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 /Can\'t return a readonly value from lvalue subroutine/;
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 print "# '$_'.\nnot "
287 unless /Can\'t return an uninitialized value from lvalue subroutine/;
293 eval <<'EOE' or $_ = $@;
294 sub lv1t : lvalue { index $x, 2 }
299 print "# '$_'.\nnot "
300 unless /Can\'t modify index in lvalue subroutine return/;
304 eval <<'EOE' or $_ = $@;
305 sub lv2t : lvalue { shift }
310 print "# '$_'.\nnot "
311 unless /Can\'t modify shift in lvalue subroutine return/;
315 sub xxx () { $xxx } # Not lvalue
318 eval <<'EOE' or $_ = $@;
319 sub lv1tmp : lvalue { xxx } # is it a TEMP?
324 print "# '$_'.\nnot "
325 unless /Can\'t modify non-lvalue subroutine call in lvalue subroutine return/;
329 eval <<'EOE' or $_ = $@;
334 print "# '$_'.\nnot "
335 unless /Can\'t return a temporary from lvalue subroutine/;
338 sub yyy () { 'yyy' } # Const, not lvalue
341 eval <<'EOE' or $_ = $@;
342 sub lv1tmpr : lvalue { yyy } # is it read-only?
347 print "# '$_'.\nnot "
348 unless /Can\'t modify constant item in lvalue subroutine return/;
352 eval <<'EOE' or $_ = $@;
357 print "# '$_'.\nnot "
358 unless /Can\'t return a readonly value from lvalue subroutine/;
361 sub lva : lvalue {@a}
366 eval <<'EOE' or $_ = $@;
371 print "# '$_'.\nnot " unless "'@a' $_" eq "'2 3' ";
378 eval <<'EOE' or $_ = $@;
383 print "# '$_'.\nnot " unless "'@a' $_" eq "'2 3' ";
390 eval <<'EOE' or $_ = $@;
395 print "# '$_'.\nnot " unless "'@a' $_" eq "'2 3' ";
398 sub lv1n : lvalue { $newvar }
401 eval <<'EOE' or $_ = $@;
406 print "# '$_', '$newvar'.\nnot " unless "'$newvar' $_" eq "'4' ";
409 sub lv1nn : lvalue { $nnewvar }
412 eval <<'EOE' or $_ = $@;
417 print "# '$_'.\nnot " unless "'$nnewvar' $_" eq "'3' ";
422 print "# '$nnewvar'.\nnot " unless $nnewvar eq '8';
425 # This must happen at run time
427 sub AUTOLOAD : lvalue { $newvar };
430 print "# '$newvar'.\nnot " unless $newvar eq "12";
433 print "ok 48 # Skip: removed test\n";
435 print "ok 49 # Skip: removed test\n";
439 sub alv : lvalue { $array[1] }
440 sub alv2 : lvalue { $array[$_[0]] }
441 sub hlv : lvalue { $hash{"foo"} }
442 sub hlv2 : lvalue { $hash{$_[0]} }
443 $array[1] = "not ok 51\n";
447 alv2(20) = "ok 51\n";
450 $hash{"foo"} = "not ok 52\n";
454 $hash{bar} = "not ok 53\n";
455 hlv("bar") = "ok 53\n";
458 sub array : lvalue { @array }
459 sub array2 : lvalue { @array2 } # This is a global.
460 sub hash : lvalue { %hash }
461 sub hash2 : lvalue { %hash2 } # So's this.
462 @array2 = qw(foo bar);
463 %hash2 = qw(foo bar);
465 (array()) = qw(ok 54);
466 print "not " unless "@array" eq "ok 54";
469 (array2()) = qw(ok 55);
470 print "not " unless "@array2" eq "ok 55";
473 (hash()) = qw(ok 56);
474 print "not " unless $hash{ok} == 56;
477 (hash2()) = qw(ok 57);
478 print "not " unless $hash2{ok} == 57;
481 @array = qw(a b c d);
482 sub aslice1 : lvalue { @array[0,2] };
483 (aslice1()) = ("ok", "already");
484 print "# @array\nnot " unless "@array" eq "ok b already d";
487 @array2 = qw(a B c d);
488 sub aslice2 : lvalue { @array2[0,2] };
489 (aslice2()) = ("ok", "already");
490 print "not " unless "@array2" eq "ok B already d";
493 %hash = qw(a Alpha b Beta c Gamma);
494 sub hslice : lvalue { @hash{"c", "b"} }
495 (hslice()) = ("CISC", "BogoMIPS");
496 print "not " unless join("/",@hash{"c","a","b"}) eq "CISC/Alpha/BogoMIPS";
500 $str = "Hello, world!";
501 sub sstr : lvalue { substr($str, 1, 4) }
503 print "not " unless $str eq "Hi, world!";
506 $str = "Made w/ JavaScript";
507 sub veclv : lvalue { vec($str, 2, 32) }
508 if (ord('A') != 193) {
509 veclv() = 0x5065726C;
512 veclv() = 0xD7859993;
514 print "# $str\nnot " unless $str eq "Made w/ PerlScript";
517 sub position : lvalue { pos }
519 $_ = "fee fi fo fum";
524 print "# @p\nnot " unless "@p" eq "1 8";
527 # Bug 20001223.002: split thought that the list had only one element
529 sub lval1 : lvalue { $ary[0]; }
530 sub lval2 : lvalue { $ary[1]; }
531 (lval1(), lval2()) = split ' ', "1 2 3 4";
532 print "not " unless join(':', @ary) eq "1:2:6";