This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Exit test script (if we're going to) *before* declaring a plan
[perl5.git] / t / op / sub_lval.t
CommitLineData
4546bcba 1print "1..68\n";
cd06dffe
GS
2
3BEGIN {
4 chdir 't' if -d 't';
20822f61 5 @INC = '../lib';
cd06dffe
GS
6}
7
78f9721b
SM
8sub a : lvalue { my $a = 34; ${\(bless \$a)} } # Return a temporary
9sub b : lvalue { ${\shift} }
cd06dffe
GS
10
11my $out = a(b()); # Check that temporaries are allowed.
12print "# `$out'\nnot " unless ref $out eq 'main'; # Not reached if error.
13print "ok 1\n";
14
15my @out = grep /main/, a(b()); # Check that temporaries are allowed.
16print "# `@out'\nnot " unless @out==1; # Not reached if error.
17print "ok 2\n";
18
19my $in;
20
21# Check that we can return localized values from subroutines:
22
a98df962
GS
23sub in : lvalue { $in = shift; }
24sub neg : lvalue { #(num_str) return num_str
cd06dffe
GS
25 local $_ = shift;
26 s/^\+/-/;
27 $_;
28}
29in(neg("+2"));
30
31
32print "# `$in'\nnot " unless $in eq '-2';
33print "ok 3\n";
34
a98df962
GS
35sub get_lex : lvalue { $in }
36sub get_st : lvalue { $blah }
78f9721b 37sub id : lvalue { ${\shift} }
a98df962 38sub id1 : lvalue { $_[0] }
78f9721b 39sub inc : lvalue { ${\++$_[0]} }
cd06dffe
GS
40
41$in = 5;
42$blah = 3;
43
44get_st = 7;
45
2f044c87 46print "# `$blah' ne 7\nnot " unless $blah == 7;
cd06dffe
GS
47print "ok 4\n";
48
49get_lex = 7;
50
2f044c87 51print "# `$in' ne 7\nnot " unless $in == 7;
cd06dffe
GS
52print "ok 5\n";
53
54++get_st;
55
2f044c87 56print "# `$blah' ne 8\nnot " unless $blah == 8;
cd06dffe
GS
57print "ok 6\n";
58
59++get_lex;
60
2f044c87 61print "# `$in' ne 8\nnot " unless $in == 8;
cd06dffe
GS
62print "ok 7\n";
63
64id(get_st) = 10;
65
2f044c87 66print "# `$blah' ne 10\nnot " unless $blah == 10;
cd06dffe
GS
67print "ok 8\n";
68
69id(get_lex) = 10;
70
2f044c87 71print "# `$in' ne 10\nnot " unless $in == 10;
cd06dffe
GS
72print "ok 9\n";
73
74++id(get_st);
75
2f044c87 76print "# `$blah' ne 11\nnot " unless $blah == 11;
cd06dffe
GS
77print "ok 10\n";
78
79++id(get_lex);
80
2f044c87 81print "# `$in' ne 11\nnot " unless $in == 11;
cd06dffe
GS
82print "ok 11\n";
83
84id1(get_st) = 20;
85
2f044c87 86print "# `$blah' ne 20\nnot " unless $blah == 20;
cd06dffe
GS
87print "ok 12\n";
88
89id1(get_lex) = 20;
90
2f044c87 91print "# `$in' ne 20\nnot " unless $in == 20;
cd06dffe
GS
92print "ok 13\n";
93
94++id1(get_st);
95
2f044c87 96print "# `$blah' ne 21\nnot " unless $blah == 21;
cd06dffe
GS
97print "ok 14\n";
98
99++id1(get_lex);
100
2f044c87 101print "# `$in' ne 21\nnot " unless $in == 21;
cd06dffe
GS
102print "ok 15\n";
103
104inc(get_st);
105
2f044c87 106print "# `$blah' ne 22\nnot " unless $blah == 22;
cd06dffe
GS
107print "ok 16\n";
108
109inc(get_lex);
110
2f044c87 111print "# `$in' ne 22\nnot " unless $in == 22;
cd06dffe
GS
112print "ok 17\n";
113
114inc(id(get_st));
115
2f044c87 116print "# `$blah' ne 23\nnot " unless $blah == 23;
cd06dffe
GS
117print "ok 18\n";
118
119inc(id(get_lex));
120
2f044c87 121print "# `$in' ne 23\nnot " unless $in == 23;
cd06dffe
GS
122print "ok 19\n";
123
124++inc(id1(id(get_st)));
125
2f044c87 126print "# `$blah' ne 25\nnot " unless $blah == 25;
cd06dffe
GS
127print "ok 20\n";
128
129++inc(id1(id(get_lex)));
130
2f044c87 131print "# `$in' ne 25\nnot " unless $in == 25;
cd06dffe
GS
132print "ok 21\n";
133
134@a = (1) x 3;
135@b = (undef) x 2;
136$#c = 3; # These slots are not fillable.
137
138# Explanation: empty slots contain &sv_undef.
139
140=for disabled constructs
141
a98df962
GS
142sub a3 :lvalue {@a}
143sub b2 : lvalue {@b}
144sub c4: lvalue {@c}
cd06dffe
GS
145
146$_ = '';
147
148eval <<'EOE' or $_ = $@;
149 ($x, a3, $y, b2, $z, c4, $t) = (34 .. 78);
150 1;
151EOE
152
153#@out = ($x, a3, $y, b2, $z, c4, $t);
154#@in = (34 .. 41, (undef) x 4, 46);
155#print "# `@out' ne `@in'\nnot " unless "@out" eq "@in";
156
157print "# '$_'.\nnot "
158 unless /Can\'t return an uninitialized value from lvalue subroutine/;
159=cut
160
161print "ok 22\n";
162
163my $var;
164
a98df962 165sub a::var : lvalue { $var }
cd06dffe
GS
166
167"a"->var = 45;
168
2f044c87 169print "# `$var' ne 45\nnot " unless $var == 45;
cd06dffe
GS
170print "ok 23\n";
171
172my $oo;
173$o = bless \$oo, "a";
174
175$o->var = 47;
176
2f044c87 177print "# `$var' ne 47\nnot " unless $var == 47;
cd06dffe
GS
178print "ok 24\n";
179
a98df962 180sub o : lvalue { $o }
cd06dffe
GS
181
182o->var = 49;
183
2f044c87 184print "# `$var' ne 49\nnot " unless $var == 49;
cd06dffe
GS
185print "ok 25\n";
186
187sub nolv () { $x0, $x1 } # Not lvalue
188
189$_ = '';
190
191eval <<'EOE' or $_ = $@;
192 nolv = (2,3);
193 1;
194EOE
195
196print "not "
197 unless /Can\'t modify non-lvalue subroutine call in scalar assignment/;
198print "ok 26\n";
199
200$_ = '';
201
202eval <<'EOE' or $_ = $@;
203 nolv = (2,3) if $_;
204 1;
205EOE
206
207print "not "
208 unless /Can\'t modify non-lvalue subroutine call in scalar assignment/;
209print "ok 27\n";
210
211$_ = '';
212
213eval <<'EOE' or $_ = $@;
214 &nolv = (2,3) if $_;
215 1;
216EOE
217
218print "not "
219 unless /Can\'t modify non-lvalue subroutine call in scalar assignment/;
220print "ok 28\n";
221
222$x0 = $x1 = $_ = undef;
223$nolv = \&nolv;
224
225eval <<'EOE' or $_ = $@;
226 $nolv->() = (2,3) if $_;
227 1;
228EOE
229
230print "# '$_', '$x0', '$x1'.\nnot " if defined $_;
231print "ok 29\n";
232
233$x0 = $x1 = $_ = undef;
234$nolv = \&nolv;
235
236eval <<'EOE' or $_ = $@;
237 $nolv->() = (2,3);
238 1;
239EOE
240
241print "# '$_', '$x0', '$x1'.\nnot "
5c0bc887 242 unless /Can\'t modify non-lvalue subroutine call/;
cd06dffe
GS
243print "ok 30\n";
244
a98df962 245sub lv0 : lvalue { } # Converted to lv10 in scalar context
cd06dffe
GS
246
247$_ = undef;
248eval <<'EOE' or $_ = $@;
249 lv0 = (2,3);
250 1;
251EOE
252
253print "# '$_'.\nnot "
e9f19e3c 254 unless /Can't return undef from lvalue subroutine/;
cd06dffe
GS
255print "ok 31\n";
256
a98df962 257sub lv10 : lvalue {}
cd06dffe
GS
258
259$_ = undef;
260eval <<'EOE' or $_ = $@;
261 (lv0) = (2,3);
262 1;
263EOE
264
265print "# '$_'.\nnot " if defined $_;
266print "ok 32\n";
267
a98df962 268sub lv1u :lvalue { undef }
cd06dffe
GS
269
270$_ = undef;
271eval <<'EOE' or $_ = $@;
272 lv1u = (2,3);
273 1;
274EOE
275
276print "# '$_'.\nnot "
e9f19e3c 277 unless /Can't return undef from lvalue subroutine/;
cd06dffe
GS
278print "ok 33\n";
279
280$_ = undef;
281eval <<'EOE' or $_ = $@;
282 (lv1u) = (2,3);
283 1;
284EOE
285
4c8a4e58
JH
286# Fixed by change @10777
287#print "# '$_'.\nnot "
288# unless /Can\'t return an uninitialized value from lvalue subroutine/;
289print "ok 34 # Skip: removed test\n";
cd06dffe
GS
290
291$x = '1234567';
cd06dffe
GS
292
293$_ = undef;
294eval <<'EOE' or $_ = $@;
78f9721b 295 sub lv1t : lvalue { index $x, 2 }
cd06dffe
GS
296 lv1t = (2,3);
297 1;
298EOE
299
300print "# '$_'.\nnot "
78f9721b 301 unless /Can\'t modify index in lvalue subroutine return/;
cd06dffe
GS
302print "ok 35\n";
303
304$_ = undef;
305eval <<'EOE' or $_ = $@;
78f9721b
SM
306 sub lv2t : lvalue { shift }
307 (lv2t) = (2,3);
cd06dffe
GS
308 1;
309EOE
310
311print "# '$_'.\nnot "
78f9721b 312 unless /Can\'t modify shift in lvalue subroutine return/;
cd06dffe
GS
313print "ok 36\n";
314
315$xxx = 'xxx';
316sub xxx () { $xxx } # Not lvalue
cd06dffe
GS
317
318$_ = undef;
319eval <<'EOE' or $_ = $@;
78f9721b 320 sub lv1tmp : lvalue { xxx } # is it a TEMP?
cd06dffe
GS
321 lv1tmp = (2,3);
322 1;
323EOE
324
325print "# '$_'.\nnot "
78f9721b 326 unless /Can\'t modify non-lvalue subroutine call in lvalue subroutine return/;
cd06dffe
GS
327print "ok 37\n";
328
329$_ = undef;
330eval <<'EOE' or $_ = $@;
331 (lv1tmp) = (2,3);
332 1;
333EOE
334
335print "# '$_'.\nnot "
336 unless /Can\'t return a temporary from lvalue subroutine/;
337print "ok 38\n";
338
9a049f1c 339sub yyy () { 'yyy' } # Const, not lvalue
cd06dffe
GS
340
341$_ = undef;
342eval <<'EOE' or $_ = $@;
78f9721b 343 sub lv1tmpr : lvalue { yyy } # is it read-only?
cd06dffe
GS
344 lv1tmpr = (2,3);
345 1;
346EOE
347
348print "# '$_'.\nnot "
78f9721b 349 unless /Can\'t modify constant item in lvalue subroutine return/;
cd06dffe
GS
350print "ok 39\n";
351
352$_ = undef;
353eval <<'EOE' or $_ = $@;
354 (lv1tmpr) = (2,3);
355 1;
356EOE
357
358print "# '$_'.\nnot "
359 unless /Can\'t return a readonly value from lvalue subroutine/;
360print "ok 40\n";
361
a98df962 362sub lva : lvalue {@a}
cd06dffe
GS
363
364$_ = undef;
365@a = ();
366$a[1] = 12;
367eval <<'EOE' or $_ = $@;
368 (lva) = (2,3);
369 1;
370EOE
371
78f9721b 372print "# '$_'.\nnot " unless "'@a' $_" eq "'2 3' ";
cd06dffe
GS
373print "ok 41\n";
374
375$_ = undef;
376@a = ();
377$a[0] = undef;
378$a[1] = 12;
379eval <<'EOE' or $_ = $@;
380 (lva) = (2,3);
381 1;
382EOE
383
384print "# '$_'.\nnot " unless "'@a' $_" eq "'2 3' ";
385print "ok 42\n";
386
387$_ = undef;
388@a = ();
389$a[0] = undef;
390$a[1] = 12;
391eval <<'EOE' or $_ = $@;
392 (lva) = (2,3);
393 1;
394EOE
395
396print "# '$_'.\nnot " unless "'@a' $_" eq "'2 3' ";
397print "ok 43\n";
398
a98df962 399sub lv1n : lvalue { $newvar }
cd06dffe
GS
400
401$_ = undef;
402eval <<'EOE' or $_ = $@;
403 lv1n = (3,4);
404 1;
405EOE
406
407print "# '$_', '$newvar'.\nnot " unless "'$newvar' $_" eq "'4' ";
408print "ok 44\n";
409
a98df962 410sub lv1nn : lvalue { $nnewvar }
cd06dffe
GS
411
412$_ = undef;
413eval <<'EOE' or $_ = $@;
414 (lv1nn) = (3,4);
415 1;
416EOE
417
418print "# '$_'.\nnot " unless "'$nnewvar' $_" eq "'3' ";
419print "ok 45\n";
420
421$a = \&lv1nn;
422$a->() = 8;
423print "# '$nnewvar'.\nnot " unless $nnewvar eq '8';
424print "ok 46\n";
d32f2495 425
84251760 426eval 'sub AUTOLOAD : lvalue { $newvar }';
d32f2495
SC
427foobar() = 12;
428print "# '$newvar'.\nnot " unless $newvar eq "12";
429print "ok 47\n";
430
8b6e3824
JH
431print "ok 48 # Skip: removed test\n";
432
433print "ok 49 # Skip: removed test\n";
26191e78 434
78f9721b
SM
435{
436my %hash; my @array;
437sub alv : lvalue { $array[1] }
438sub alv2 : lvalue { $array[$_[0]] }
439sub hlv : lvalue { $hash{"foo"} }
440sub hlv2 : lvalue { $hash{$_[0]} }
441$array[1] = "not ok 51\n";
442alv() = "ok 50\n";
443print alv();
444
445alv2(20) = "ok 51\n";
446print $array[20];
447
448$hash{"foo"} = "not ok 52\n";
449hlv() = "ok 52\n";
450print $hash{foo};
451
452$hash{bar} = "not ok 53\n";
453hlv("bar") = "ok 53\n";
454print hlv("bar");
455
456sub array : lvalue { @array }
457sub array2 : lvalue { @array2 } # This is a global.
458sub hash : lvalue { %hash }
459sub hash2 : lvalue { %hash2 } # So's this.
460@array2 = qw(foo bar);
461%hash2 = qw(foo bar);
462
463(array()) = qw(ok 54);
464print "not " unless "@array" eq "ok 54";
465print "ok 54\n";
466
467(array2()) = qw(ok 55);
468print "not " unless "@array2" eq "ok 55";
469print "ok 55\n";
470
471(hash()) = qw(ok 56);
472print "not " unless $hash{ok} == 56;
473print "ok 56\n";
474
475(hash2()) = qw(ok 57);
476print "not " unless $hash2{ok} == 57;
477print "ok 57\n";
478
479@array = qw(a b c d);
480sub aslice1 : lvalue { @array[0,2] };
481(aslice1()) = ("ok", "already");
482print "# @array\nnot " unless "@array" eq "ok b already d";
483print "ok 58\n";
484
485@array2 = qw(a B c d);
486sub aslice2 : lvalue { @array2[0,2] };
487(aslice2()) = ("ok", "already");
488print "not " unless "@array2" eq "ok B already d";
489print "ok 59\n";
490
491%hash = qw(a Alpha b Beta c Gamma);
492sub hslice : lvalue { @hash{"c", "b"} }
493(hslice()) = ("CISC", "BogoMIPS");
494print "not " unless join("/",@hash{"c","a","b"}) eq "CISC/Alpha/BogoMIPS";
495print "ok 60\n";
496}
497
498$str = "Hello, world!";
499sub sstr : lvalue { substr($str, 1, 4) }
500sstr() = "i";
501print "not " unless $str eq "Hi, world!";
502print "ok 61\n";
503
504$str = "Made w/ JavaScript";
505sub veclv : lvalue { vec($str, 2, 32) }
e6b8b224
PP
506if (ord('A') != 193) {
507 veclv() = 0x5065726C;
508}
509else { # EBCDIC?
510 veclv() = 0xD7859993;
511}
78f9721b
SM
512print "# $str\nnot " unless $str eq "Made w/ PerlScript";
513print "ok 62\n";
514
515sub position : lvalue { pos }
516@p = ();
517$_ = "fee fi fo fum";
518while (/f/g) {
519 push @p, position;
520 position() += 6;
521}
522print "# @p\nnot " unless "@p" eq "1 8";
523print "ok 63\n";
7c8af4ef
RG
524
525# Bug 20001223.002: split thought that the list had only one element
526@ary = qw(4 5 6);
527sub lval1 : lvalue { $ary[0]; }
528sub lval2 : lvalue { $ary[1]; }
529(lval1(), lval2()) = split ' ', "1 2 3 4";
530print "not " unless join(':', @ary) eq "1:2:6";
531print "ok 64\n";
1c4274f4
MS
532
533require './test.pl';
534curr_test(65);
535
536TODO: {
537 local $TODO = 'test explicit return of lval expr';
538
539 # subs are corrupted copies from tests 1-~4
540 sub bad_get_lex : lvalue { return $in };
541 sub bad_get_st : lvalue { return $blah }
542
543 sub bad_id : lvalue { return ${\shift} }
544 sub bad_id1 : lvalue { return $_[0] }
545 sub bad_inc : lvalue { return ${\++$_[0]} }
546
547 $in = 5;
548 $blah = 3;
549
550 bad_get_st = 7;
551
552 is( $blah, 7 );
553
554 bad_get_lex = 7;
555
556 is($in, 7, "yada");
557
558 ++bad_get_st;
559
560 is($blah, 8, "yada");
561}
562
4546bcba
RGS
563TODO: {
564 local $TODO = "bug #23790";
565 my @arr = qw /one two three/;
566 my $line = "zero";
567 sub lval_array () : lvalue {@arr}
568
569 for (lval_array) {
570 $line .= $_;
571 }
572
573 is($line, "zeroonetwothree");
574}