This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #92290, #92406] Returning a pad var from lv sub
[perl5.git] / t / op / sub_lval.t
1 BEGIN {
2     chdir 't' if -d 't';
3     @INC = '../lib';
4     require './test.pl';
5 }
6 plan tests=>155;
7
8 sub a : lvalue { my $a = 34; ${\(bless \$a)} }  # Return a temporary
9 sub b : lvalue { ${\shift} }
10
11 my $out = a(b());               # Check that temporaries are allowed.
12 is(ref $out, 'main'); # Not reached if error.
13
14 my @out = grep /main/, a(b()); # Check that temporaries are allowed.
15 cmp_ok(scalar @out, '==', 1); # Not reached if error.
16
17 my $in;
18
19 # Check that we can return localized values from subroutines:
20
21 sub in : lvalue { $in = shift; }
22 sub neg : lvalue {  #(num_str) return num_str
23     local $_ = shift;
24     s/^\+/-/;
25     $_;
26 }
27 in(neg("+2"));
28
29
30 is($in, '-2');
31
32 sub get_lex : lvalue { $in }
33 sub get_st : lvalue { $blah }
34 sub id : lvalue { ${\shift} }
35 sub id1 : lvalue { $_[0] }
36 sub inc : lvalue { ${\++$_[0]} }
37
38 $in = 5;
39 $blah = 3;
40
41 get_st = 7;
42
43 cmp_ok($blah, '==', 7);
44
45 get_lex = 7;
46
47 cmp_ok($in, '==', 7);
48
49 ++get_st;
50
51 cmp_ok($blah, '==', 8);
52
53 ++get_lex;
54
55 cmp_ok($in, '==', 8);
56
57 id(get_st) = 10;
58
59 cmp_ok($blah, '==', 10);
60
61 id(get_lex) = 10;
62
63 cmp_ok($in, '==', 10);
64
65 ++id(get_st);
66
67 cmp_ok($blah, '==', 11);
68
69 ++id(get_lex);
70
71 cmp_ok($in, '==', 11);
72
73 id1(get_st) = 20;
74
75 cmp_ok($blah, '==', 20);
76
77 id1(get_lex) = 20;
78
79 cmp_ok($in, '==', 20);
80
81 ++id1(get_st);
82
83 cmp_ok($blah, '==', 21);
84
85 ++id1(get_lex);
86
87 cmp_ok($in, '==', 21);
88
89 inc(get_st);
90
91 cmp_ok($blah, '==', 22);
92
93 inc(get_lex);
94
95 cmp_ok($in, '==', 22);
96
97 inc(id(get_st));
98
99 cmp_ok($blah, '==', 23);
100
101 inc(id(get_lex));
102
103 cmp_ok($in, '==', 23);
104
105 ++inc(id1(id(get_st)));
106
107 cmp_ok($blah, '==', 25);
108
109 ++inc(id1(id(get_lex)));
110
111 cmp_ok($in, '==', 25);
112
113 @a = (1) x 3;
114 @b = (undef) x 2;
115 $#c = 3;                        # These slots are not fillable.
116
117 # Explanation: empty slots contain &sv_undef.
118
119 =for disabled constructs
120
121 sub a3 :lvalue {@a}
122 sub b2 : lvalue {@b}
123 sub c4: lvalue {@c}
124
125 $_ = '';
126
127 eval <<'EOE' or $_ = $@;
128   ($x, a3, $y, b2, $z, c4, $t) = (34 .. 78);
129   1;
130 EOE
131
132 #@out = ($x, a3, $y, b2, $z, c4, $t);
133 #@in = (34 .. 41, (undef) x 4, 46);
134 #print "# `@out' ne `@in'\nnot " unless "@out" eq "@in";
135
136 like($_, qr/Can\'t return an uninitialized value from lvalue subroutine/);
137 print "ok 22\n";
138
139 =cut
140
141
142 my $var;
143
144 sub a::var : lvalue { $var }
145
146 "a"->var = 45;
147
148 cmp_ok($var, '==', 45);
149
150 my $oo;
151 $o = bless \$oo, "a";
152
153 $o->var = 47;
154
155 cmp_ok($var, '==', 47);
156
157 sub o : lvalue { $o }
158
159 o->var = 49;
160
161 cmp_ok($var, '==', 49);
162
163 sub nolv () { $x0, $x1 } # Not lvalue
164
165 $_ = '';
166
167 eval <<'EOE' or $_ = $@;
168   nolv = (2,3);
169   1;
170 EOE
171
172 like($_, qr/Can\'t modify non-lvalue subroutine call in scalar assignment/);
173
174 $_ = '';
175
176 eval <<'EOE' or $_ = $@;
177   nolv = (2,3) if $_;
178   1;
179 EOE
180
181 like($_, qr/Can\'t modify non-lvalue subroutine call in scalar assignment/);
182
183 $_ = '';
184
185 eval <<'EOE' or $_ = $@;
186   &nolv = (2,3) if $_;
187   1;
188 EOE
189
190 like($_, qr/Can\'t modify non-lvalue subroutine call in scalar assignment/);
191
192 $x0 = $x1 = $_ = undef;
193 $nolv = \&nolv;
194
195 eval <<'EOE' or $_ = $@;
196   $nolv->() = (2,3) if $_;
197   1;
198 EOE
199
200 ok(!defined $_) or diag "'$_', '$x0', '$x1'";
201
202 $x0 = $x1 = $_ = undef;
203 $nolv = \&nolv;
204
205 eval <<'EOE' or $_ = $@;
206   $nolv->() = (2,3);
207   1;
208 EOE
209
210 like($_, qr/Can\'t modify non-lvalue subroutine call/)
211   or diag "'$_', '$x0', '$x1'";
212
213 sub lv0 : lvalue { }
214
215 $_ = undef;
216 eval <<'EOE' or $_ = $@;
217   lv0 = (2,3);
218   1;
219 EOE
220
221 like($_, qr/Can't return undef from lvalue subroutine/);
222
223 $_ = undef;
224 eval <<'EOE' or $_ = $@;
225   (lv0) = (2,3);
226   1;
227 EOE
228
229 ok(!defined $_) or diag $_;
230
231 ($a,$b)=();
232 (lv0($a,$b)) = (3,4);
233 is +($a//'undef') . ($b//'undef'), 'undefundef',
234    'list assignment to empty lvalue sub';
235
236
237 sub lv1u :lvalue { undef }
238
239 $_ = undef;
240 eval <<'EOE' or $_ = $@;
241   lv1u = (2,3);
242   1;
243 EOE
244
245 like($_, qr/Can't return undef from lvalue subroutine/);
246
247 $_ = undef;
248 eval <<'EOE' or $_ = $@;
249   (lv1u) = (2,3);
250   1;
251 EOE
252
253 # Fixed by change @10777
254 #print "# '$_'.\nnot "
255 #  unless /Can\'t return an uninitialized value from lvalue subroutine/;
256 # print "ok 34 # Skip: removed test\n";
257
258 $x = '1234567';
259
260 $_ = undef;
261 eval <<'EOE' or $_ = $@;
262   sub lv1t : lvalue { index $x, 2 }
263   lv1t = (2,3);
264   1;
265 EOE
266
267 like($_, qr/Can\'t return a temporary from lvalue subroutine/);
268
269 $_ = undef;
270 sub lv2t : lvalue { shift }
271 (lv2t($_)) = (2,3);
272 is($_, 2);
273
274 $xxx = 'xxx';
275 sub xxx () { $xxx }  # Not lvalue
276
277 $_ = undef;
278 eval <<'EOE' or $_ = $@;
279   sub lv1tmp : lvalue { xxx }                   # is it a TEMP?
280   lv1tmp = (2,3);
281   1;
282 EOE
283
284 is($_, undef, "returning a temp from an lvalue sub in scalar context");
285
286 $_ = undef;
287 eval <<'EOE' or $_ = $@;
288   (lv1tmp) = (2,3);
289   1;
290 EOE
291
292 is($_, undef, "returning a temp from an lvalue sub in list context");
293
294 sub yyy () { 'yyy' } # Const, not lvalue
295
296 $_ = undef;
297 eval <<'EOE' or $_ = $@;
298   sub lv1tmpr : lvalue { yyy }                  # is it read-only?
299   lv1tmpr = (2,3);
300   1;
301 EOE
302
303 like($_, qr/Can\'t return a readonly value from lvalue subroutine at/);
304
305 $_ = undef;
306 eval <<'EOE' or $_ = $@;
307   (lv1tmpr) = (2,3);
308   1;
309 EOE
310
311 like($_, qr/Can\'t return a readonly value from lvalue subroutine/);
312
313 sub lva : lvalue {@a}
314
315 $_ = undef;
316 @a = ();
317 $a[1] = 12;
318 eval <<'EOE' or $_ = $@;
319   (lva) = (2,3);
320   1;
321 EOE
322
323 is("'@a' $_", "'2 3' ");
324
325 $_ = undef;
326 @a = ();
327 $a[0] = undef;
328 $a[1] = 12;
329 eval <<'EOE' or $_ = $@;
330   (lva) = (2,3);
331   1;
332 EOE
333
334 is("'@a' $_", "'2 3' ");
335
336 is lva->${\sub { return $_[0] }}, 2,
337   'lvalue->$thing when lvalue returns array';
338
339 my @my = qw/ a b c /;
340 sub lvmya : lvalue { @my }
341
342 is lvmya->${\sub { return $_[0] }}, 3,
343   'lvalue->$thing when lvalue returns lexical array';
344
345 sub lv1n : lvalue { $newvar }
346
347 $_ = undef;
348 eval <<'EOE' or $_ = $@;
349   lv1n = (3,4);
350   1;
351 EOE
352
353 is("'$newvar' $_", "'4' ");
354
355 sub lv1nn : lvalue { $nnewvar }
356
357 $_ = undef;
358 eval <<'EOE' or $_ = $@;
359   (lv1nn) = (3,4);
360   1;
361 EOE
362
363 is("'$nnewvar' $_", "'3' ");
364
365 $a = \&lv1nn;
366 $a->() = 8;
367 is($nnewvar, '8');
368
369 eval 'sub AUTOLOAD : lvalue { $newvar }';
370 foobar() = 12;
371 is($newvar, "12");
372
373 {
374 my %hash; my @array;
375 sub alv : lvalue { $array[1] }
376 sub alv2 : lvalue { $array[$_[0]] }
377 sub hlv : lvalue { $hash{"foo"} }
378 sub hlv2 : lvalue { $hash{$_[0]} }
379 $array[1] = "not ok 51\n";
380 alv() = "ok 50\n";
381 is(alv(), "ok 50\n");
382
383 alv2(20) = "ok 51\n";
384 is($array[20], "ok 51\n");
385
386 $hash{"foo"} = "not ok 52\n";
387 hlv() = "ok 52\n";
388 is($hash{foo}, "ok 52\n");
389
390 $hash{bar} = "not ok 53\n";
391 hlv("bar") = "ok 53\n";
392 is(hlv("bar"), "ok 53\n");
393
394 sub array : lvalue  { @array  }
395 sub array2 : lvalue { @array2 } # This is a global.
396 sub hash : lvalue   { %hash   }
397 sub hash2 : lvalue  { %hash2  } # So's this.
398 @array2 = qw(foo bar);
399 %hash2 = qw(foo bar);
400
401 (array()) = qw(ok 54);
402 is("@array", "ok 54");
403
404 (array2()) = qw(ok 55);
405 is("@array2", "ok 55");
406
407 (hash()) = qw(ok 56);
408 cmp_ok($hash{ok}, '==', 56);
409
410 (hash2()) = qw(ok 57);
411 cmp_ok($hash2{ok}, '==', 57);
412
413 @array = qw(a b c d);
414 sub aslice1 : lvalue { @array[0,2] };
415 (aslice1()) = ("ok", "already");
416 is("@array", "ok b already d");
417
418 @array2 = qw(a B c d);
419 sub aslice2 : lvalue { @array2[0,2] };
420 (aslice2()) = ("ok", "already");
421 is("@array2", "ok B already d");
422
423 %hash = qw(a Alpha b Beta c Gamma);
424 sub hslice : lvalue { @hash{"c", "b"} }
425 (hslice()) = ("CISC", "BogoMIPS");
426 is(join("/",@hash{"c","a","b"}), "CISC/Alpha/BogoMIPS");
427 }
428
429 $str = "Hello, world!";
430 sub sstr : lvalue { substr($str, 1, 4) }
431 sstr() = "i";
432 is($str, "Hi, world!");
433
434 $str = "Made w/ JavaScript";
435 sub veclv : lvalue { vec($str, 2, 32) }
436 if (ord('A') != 193) {
437     veclv() = 0x5065726C;
438 }
439 else { # EBCDIC?
440     veclv() = 0xD7859993;
441 }
442 is($str, "Made w/ PerlScript");
443
444 sub position : lvalue { pos }
445 @p = ();
446 $_ = "fee fi fo fum";
447 while (/f/g) {
448     push @p, position;
449     position() += 6;
450 }
451 is("@p", "1 8");
452
453 # Bug 20001223.002: split thought that the list had only one element
454 @ary = qw(4 5 6);
455 sub lval1 : lvalue { $ary[0]; }
456 sub lval2 : lvalue { $ary[1]; }
457 (lval1(), lval2()) = split ' ', "1 2 3 4";
458
459 is(join(':', @ary), "1:2:6");
460
461 # check that an element of a tied hash/array can be assigned to via lvalueness
462
463 package Tie_Hash;
464
465 our ($key, $val);
466 sub TIEHASH { bless \my $v => __PACKAGE__ }
467 sub STORE   { ($key, $val) = @_[1,2] }
468
469 package main;
470 sub lval_tie_hash : lvalue {
471     tie my %t => 'Tie_Hash';
472     $t{key};
473 }
474
475 eval { lval_tie_hash() = "value"; };
476
477 is($@, "", "element of tied hash");
478
479 is("$Tie_Hash::key-$Tie_Hash::val", "key-value");
480
481
482 package Tie_Array;
483
484 our @val;
485 sub TIEARRAY { bless \my $v => __PACKAGE__ }
486 sub STORE   { $val[ $_[1] ] = $_[2] }
487
488 package main;
489 sub lval_tie_array : lvalue {
490     tie my @t => 'Tie_Array';
491     $t[0];
492 }
493
494 eval { lval_tie_array() = "value"; };
495
496
497 is($@, "", "element of tied array");
498
499 is ($Tie_Array::val[0], "value");
500
501
502 # Test explicit return of lvalue expression
503 {
504     # subs are copies from tests 1-~18 with an explicit return added.
505     # They used not to work, which is why they are ‘badly’ named.
506     sub bad_get_lex : lvalue { return $in };
507     sub bad_get_st  : lvalue { return $blah }
508
509     sub bad_id  : lvalue { return ${\shift} }
510     sub bad_id1 : lvalue { return $_[0] }
511     sub bad_inc : lvalue { return ${\++$_[0]} }
512
513     $in = 5;
514     $blah = 3;
515
516     bad_get_st = 7;
517
518     is( $blah, 7 );
519
520     bad_get_lex = 7;
521
522     is($in, 7, "yada");
523
524     ++bad_get_st;
525
526     is($blah, 8, "yada");
527
528     ++bad_get_lex;
529     cmp_ok($in, '==', 8);
530
531     bad_id(bad_get_st) = 10;
532     cmp_ok($blah, '==', 10);
533
534     bad_id(bad_get_lex) = 10;
535     cmp_ok($in, '==', 10);
536
537     ++bad_id(bad_get_st);
538     cmp_ok($blah, '==', 11);
539
540     ++bad_id(bad_get_lex);
541     cmp_ok($in, '==', 11);
542
543     bad_id1(bad_get_st) = 20;
544     cmp_ok($blah, '==', 20);
545
546     bad_id1(bad_get_lex) = 20;
547     cmp_ok($in, '==', 20);
548
549     ++bad_id1(bad_get_st);
550     cmp_ok($blah, '==', 21);
551
552     ++bad_id1(bad_get_lex);
553     cmp_ok($in, '==', 21);
554
555     bad_inc(bad_get_st);
556     cmp_ok($blah, '==', 22);
557
558     bad_inc(bad_get_lex);
559     cmp_ok($in, '==', 22);
560
561     bad_inc(bad_id(bad_get_st));
562     cmp_ok($blah, '==', 23);
563
564     bad_inc(bad_id(bad_get_lex));
565     cmp_ok($in, '==', 23);
566
567     ++bad_inc(bad_id1(bad_id(bad_get_st)));
568     cmp_ok($blah, '==', 25);
569
570     ++bad_inc(bad_id1(bad_id(bad_get_lex)));
571     cmp_ok($in, '==', 25);
572
573     # Recursive
574     my $r;
575     my $to_modify;
576     $r = sub :lvalue {
577       my $depth = shift//0;
578       if ($depth == 2) { return $to_modify }
579       return &$r($depth+1);
580     };
581     &$r(0) = 7;
582     is $to_modify, 7, 'recursive lvalue sub';
583
584     # Recursive with substr [perl #72706]
585     my $val = '';
586     my $pie;
587     $pie = sub :lvalue {
588         my $depth = shift;
589         return &$pie($depth) if $depth--;
590         substr $val, 0;
591     };
592     for my $depth (0, 1, 2) {
593         my $value = "Good $depth";
594         eval {
595             &$pie($depth) = $value;
596         };
597         is($@, '', "recursive lvalue substr return depth $depth");
598         is($val, $value,
599            "value assigned to recursive lvalue substr (depth $depth)");
600     }
601 }
602
603 { # bug #23790
604     my @arr  = qw /one two three/;
605     my $line = "zero";
606     sub lval_array () : lvalue {@arr}
607
608     for (lval_array) {
609         $line .= $_;
610     }
611
612     is($line, "zeroonetwothree");
613
614     sub trythislval { scalar(@_)."x".join "", @_ }
615     is(trythislval(lval_array()), "3xonetwothree");
616
617     sub changeme { $_[2] = "free" }
618     changeme(lval_array);
619     is("@arr", "one two free");
620
621     # test again, with explicit return
622     sub rlval_array() : lvalue {return @arr}
623     @arr  = qw /one two three/;
624     $line = "zero";
625     for (rlval_array) {
626         $line .= $_;
627     }
628     is($line, "zeroonetwothree");
629     is(trythislval(rlval_array()), "3xonetwothree");
630     changeme(rlval_array);
631     is("@arr", "one two free");
632
633     # Variations on the same theme, with multiple vars returned
634     my $scalar = 'half';
635     sub lval_scalar_array () : lvalue { $scalar, @arr }
636     @arr  = qw /one two three/;
637     $line = "zero";
638     for (lval_scalar_array) {
639         $line .= $_;
640     }
641     is($line, "zerohalfonetwothree");
642     is(trythislval(lval_scalar_array()), "4xhalfonetwothree");
643     changeme(lval_scalar_array);
644     is("@arr", "one free three");
645
646     sub lval_array_scalar () : lvalue { @arr, $scalar }
647     @arr  = qw /one two three/;
648     $line = "zero";
649     $scalar = 'four';
650     for (lval_array_scalar) {
651         $line .= $_;
652     }
653     is($line, "zeroonetwothreefour");
654     is(trythislval(lval_array_scalar()), "4xonetwothreefour");
655     changeme(lval_array_scalar);
656     is("@arr", "one two free");
657
658     # Tests for specific ops not tested above
659     # rv2av
660     @array2 = qw 'one two free';
661     is join(',', map $_, sub:lvalue{@array2}->()), 'one,two,free',
662       'rv2av in reference context';
663     is join(',', map $_, sub:lvalue{@{\@array2}}->()), 'one,two,free',
664       'rv2av-with-ref in reference context';
665     # padhv
666     my %hash = qw[a b c d];
667     like join(',', map $_, sub:lvalue{%hash}->()),
668          qr/^(?:a,b,c,d|c,d,a,b)\z/, 'padhv in reference context';
669     # rv2hv
670     %hash2 = qw[a b c d];
671     like join(',', map $_, sub:lvalue{%hash2}->()),
672          qr/^(?:a,b,c,d|c,d,a,b)\z/, 'rv2hv in reference context';
673     like join(',', map $_, sub:lvalue{%{\%hash2}}->()),
674          qr/^(?:a,b,c,d|c,d,a,b)\z/, 'rv2hv-with-ref in reference context';
675 }
676
677 {
678     package Foo;
679     sub AUTOLOAD :lvalue { *{$AUTOLOAD} };
680     package main;
681     my $foo = bless {},"Foo";
682     my $result;
683     $foo->bar = sub { $result = "bar" };
684     $foo->bar;
685     is ($result, 'bar', "RT #41550");
686 }
687
688 fresh_perl_is(<<'----', <<'====', "lvalue can not be set after definition. [perl #68758]");
689 use warnings;
690 our $x;
691 sub foo { $x }
692 sub foo : lvalue;
693 foo = 3;
694 ----
695 lvalue attribute ignored after the subroutine has been defined at - line 4.
696 Can't modify non-lvalue subroutine call in scalar assignment at - line 5, near "3;"
697 Execution of - aborted due to compilation errors.
698 ====
699
700 {
701     my $x;
702     sub lval_decl : lvalue;
703     sub lval_decl { $x }
704     lval_decl = 5;
705     is($x, 5, "subroutine declared with lvalue before definition retains lvalue. [perl #68758]");
706 }
707
708 sub fleen : lvalue { $pnare }
709 $pnare = __PACKAGE__;
710 ok eval { fleen = 1 }, "lvalues can return COWs (CATTLE?) [perl #75656]";\
711 is $pnare, 1, 'and returning CATTLE actually works';
712 $pnare = __PACKAGE__;
713 ok eval { (fleen) = 1 }, "lvalues can return COWs in list context";
714 is $pnare, 1, 'and returning COWs in list context actually works';
715 $pnare = __PACKAGE__;
716 ok eval { $_ = 1 for(fleen); 1 }, "lvalues can return COWs in ref cx";
717 is $pnare, 1, 'and returning COWs in reference context actually works';
718
719
720 # Returning an arbitrary expression, not necessarily lvalue
721 +sub :lvalue { return $ambaga || $ambaga }->() = 73;
722 is $ambaga, 73, 'explicit return of arbitrary expression (scalar context)';
723 (sub :lvalue { return $ambaga || $ambaga }->()) = 74;
724 is $ambaga, 74, 'explicit return of arbitrary expression (list context)';
725 +sub :lvalue { $ambaga || $ambaga }->() = 73;
726 is $ambaga, 73, 'implicit return of arbitrary expression (scalar context)';
727 (sub :lvalue { $ambaga || $ambaga }->()) = 74;
728 is $ambaga, 74, 'implicit return of arbitrary expression (list context)';
729 { local $::TODO = 'return needs to enforce the same rules as leavesublv';
730 eval { +sub :lvalue { return 3 }->() = 4 };
731 like $@, qr/Can\'t return a readonly value from lvalue subroutine at/,
732       'assignment to numeric constant explicitly returned from lv sub';
733 eval { (sub :lvalue { return 3 }->()) = 4 };
734 like $@, qr/Can\'t return a readonly value from lvalue subroutine at/,
735       'assignment to num constant explicitly returned (list cx)';
736 }
737 eval { +sub :lvalue { 3 }->() = 4 };
738 like $@, qr/Can\'t return a readonly value from lvalue subroutine at/,
739       'assignment to numeric constant implicitly returned from lv sub';
740 eval { (sub :lvalue { 3 }->()) = 4 };
741 like $@, qr/Can\'t return a readonly value from lvalue subroutine at/,
742       'assignment to num constant implicitly returned (list cx)';
743
744 # reference (potential lvalue) context
745 $suffix = '';
746 for my $sub (sub :lvalue {$_}, sub :lvalue {return $_}) {
747     &$sub()->${\sub { $_[0] = 37 }};
748     is $_, '37', 'lvalue->method'.$suffix;
749     ${\scalar &$sub()} = 38;
750     is $_, '38', 'scalar(lvalue)'.$suffix;
751     sub assign39_with_proto ($) { $_[0] = 39 }
752     assign39_with_proto(&$sub());
753     is $_, '39', 'func(lvalue) when func has $ proto'.$suffix;
754     $_ = 1;
755     ${\(&$sub()||undef)} = 40;
756     is $_, '40', 'lvalue||...'.$suffix;
757     ${\(${\undef}||&$sub())} = 41; # extra ${\...} to bypass const folding
758     is $_, '41', '...||lvalue'.$suffix;
759     $_ = 0;
760     ${\(&$sub()&&undef)} = 42;
761     is $_, '42', 'lvalue&&...'.$suffix;
762     ${\(${\1}&&&$sub())} = 43;
763     is $_, '43', '...&&lvalue'.$suffix;
764     ${\(&$sub())[0]} = 44;
765     is $_, '44', '(lvalue)[0]'.$suffix;
766 }
767 continue { $suffix = ' (explicit return)' }
768
769 # autovivification
770 $suffix = '';
771 for my $sub (sub :lvalue {$_}, sub :lvalue {return $_}) {
772     undef $_;
773     &$sub()->[3] = 4;
774     is $_->[3], 4, 'func->[...] autovivification'.$suffix;
775     undef $_;
776     &$sub()->{3} = 4;
777     is $_->{3}, 4, 'func->{...} autovivification'.$suffix;
778     undef $_;
779     ${&$sub()} = 4;
780     is $$_, 4, '${func()} autovivification'      .$suffix;
781     undef $_;
782     @{&$sub()} = 4;
783     is "@$_", 4, '@{func()} autovivification'    .$suffix;
784     undef $_;
785     %{&$sub()} = (4,5);
786     is join('-',%$_), '4-5', '%{func()} autovivification'.$suffix;
787 }
788 continue { $suffix = ' (explicit return)' }
789
790 # [perl #92406] [perl #92290] Returning a pad var in rvalue context
791 $suffix = '';
792 for my $sub (
793          sub :lvalue { my $x = 72; $x },
794          sub :lvalue { my $x = 72; return $x }
795 ) {
796     is scalar(&$sub), 72, "sub returning pad var in scalar context$suffix";
797     is +(&$sub)[0], 72, "sub returning pad var in list context$suffix";
798 }
799 continue { $suffix = ' (explicit return)' }