8 sub a : lvalue { my $a = 34; ${\(bless \$a)} } # Return a temporary
9 sub b : lvalue { ${\shift} }
11 my $out = a(b()); # Check that temporaries are allowed.
12 print "# `$out'\nnot " unless ref $out eq 'main'; # Not reached if error.
15 my @out = grep /main/, a(b()); # Check that temporaries are allowed.
16 print "# `@out'\nnot " unless @out==1; # Not reached if error.
21 # Check that we can return localized values from subroutines:
23 sub in : lvalue { $in = shift; }
24 sub neg : lvalue { #(num_str) return num_str
32 print "# `$in'\nnot " unless $in eq '-2';
35 sub get_lex : lvalue { $in }
36 sub get_st : lvalue { $blah }
37 sub id : lvalue { ${\shift} }
38 sub id1 : lvalue { $_[0] }
39 sub inc : lvalue { ${\++$_[0]} }
46 print "# `$blah' ne 7\nnot " unless $blah eq 7;
51 print "# `$in' ne 7\nnot " unless $in eq 7;
56 print "# `$blah' ne 8\nnot " unless $blah eq 8;
61 print "# `$in' ne 8\nnot " unless $in eq 8;
66 print "# `$blah' ne 10\nnot " unless $blah eq 10;
71 print "# `$in' ne 10\nnot " unless $in eq 10;
76 print "# `$blah' ne 11\nnot " unless $blah eq 11;
81 print "# `$in' ne 11\nnot " unless $in eq 11;
86 print "# `$blah' ne 20\nnot " unless $blah eq 20;
91 print "# `$in' ne 20\nnot " unless $in eq 20;
96 print "# `$blah' ne 21\nnot " unless $blah eq 21;
101 print "# `$in' ne 21\nnot " unless $in eq 21;
106 print "# `$blah' ne 22\nnot " unless $blah eq 22;
111 print "# `$in' ne 22\nnot " unless $in eq 22;
116 print "# `$blah' ne 23\nnot " unless $blah eq 23;
121 print "# `$in' ne 23\nnot " unless $in eq 23;
124 ++inc(id1(id(get_st)));
126 print "# `$blah' ne 25\nnot " unless $blah eq 25;
129 ++inc(id1(id(get_lex)));
131 print "# `$in' ne 25\nnot " unless $in eq 25;
136 $#c = 3; # These slots are not fillable.
138 # Explanation: empty slots contain &sv_undef.
140 =for disabled constructs
148 eval <<'EOE' or $_ = $@;
149 ($x, a3, $y, b2, $z, c4, $t) = (34 .. 78);
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";
157 print "# '$_'.\nnot "
158 unless /Can\'t return an uninitialized value from lvalue subroutine/;
165 sub a::var : lvalue { $var }
169 print "# `$var' ne 45\nnot " unless $var eq 45;
173 $o = bless \$oo, "a";
177 print "# `$var' ne 47\nnot " unless $var eq 47;
180 sub o : lvalue { $o }
184 print "# `$var' ne 49\nnot " unless $var eq 49;
187 sub nolv () { $x0, $x1 } # Not lvalue
191 eval <<'EOE' or $_ = $@;
197 unless /Can\'t modify non-lvalue subroutine call in scalar assignment/;
202 eval <<'EOE' or $_ = $@;
208 unless /Can\'t modify non-lvalue subroutine call in scalar assignment/;
213 eval <<'EOE' or $_ = $@;
219 unless /Can\'t modify non-lvalue subroutine call in scalar assignment/;
222 $x0 = $x1 = $_ = undef;
225 eval <<'EOE' or $_ = $@;
226 $nolv->() = (2,3) if $_;
230 print "# '$_', '$x0', '$x1'.\nnot " if defined $_;
233 $x0 = $x1 = $_ = undef;
236 eval <<'EOE' or $_ = $@;
241 print "# '$_', '$x0', '$x1'.\nnot "
242 unless /Can\'t modify non-lvalue subroutine call/;
245 sub lv0 : lvalue { } # Converted to lv10 in scalar context
248 eval <<'EOE' or $_ = $@;
253 print "# '$_'.\nnot "
254 unless /Empty array returned from lvalue subroutine in scalar context/;
260 eval <<'EOE' or $_ = $@;
265 print "# '$_'.\nnot " if defined $_;
268 sub lv1u :lvalue { undef }
271 eval <<'EOE' or $_ = $@;
276 print "# '$_'.\nnot "
277 unless /Can\'t return a readonly value from lvalue subroutine/;
281 eval <<'EOE' or $_ = $@;
286 # Fixed by change @10777
287 #print "# '$_'.\nnot "
288 # unless /Can\'t return an uninitialized value from lvalue subroutine/;
289 print "ok 34 # Skip: removed test\n";
294 eval <<'EOE' or $_ = $@;
295 sub lv1t : lvalue { index $x, 2 }
300 print "# '$_'.\nnot "
301 unless /Can\'t modify index in lvalue subroutine return/;
305 eval <<'EOE' or $_ = $@;
306 sub lv2t : lvalue { shift }
311 print "# '$_'.\nnot "
312 unless /Can\'t modify shift in lvalue subroutine return/;
316 sub xxx () { $xxx } # Not lvalue
319 eval <<'EOE' or $_ = $@;
320 sub lv1tmp : lvalue { xxx } # is it a TEMP?
325 print "# '$_'.\nnot "
326 unless /Can\'t modify non-lvalue subroutine call in lvalue subroutine return/;
330 eval <<'EOE' or $_ = $@;
335 print "# '$_'.\nnot "
336 unless /Can\'t return a temporary from lvalue subroutine/;
339 sub yyy () { 'yyy' } # Const, not lvalue
342 eval <<'EOE' or $_ = $@;
343 sub lv1tmpr : lvalue { yyy } # is it read-only?
348 print "# '$_'.\nnot "
349 unless /Can\'t modify constant item in lvalue subroutine return/;
353 eval <<'EOE' or $_ = $@;
358 print "# '$_'.\nnot "
359 unless /Can\'t return a readonly value from lvalue subroutine/;
362 sub lva : lvalue {@a}
367 eval <<'EOE' or $_ = $@;
372 print "# '$_'.\nnot " unless "'@a' $_" eq "'2 3' ";
379 eval <<'EOE' or $_ = $@;
384 print "# '$_'.\nnot " unless "'@a' $_" eq "'2 3' ";
391 eval <<'EOE' or $_ = $@;
396 print "# '$_'.\nnot " unless "'@a' $_" eq "'2 3' ";
399 sub lv1n : lvalue { $newvar }
402 eval <<'EOE' or $_ = $@;
407 print "# '$_', '$newvar'.\nnot " unless "'$newvar' $_" eq "'4' ";
410 sub lv1nn : lvalue { $nnewvar }
413 eval <<'EOE' or $_ = $@;
418 print "# '$_'.\nnot " unless "'$nnewvar' $_" eq "'3' ";
423 print "# '$nnewvar'.\nnot " unless $nnewvar eq '8';
426 # This must happen at run time
428 sub AUTOLOAD : lvalue { $newvar };
431 print "# '$newvar'.\nnot " unless $newvar eq "12";
434 print "ok 48 # Skip: removed test\n";
436 print "ok 49 # Skip: removed test\n";
440 sub alv : lvalue { $array[1] }
441 sub alv2 : lvalue { $array[$_[0]] }
442 sub hlv : lvalue { $hash{"foo"} }
443 sub hlv2 : lvalue { $hash{$_[0]} }
444 $array[1] = "not ok 51\n";
448 alv2(20) = "ok 51\n";
451 $hash{"foo"} = "not ok 52\n";
455 $hash{bar} = "not ok 53\n";
456 hlv("bar") = "ok 53\n";
459 sub array : lvalue { @array }
460 sub array2 : lvalue { @array2 } # This is a global.
461 sub hash : lvalue { %hash }
462 sub hash2 : lvalue { %hash2 } # So's this.
463 @array2 = qw(foo bar);
464 %hash2 = qw(foo bar);
466 (array()) = qw(ok 54);
467 print "not " unless "@array" eq "ok 54";
470 (array2()) = qw(ok 55);
471 print "not " unless "@array2" eq "ok 55";
474 (hash()) = qw(ok 56);
475 print "not " unless $hash{ok} == 56;
478 (hash2()) = qw(ok 57);
479 print "not " unless $hash2{ok} == 57;
482 @array = qw(a b c d);
483 sub aslice1 : lvalue { @array[0,2] };
484 (aslice1()) = ("ok", "already");
485 print "# @array\nnot " unless "@array" eq "ok b already d";
488 @array2 = qw(a B c d);
489 sub aslice2 : lvalue { @array2[0,2] };
490 (aslice2()) = ("ok", "already");
491 print "not " unless "@array2" eq "ok B already d";
494 %hash = qw(a Alpha b Beta c Gamma);
495 sub hslice : lvalue { @hash{"c", "b"} }
496 (hslice()) = ("CISC", "BogoMIPS");
497 print "not " unless join("/",@hash{"c","a","b"}) eq "CISC/Alpha/BogoMIPS";
501 $str = "Hello, world!";
502 sub sstr : lvalue { substr($str, 1, 4) }
504 print "not " unless $str eq "Hi, world!";
507 $str = "Made w/ JavaScript";
508 sub veclv : lvalue { vec($str, 2, 32) }
509 if (ord('A') != 193) {
510 veclv() = 0x5065726C;
513 veclv() = 0xD7859993;
515 print "# $str\nnot " unless $str eq "Made w/ PerlScript";
518 sub position : lvalue { pos }
520 $_ = "fee fi fo fum";
525 print "# @p\nnot " unless "@p" eq "1 8";
528 # Bug 20001223.002: split thought that the list had only one element
530 sub lval1 : lvalue { $ary[0]; }
531 sub lval2 : lvalue { $ary[1]; }
532 (lval1(), lval2()) = split ' ', "1 2 3 4";
533 print "not " unless join(':', @ary) eq "1:2:6";