Commit | Line | Data |
---|---|---|
cd06dffe GS |
1 | BEGIN { |
2 | chdir 't' if -d 't'; | |
20822f61 | 3 | @INC = '../lib'; |
cb949c37 | 4 | require './test.pl'; |
cd06dffe | 5 | } |
3885a45a | 6 | plan tests=>207; |
cd06dffe | 7 | |
78f9721b SM |
8 | sub a : lvalue { my $a = 34; ${\(bless \$a)} } # Return a temporary |
9 | sub b : lvalue { ${\shift} } | |
cd06dffe GS |
10 | |
11 | my $out = a(b()); # Check that temporaries are allowed. | |
cb949c37 | 12 | is(ref $out, 'main'); # Not reached if error. |
cd06dffe GS |
13 | |
14 | my @out = grep /main/, a(b()); # Check that temporaries are allowed. | |
cb949c37 | 15 | cmp_ok(scalar @out, '==', 1); # Not reached if error. |
cd06dffe GS |
16 | |
17 | my $in; | |
18 | ||
19 | # Check that we can return localized values from subroutines: | |
20 | ||
a98df962 GS |
21 | sub in : lvalue { $in = shift; } |
22 | sub neg : lvalue { #(num_str) return num_str | |
cd06dffe GS |
23 | local $_ = shift; |
24 | s/^\+/-/; | |
25 | $_; | |
26 | } | |
27 | in(neg("+2")); | |
28 | ||
29 | ||
cb949c37 | 30 | is($in, '-2'); |
cd06dffe | 31 | |
a98df962 GS |
32 | sub get_lex : lvalue { $in } |
33 | sub get_st : lvalue { $blah } | |
78f9721b | 34 | sub id : lvalue { ${\shift} } |
a98df962 | 35 | sub id1 : lvalue { $_[0] } |
78f9721b | 36 | sub inc : lvalue { ${\++$_[0]} } |
cd06dffe GS |
37 | |
38 | $in = 5; | |
39 | $blah = 3; | |
40 | ||
41 | get_st = 7; | |
42 | ||
cb949c37 | 43 | cmp_ok($blah, '==', 7); |
cd06dffe GS |
44 | |
45 | get_lex = 7; | |
46 | ||
cb949c37 | 47 | cmp_ok($in, '==', 7); |
cd06dffe GS |
48 | |
49 | ++get_st; | |
50 | ||
cb949c37 | 51 | cmp_ok($blah, '==', 8); |
cd06dffe GS |
52 | |
53 | ++get_lex; | |
54 | ||
cb949c37 | 55 | cmp_ok($in, '==', 8); |
cd06dffe GS |
56 | |
57 | id(get_st) = 10; | |
58 | ||
cb949c37 | 59 | cmp_ok($blah, '==', 10); |
cd06dffe GS |
60 | |
61 | id(get_lex) = 10; | |
62 | ||
cb949c37 | 63 | cmp_ok($in, '==', 10); |
cd06dffe GS |
64 | |
65 | ++id(get_st); | |
66 | ||
cb949c37 | 67 | cmp_ok($blah, '==', 11); |
cd06dffe GS |
68 | |
69 | ++id(get_lex); | |
70 | ||
cb949c37 | 71 | cmp_ok($in, '==', 11); |
cd06dffe GS |
72 | |
73 | id1(get_st) = 20; | |
74 | ||
cb949c37 | 75 | cmp_ok($blah, '==', 20); |
cd06dffe GS |
76 | |
77 | id1(get_lex) = 20; | |
78 | ||
cb949c37 | 79 | cmp_ok($in, '==', 20); |
cd06dffe GS |
80 | |
81 | ++id1(get_st); | |
82 | ||
cb949c37 | 83 | cmp_ok($blah, '==', 21); |
cd06dffe GS |
84 | |
85 | ++id1(get_lex); | |
86 | ||
cb949c37 | 87 | cmp_ok($in, '==', 21); |
cd06dffe GS |
88 | |
89 | inc(get_st); | |
90 | ||
cb949c37 | 91 | cmp_ok($blah, '==', 22); |
cd06dffe GS |
92 | |
93 | inc(get_lex); | |
94 | ||
cb949c37 | 95 | cmp_ok($in, '==', 22); |
cd06dffe GS |
96 | |
97 | inc(id(get_st)); | |
98 | ||
cb949c37 | 99 | cmp_ok($blah, '==', 23); |
cd06dffe GS |
100 | |
101 | inc(id(get_lex)); | |
102 | ||
cb949c37 | 103 | cmp_ok($in, '==', 23); |
cd06dffe GS |
104 | |
105 | ++inc(id1(id(get_st))); | |
106 | ||
cb949c37 | 107 | cmp_ok($blah, '==', 25); |
cd06dffe GS |
108 | |
109 | ++inc(id1(id(get_lex))); | |
110 | ||
cb949c37 | 111 | cmp_ok($in, '==', 25); |
cd06dffe GS |
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 | ||
a98df962 GS |
121 | sub a3 :lvalue {@a} |
122 | sub b2 : lvalue {@b} | |
123 | sub c4: lvalue {@c} | |
cd06dffe GS |
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); | |
2fe1f0f5 | 134 | #print "# '@out' ne '@in'\nnot " unless "@out" eq "@in"; |
cd06dffe | 135 | |
cb949c37 NC |
136 | like($_, qr/Can\'t return an uninitialized value from lvalue subroutine/); |
137 | print "ok 22\n"; | |
138 | ||
cd06dffe GS |
139 | =cut |
140 | ||
cd06dffe GS |
141 | |
142 | my $var; | |
143 | ||
a98df962 | 144 | sub a::var : lvalue { $var } |
cd06dffe GS |
145 | |
146 | "a"->var = 45; | |
147 | ||
cb949c37 | 148 | cmp_ok($var, '==', 45); |
cd06dffe GS |
149 | |
150 | my $oo; | |
151 | $o = bless \$oo, "a"; | |
152 | ||
153 | $o->var = 47; | |
154 | ||
cb949c37 | 155 | cmp_ok($var, '==', 47); |
cd06dffe | 156 | |
a98df962 | 157 | sub o : lvalue { $o } |
cd06dffe GS |
158 | |
159 | o->var = 49; | |
160 | ||
cb949c37 | 161 | cmp_ok($var, '==', 49); |
cd06dffe GS |
162 | |
163 | sub nolv () { $x0, $x1 } # Not lvalue | |
164 | ||
165 | $_ = ''; | |
166 | ||
167 | eval <<'EOE' or $_ = $@; | |
168 | nolv = (2,3); | |
169 | 1; | |
170 | EOE | |
171 | ||
cb949c37 | 172 | like($_, qr/Can\'t modify non-lvalue subroutine call in scalar assignment/); |
cd06dffe GS |
173 | |
174 | $_ = ''; | |
175 | ||
176 | eval <<'EOE' or $_ = $@; | |
177 | nolv = (2,3) if $_; | |
178 | 1; | |
179 | EOE | |
180 | ||
cb949c37 | 181 | like($_, qr/Can\'t modify non-lvalue subroutine call in scalar assignment/); |
cd06dffe GS |
182 | |
183 | $_ = ''; | |
184 | ||
185 | eval <<'EOE' or $_ = $@; | |
186 | &nolv = (2,3) if $_; | |
187 | 1; | |
188 | EOE | |
189 | ||
cb949c37 | 190 | like($_, qr/Can\'t modify non-lvalue subroutine call in scalar assignment/); |
cd06dffe GS |
191 | |
192 | $x0 = $x1 = $_ = undef; | |
193 | $nolv = \&nolv; | |
194 | ||
195 | eval <<'EOE' or $_ = $@; | |
196 | $nolv->() = (2,3) if $_; | |
197 | 1; | |
198 | EOE | |
199 | ||
cb949c37 | 200 | ok(!defined $_) or diag "'$_', '$x0', '$x1'"; |
cd06dffe GS |
201 | |
202 | $x0 = $x1 = $_ = undef; | |
203 | $nolv = \&nolv; | |
204 | ||
205 | eval <<'EOE' or $_ = $@; | |
206 | $nolv->() = (2,3); | |
207 | 1; | |
208 | EOE | |
209 | ||
cb949c37 NC |
210 | like($_, qr/Can\'t modify non-lvalue subroutine call/) |
211 | or diag "'$_', '$x0', '$x1'"; | |
cd06dffe | 212 | |
e2316ad3 | 213 | sub lv0 : lvalue { } |
d25b0d7b | 214 | sub rlv0 : lvalue { return } |
cd06dffe GS |
215 | |
216 | $_ = undef; | |
217 | eval <<'EOE' or $_ = $@; | |
218 | lv0 = (2,3); | |
219 | 1; | |
220 | EOE | |
221 | ||
c73030b8 | 222 | like($_, qr/Can't return undef from lvalue subroutine/); |
cd06dffe | 223 | |
cd06dffe GS |
224 | $_ = undef; |
225 | eval <<'EOE' or $_ = $@; | |
d25b0d7b FC |
226 | rlv0 = (2,3); |
227 | 1; | |
228 | EOE | |
229 | ||
230 | like($_, qr/Can't return undef from lvalue subroutine/, | |
231 | 'explicit return of nothing in scalar context'); | |
232 | ||
233 | $_ = undef; | |
234 | eval <<'EOE' or $_ = $@; | |
cd06dffe GS |
235 | (lv0) = (2,3); |
236 | 1; | |
237 | EOE | |
238 | ||
cb949c37 | 239 | ok(!defined $_) or diag $_; |
cd06dffe | 240 | |
d25b0d7b FC |
241 | $_ = undef; |
242 | eval <<'EOE' or $_ = $@; | |
243 | (rlv0) = (2,3); | |
244 | 1; | |
245 | EOE | |
246 | ||
247 | ok(!defined $_, 'explicit return of nothing in list context') or diag $_; | |
248 | ||
69b22cd1 FC |
249 | ($a,$b)=(); |
250 | (lv0($a,$b)) = (3,4); | |
251 | is +($a//'undef') . ($b//'undef'), 'undefundef', | |
252 | 'list assignment to empty lvalue sub'; | |
253 | ||
254 | ||
a98df962 | 255 | sub lv1u :lvalue { undef } |
d25b0d7b | 256 | sub rlv1u :lvalue { undef } |
cd06dffe GS |
257 | |
258 | $_ = undef; | |
259 | eval <<'EOE' or $_ = $@; | |
260 | lv1u = (2,3); | |
261 | 1; | |
262 | EOE | |
263 | ||
c73030b8 | 264 | like($_, qr/Can't return undef from lvalue subroutine/); |
cd06dffe GS |
265 | |
266 | $_ = undef; | |
267 | eval <<'EOE' or $_ = $@; | |
d25b0d7b FC |
268 | rlv1u = (2,3); |
269 | 1; | |
270 | EOE | |
271 | ||
272 | like($_, qr/Can't return undef from lvalue subroutine/, | |
273 | 'explicitly returning undef in scalar context'); | |
274 | ||
275 | $_ = undef; | |
276 | eval <<'EOE' or $_ = $@; | |
cd06dffe GS |
277 | (lv1u) = (2,3); |
278 | 1; | |
279 | EOE | |
280 | ||
730fb7e7 FC |
281 | ok(!defined, 'implicitly returning undef in list context'); |
282 | ||
283 | $_ = undef; | |
284 | eval <<'EOE' or $_ = $@; | |
285 | (rlv1u) = (2,3); | |
286 | 1; | |
287 | EOE | |
288 | ||
289 | ok(!defined, 'explicitly returning undef in list context'); | |
cd06dffe GS |
290 | |
291 | $x = '1234567'; | |
cd06dffe GS |
292 | |
293 | $_ = undef; | |
294 | eval <<'EOE' or $_ = $@; | |
78f9721b | 295 | sub lv1t : lvalue { index $x, 2 } |
cd06dffe GS |
296 | lv1t = (2,3); |
297 | 1; | |
298 | EOE | |
299 | ||
145b2bbb | 300 | like($_, qr/Can\'t return a temporary from lvalue subroutine/); |
cd06dffe GS |
301 | |
302 | $_ = undef; | |
d25b0d7b FC |
303 | eval <<'EOE' or $_ = $@; |
304 | sub rlv1t : lvalue { index $x, 2 } | |
305 | rlv1t = (2,3); | |
306 | 1; | |
307 | EOE | |
308 | ||
309 | like($_, qr/Can\'t return a temporary from lvalue subroutine/, | |
310 | 'returning a PADTMP explicitly'); | |
311 | ||
312 | $_ = undef; | |
313 | eval <<'EOE' or $_ = $@; | |
314 | (rlv1t) = (2,3); | |
315 | 1; | |
316 | EOE | |
317 | ||
318 | like($_, qr/Can\'t return a temporary from lvalue subroutine/, | |
319 | 'returning a PADTMP explicitly (list context)'); | |
320 | ||
32cbae3f FC |
321 | # These next two tests are not necessarily normative. But this way we will |
322 | # know if this discrepancy changes. | |
323 | ||
324 | $_ = undef; | |
325 | eval <<'EOE' or $_ = $@; | |
326 | sub scalarray : lvalue { @a || $b } | |
327 | @a = 1; | |
328 | (scalarray) = (2,3); | |
329 | 1; | |
330 | EOE | |
331 | ||
332 | like($_, qr/Can\'t return a temporary from lvalue subroutine/, | |
333 | 'returning a scalar-context array via ||'); | |
334 | ||
335 | $_ = undef; | |
336 | eval <<'EOE' or $_ = $@; | |
337 | use warnings "FATAL" => "all"; | |
338 | sub myscalarray : lvalue { my @a = 1; @a || $b } | |
339 | (myscalarray) = (2,3); | |
340 | 1; | |
341 | EOE | |
342 | ||
343 | like($_, qr/Useless assignment to a temporary/, | |
344 | 'returning a scalar-context lexical array via ||'); | |
345 | ||
d25b0d7b | 346 | $_ = undef; |
145b2bbb FC |
347 | sub lv2t : lvalue { shift } |
348 | (lv2t($_)) = (2,3); | |
349 | is($_, 2); | |
cd06dffe GS |
350 | |
351 | $xxx = 'xxx'; | |
352 | sub xxx () { $xxx } # Not lvalue | |
cd06dffe GS |
353 | |
354 | $_ = undef; | |
355 | eval <<'EOE' or $_ = $@; | |
78f9721b | 356 | sub lv1tmp : lvalue { xxx } # is it a TEMP? |
cd06dffe GS |
357 | lv1tmp = (2,3); |
358 | 1; | |
359 | EOE | |
360 | ||
da1dff94 | 361 | like($_, qr/Can\'t modify non-lvalue subroutine call at /); |
cd06dffe GS |
362 | |
363 | $_ = undef; | |
364 | eval <<'EOE' or $_ = $@; | |
365 | (lv1tmp) = (2,3); | |
366 | 1; | |
367 | EOE | |
368 | ||
da1dff94 | 369 | like($_, qr/Can\'t modify non-lvalue subroutine call at /); |
fd6c41ce | 370 | |
9a049f1c | 371 | sub yyy () { 'yyy' } # Const, not lvalue |
cd06dffe GS |
372 | |
373 | $_ = undef; | |
374 | eval <<'EOE' or $_ = $@; | |
78f9721b | 375 | sub lv1tmpr : lvalue { yyy } # is it read-only? |
cd06dffe GS |
376 | lv1tmpr = (2,3); |
377 | 1; | |
378 | EOE | |
379 | ||
145b2bbb | 380 | like($_, qr/Can\'t return a readonly value from lvalue subroutine at/); |
cd06dffe GS |
381 | |
382 | $_ = undef; | |
383 | eval <<'EOE' or $_ = $@; | |
384 | (lv1tmpr) = (2,3); | |
385 | 1; | |
386 | EOE | |
387 | ||
cb949c37 | 388 | like($_, qr/Can\'t return a readonly value from lvalue subroutine/); |
3885a45a FC |
389 | |
390 | eval <<'EOF'; | |
391 | sub lv2tmpr : lvalue { my $x = *foo; Internals::SvREADONLY $x, 1; $x } | |
392 | lv2tmpr = (2,3); | |
393 | EOF | |
394 | ||
395 | like($@, qr/Can\'t return a readonly value from lvalue subroutine at/); | |
396 | ||
397 | eval <<'EOG'; | |
398 | (lv2tmpr) = (2,3); | |
399 | EOG | |
400 | ||
401 | like($@, qr/Can\'t return a readonly value from lvalue subroutine/); | |
cd06dffe | 402 | |
a98df962 | 403 | sub lva : lvalue {@a} |
cd06dffe GS |
404 | |
405 | $_ = undef; | |
406 | @a = (); | |
407 | $a[1] = 12; | |
408 | eval <<'EOE' or $_ = $@; | |
409 | (lva) = (2,3); | |
410 | 1; | |
411 | EOE | |
412 | ||
cb949c37 | 413 | is("'@a' $_", "'2 3' "); |
cd06dffe GS |
414 | |
415 | $_ = undef; | |
416 | @a = (); | |
417 | $a[0] = undef; | |
418 | $a[1] = 12; | |
419 | eval <<'EOE' or $_ = $@; | |
420 | (lva) = (2,3); | |
421 | 1; | |
422 | EOE | |
423 | ||
cb949c37 | 424 | is("'@a' $_", "'2 3' "); |
cd06dffe | 425 | |
40c94d11 FC |
426 | is lva->${\sub { return $_[0] }}, 2, |
427 | 'lvalue->$thing when lvalue returns array'; | |
428 | ||
429 | my @my = qw/ a b c /; | |
430 | sub lvmya : lvalue { @my } | |
431 | ||
432 | is lvmya->${\sub { return $_[0] }}, 3, | |
433 | 'lvalue->$thing when lvalue returns lexical array'; | |
434 | ||
a98df962 | 435 | sub lv1n : lvalue { $newvar } |
cd06dffe GS |
436 | |
437 | $_ = undef; | |
438 | eval <<'EOE' or $_ = $@; | |
439 | lv1n = (3,4); | |
440 | 1; | |
441 | EOE | |
442 | ||
cb949c37 | 443 | is("'$newvar' $_", "'4' "); |
cd06dffe | 444 | |
a98df962 | 445 | sub lv1nn : lvalue { $nnewvar } |
cd06dffe GS |
446 | |
447 | $_ = undef; | |
448 | eval <<'EOE' or $_ = $@; | |
449 | (lv1nn) = (3,4); | |
450 | 1; | |
451 | EOE | |
452 | ||
cb949c37 | 453 | is("'$nnewvar' $_", "'3' "); |
cd06dffe GS |
454 | |
455 | $a = \&lv1nn; | |
456 | $a->() = 8; | |
cb949c37 | 457 | is($nnewvar, '8'); |
d32f2495 | 458 | |
84251760 | 459 | eval 'sub AUTOLOAD : lvalue { $newvar }'; |
d32f2495 | 460 | foobar() = 12; |
cb949c37 | 461 | is($newvar, "12"); |
26191e78 | 462 | |
da1dff94 FC |
463 | # But autoloading should only be triggered by a call to an undefined |
464 | # subroutine. | |
465 | &{"lv1nn"} = 14; | |
466 | is $newvar, 12, 'AUTOLOAD does not take precedence over lvalue sub'; | |
467 | eval { &{"xxx"} = 14 }; | |
468 | is $newvar, 12, 'AUTOLOAD does not take precedence over non-lvalue sub'; | |
469 | ||
78f9721b SM |
470 | { |
471 | my %hash; my @array; | |
472 | sub alv : lvalue { $array[1] } | |
473 | sub alv2 : lvalue { $array[$_[0]] } | |
474 | sub hlv : lvalue { $hash{"foo"} } | |
475 | sub hlv2 : lvalue { $hash{$_[0]} } | |
476 | $array[1] = "not ok 51\n"; | |
477 | alv() = "ok 50\n"; | |
cb949c37 | 478 | is(alv(), "ok 50\n"); |
78f9721b SM |
479 | |
480 | alv2(20) = "ok 51\n"; | |
cb949c37 | 481 | is($array[20], "ok 51\n"); |
78f9721b SM |
482 | |
483 | $hash{"foo"} = "not ok 52\n"; | |
484 | hlv() = "ok 52\n"; | |
cb949c37 | 485 | is($hash{foo}, "ok 52\n"); |
78f9721b SM |
486 | |
487 | $hash{bar} = "not ok 53\n"; | |
488 | hlv("bar") = "ok 53\n"; | |
cb949c37 | 489 | is(hlv("bar"), "ok 53\n"); |
78f9721b SM |
490 | |
491 | sub array : lvalue { @array } | |
492 | sub array2 : lvalue { @array2 } # This is a global. | |
493 | sub hash : lvalue { %hash } | |
494 | sub hash2 : lvalue { %hash2 } # So's this. | |
495 | @array2 = qw(foo bar); | |
496 | %hash2 = qw(foo bar); | |
497 | ||
498 | (array()) = qw(ok 54); | |
cb949c37 | 499 | is("@array", "ok 54"); |
78f9721b SM |
500 | |
501 | (array2()) = qw(ok 55); | |
cb949c37 | 502 | is("@array2", "ok 55"); |
78f9721b SM |
503 | |
504 | (hash()) = qw(ok 56); | |
cb949c37 | 505 | cmp_ok($hash{ok}, '==', 56); |
78f9721b SM |
506 | |
507 | (hash2()) = qw(ok 57); | |
cb949c37 | 508 | cmp_ok($hash2{ok}, '==', 57); |
78f9721b SM |
509 | |
510 | @array = qw(a b c d); | |
511 | sub aslice1 : lvalue { @array[0,2] }; | |
512 | (aslice1()) = ("ok", "already"); | |
cb949c37 | 513 | is("@array", "ok b already d"); |
78f9721b SM |
514 | |
515 | @array2 = qw(a B c d); | |
516 | sub aslice2 : lvalue { @array2[0,2] }; | |
517 | (aslice2()) = ("ok", "already"); | |
cb949c37 | 518 | is("@array2", "ok B already d"); |
78f9721b SM |
519 | |
520 | %hash = qw(a Alpha b Beta c Gamma); | |
521 | sub hslice : lvalue { @hash{"c", "b"} } | |
522 | (hslice()) = ("CISC", "BogoMIPS"); | |
cb949c37 | 523 | is(join("/",@hash{"c","a","b"}), "CISC/Alpha/BogoMIPS"); |
78f9721b SM |
524 | } |
525 | ||
526 | $str = "Hello, world!"; | |
527 | sub sstr : lvalue { substr($str, 1, 4) } | |
528 | sstr() = "i"; | |
cb949c37 | 529 | is($str, "Hi, world!"); |
78f9721b SM |
530 | |
531 | $str = "Made w/ JavaScript"; | |
532 | sub veclv : lvalue { vec($str, 2, 32) } | |
e6b8b224 PP |
533 | if (ord('A') != 193) { |
534 | veclv() = 0x5065726C; | |
535 | } | |
536 | else { # EBCDIC? | |
537 | veclv() = 0xD7859993; | |
538 | } | |
cb949c37 | 539 | is($str, "Made w/ PerlScript"); |
78f9721b SM |
540 | |
541 | sub position : lvalue { pos } | |
542 | @p = (); | |
543 | $_ = "fee fi fo fum"; | |
544 | while (/f/g) { | |
545 | push @p, position; | |
546 | position() += 6; | |
547 | } | |
cb949c37 | 548 | is("@p", "1 8"); |
7c8af4ef | 549 | |
fad4a2e4 FC |
550 | sub keeze : lvalue { keys %__ } |
551 | %__ = ("a","b"); | |
552 | keeze = 64; | |
553 | is scalar %__, '1/64', 'keys assignment through lvalue sub'; | |
554 | ||
7c8af4ef RG |
555 | # Bug 20001223.002: split thought that the list had only one element |
556 | @ary = qw(4 5 6); | |
557 | sub lval1 : lvalue { $ary[0]; } | |
558 | sub lval2 : lvalue { $ary[1]; } | |
559 | (lval1(), lval2()) = split ' ', "1 2 3 4"; | |
cb949c37 NC |
560 | |
561 | is(join(':', @ary), "1:2:6"); | |
1c4274f4 | 562 | |
f9bc45ef TP |
563 | # check that an element of a tied hash/array can be assigned to via lvalueness |
564 | ||
565 | package Tie_Hash; | |
566 | ||
567 | our ($key, $val); | |
568 | sub TIEHASH { bless \my $v => __PACKAGE__ } | |
569 | sub STORE { ($key, $val) = @_[1,2] } | |
570 | ||
571 | package main; | |
572 | sub lval_tie_hash : lvalue { | |
573 | tie my %t => 'Tie_Hash'; | |
574 | $t{key}; | |
575 | } | |
576 | ||
577 | eval { lval_tie_hash() = "value"; }; | |
578 | ||
cb949c37 | 579 | is($@, "", "element of tied hash"); |
f9bc45ef | 580 | |
cb949c37 | 581 | is("$Tie_Hash::key-$Tie_Hash::val", "key-value"); |
f9bc45ef TP |
582 | |
583 | ||
584 | package Tie_Array; | |
585 | ||
586 | our @val; | |
587 | sub TIEARRAY { bless \my $v => __PACKAGE__ } | |
588 | sub STORE { $val[ $_[1] ] = $_[2] } | |
589 | ||
590 | package main; | |
591 | sub lval_tie_array : lvalue { | |
592 | tie my @t => 'Tie_Array'; | |
593 | $t[0]; | |
594 | } | |
595 | ||
596 | eval { lval_tie_array() = "value"; }; | |
597 | ||
f9bc45ef | 598 | |
cb949c37 | 599 | is($@, "", "element of tied array"); |
f9bc45ef | 600 | |
cb949c37 | 601 | is ($Tie_Array::val[0], "value"); |
1c4274f4 | 602 | |
1c4274f4 | 603 | |
4bee03f8 FC |
604 | # Check that tied pad vars that are returned can be assigned to |
605 | sub TIESCALAR { bless [] } | |
606 | sub STORE {$wheel = $_[1]} | |
607 | sub FETCH {$wheel} | |
608 | sub tied_pad_var :lvalue { tie my $tyre, ''; $tyre } | |
609 | sub tied_pad_varr :lvalue { tie my $tyre, ''; return $tyre } | |
610 | tied_pad_var = 1; | |
611 | is $wheel, 1, 'tied pad var returned in scalar lvalue context'; | |
612 | tied_pad_var->${\sub{ $_[0] = 2 }}; | |
613 | is $wheel, 2, 'tied pad var returned in scalar ref context'; | |
614 | (tied_pad_var) = 3; | |
615 | is $wheel, 3, 'tied pad var returned in list lvalue context'; | |
616 | $_ = 4 for tied_pad_var; | |
617 | is $wheel, 4, 'tied pad var returned in list ref context'; | |
618 | tied_pad_varr = 5; | |
619 | is $wheel, 5, 'tied pad var explicitly returned in scalar lvalue context'; | |
620 | tied_pad_varr->${\sub{ $_[0] = 6 }}; | |
621 | is $wheel, 6, 'tied pad var explicitly returned in scalar ref context'; | |
622 | (tied_pad_varr) = 7; | |
623 | is $wheel, 7, 'tied pad var explicitly returned in list lvalue context'; | |
624 | $_ = 8 for tied_pad_varr; | |
625 | is $wheel, 8, 'tied pad var explicitly returned in list ref context'; | |
626 | ||
627 | ||
fa1e92c4 FC |
628 | # Test explicit return of lvalue expression |
629 | { | |
630 | # subs are copies from tests 1-~18 with an explicit return added. | |
631 | # They used not to work, which is why they are ‘badly’ named. | |
1c4274f4 MS |
632 | sub bad_get_lex : lvalue { return $in }; |
633 | sub bad_get_st : lvalue { return $blah } | |
634 | ||
635 | sub bad_id : lvalue { return ${\shift} } | |
636 | sub bad_id1 : lvalue { return $_[0] } | |
637 | sub bad_inc : lvalue { return ${\++$_[0]} } | |
638 | ||
639 | $in = 5; | |
640 | $blah = 3; | |
641 | ||
642 | bad_get_st = 7; | |
643 | ||
644 | is( $blah, 7 ); | |
645 | ||
646 | bad_get_lex = 7; | |
647 | ||
648 | is($in, 7, "yada"); | |
649 | ||
650 | ++bad_get_st; | |
651 | ||
652 | is($blah, 8, "yada"); | |
07fd1c9c FC |
653 | |
654 | ++bad_get_lex; | |
655 | cmp_ok($in, '==', 8); | |
656 | ||
657 | bad_id(bad_get_st) = 10; | |
658 | cmp_ok($blah, '==', 10); | |
659 | ||
660 | bad_id(bad_get_lex) = 10; | |
661 | cmp_ok($in, '==', 10); | |
662 | ||
663 | ++bad_id(bad_get_st); | |
664 | cmp_ok($blah, '==', 11); | |
665 | ||
666 | ++bad_id(bad_get_lex); | |
667 | cmp_ok($in, '==', 11); | |
668 | ||
669 | bad_id1(bad_get_st) = 20; | |
670 | cmp_ok($blah, '==', 20); | |
671 | ||
672 | bad_id1(bad_get_lex) = 20; | |
673 | cmp_ok($in, '==', 20); | |
674 | ||
675 | ++bad_id1(bad_get_st); | |
676 | cmp_ok($blah, '==', 21); | |
677 | ||
678 | ++bad_id1(bad_get_lex); | |
679 | cmp_ok($in, '==', 21); | |
680 | ||
681 | bad_inc(bad_get_st); | |
682 | cmp_ok($blah, '==', 22); | |
683 | ||
684 | bad_inc(bad_get_lex); | |
685 | cmp_ok($in, '==', 22); | |
686 | ||
687 | bad_inc(bad_id(bad_get_st)); | |
688 | cmp_ok($blah, '==', 23); | |
689 | ||
690 | bad_inc(bad_id(bad_get_lex)); | |
691 | cmp_ok($in, '==', 23); | |
692 | ||
693 | ++bad_inc(bad_id1(bad_id(bad_get_st))); | |
694 | cmp_ok($blah, '==', 25); | |
695 | ||
696 | ++bad_inc(bad_id1(bad_id(bad_get_lex))); | |
697 | cmp_ok($in, '==', 25); | |
1ffdc07c FC |
698 | |
699 | # Recursive | |
700 | my $r; | |
701 | my $to_modify; | |
702 | $r = sub :lvalue { | |
703 | my $depth = shift//0; | |
704 | if ($depth == 2) { return $to_modify } | |
705 | return &$r($depth+1); | |
706 | }; | |
707 | &$r(0) = 7; | |
708 | is $to_modify, 7, 'recursive lvalue sub'; | |
f6a9f8a4 FC |
709 | |
710 | # Recursive with substr [perl #72706] | |
711 | my $val = ''; | |
712 | my $pie; | |
713 | $pie = sub :lvalue { | |
714 | my $depth = shift; | |
715 | return &$pie($depth) if $depth--; | |
716 | substr $val, 0; | |
717 | }; | |
718 | for my $depth (0, 1, 2) { | |
719 | my $value = "Good $depth"; | |
720 | eval { | |
721 | &$pie($depth) = $value; | |
722 | }; | |
723 | is($@, '', "recursive lvalue substr return depth $depth"); | |
724 | is($val, $value, | |
725 | "value assigned to recursive lvalue substr (depth $depth)"); | |
726 | } | |
1c4274f4 MS |
727 | } |
728 | ||
91e34d82 | 729 | { # bug #23790 |
4546bcba RGS |
730 | my @arr = qw /one two three/; |
731 | my $line = "zero"; | |
732 | sub lval_array () : lvalue {@arr} | |
733 | ||
734 | for (lval_array) { | |
735 | $line .= $_; | |
736 | } | |
737 | ||
738 | is($line, "zeroonetwothree"); | |
91e34d82 MP |
739 | |
740 | sub trythislval { scalar(@_)."x".join "", @_ } | |
741 | is(trythislval(lval_array()), "3xonetwothree"); | |
742 | ||
743 | sub changeme { $_[2] = "free" } | |
744 | changeme(lval_array); | |
745 | is("@arr", "one two free"); | |
40c94d11 FC |
746 | |
747 | # test again, with explicit return | |
748 | sub rlval_array() : lvalue {return @arr} | |
749 | @arr = qw /one two three/; | |
750 | $line = "zero"; | |
751 | for (rlval_array) { | |
752 | $line .= $_; | |
753 | } | |
754 | is($line, "zeroonetwothree"); | |
755 | is(trythislval(rlval_array()), "3xonetwothree"); | |
756 | changeme(rlval_array); | |
757 | is("@arr", "one two free"); | |
758 | ||
759 | # Variations on the same theme, with multiple vars returned | |
760 | my $scalar = 'half'; | |
761 | sub lval_scalar_array () : lvalue { $scalar, @arr } | |
762 | @arr = qw /one two three/; | |
763 | $line = "zero"; | |
764 | for (lval_scalar_array) { | |
765 | $line .= $_; | |
766 | } | |
767 | is($line, "zerohalfonetwothree"); | |
768 | is(trythislval(lval_scalar_array()), "4xhalfonetwothree"); | |
769 | changeme(lval_scalar_array); | |
770 | is("@arr", "one free three"); | |
771 | ||
772 | sub lval_array_scalar () : lvalue { @arr, $scalar } | |
773 | @arr = qw /one two three/; | |
774 | $line = "zero"; | |
775 | $scalar = 'four'; | |
776 | for (lval_array_scalar) { | |
777 | $line .= $_; | |
778 | } | |
779 | is($line, "zeroonetwothreefour"); | |
780 | is(trythislval(lval_array_scalar()), "4xonetwothreefour"); | |
781 | changeme(lval_array_scalar); | |
782 | is("@arr", "one two free"); | |
783 | ||
784 | # Tests for specific ops not tested above | |
785 | # rv2av | |
786 | @array2 = qw 'one two free'; | |
787 | is join(',', map $_, sub:lvalue{@array2}->()), 'one,two,free', | |
788 | 'rv2av in reference context'; | |
789 | is join(',', map $_, sub:lvalue{@{\@array2}}->()), 'one,two,free', | |
790 | 'rv2av-with-ref in reference context'; | |
791 | # padhv | |
792 | my %hash = qw[a b c d]; | |
793 | like join(',', map $_, sub:lvalue{%hash}->()), | |
794 | qr/^(?:a,b,c,d|c,d,a,b)\z/, 'padhv in reference context'; | |
795 | # rv2hv | |
796 | %hash2 = qw[a b c d]; | |
797 | like join(',', map $_, sub:lvalue{%hash2}->()), | |
798 | qr/^(?:a,b,c,d|c,d,a,b)\z/, 'rv2hv in reference context'; | |
799 | like join(',', map $_, sub:lvalue{%{\%hash2}}->()), | |
800 | qr/^(?:a,b,c,d|c,d,a,b)\z/, 'rv2hv-with-ref in reference context'; | |
4546bcba | 801 | } |
cb0d96b9 NC |
802 | |
803 | { | |
804 | package Foo; | |
805 | sub AUTOLOAD :lvalue { *{$AUTOLOAD} }; | |
806 | package main; | |
807 | my $foo = bless {},"Foo"; | |
808 | my $result; | |
809 | $foo->bar = sub { $result = "bar" }; | |
810 | $foo->bar; | |
811 | is ($result, 'bar', "RT #41550"); | |
812 | } | |
885ef6f5 | 813 | |
c70e3f2a | 814 | SKIP: { skip 'no attributes.pm', 1 unless eval 'require attributes'; |
20e5bab4 | 815 | fresh_perl_is(<<'----', <<'====', {}, "lvalue can not be set after definition. [perl #68758]"); |
885ef6f5 GG |
816 | use warnings; |
817 | our $x; | |
818 | sub foo { $x } | |
819 | sub foo : lvalue; | |
fff96ff7 FC |
820 | sub MODIFY_CODE_ATTRIBUTES {} |
821 | sub foo : lvalue : fr0g; | |
885ef6f5 GG |
822 | foo = 3; |
823 | ---- | |
824 | lvalue attribute ignored after the subroutine has been defined at - line 4. | |
fff96ff7 FC |
825 | lvalue attribute ignored after the subroutine has been defined at - line 6. |
826 | Can't modify non-lvalue subroutine call in scalar assignment at - line 7, near "3;" | |
885ef6f5 GG |
827 | Execution of - aborted due to compilation errors. |
828 | ==== | |
c70e3f2a | 829 | } |
eac910c8 GG |
830 | |
831 | { | |
832 | my $x; | |
833 | sub lval_decl : lvalue; | |
834 | sub lval_decl { $x } | |
835 | lval_decl = 5; | |
836 | is($x, 5, "subroutine declared with lvalue before definition retains lvalue. [perl #68758]"); | |
837 | } | |
f71f472f | 838 | |
c70e3f2a | 839 | SKIP: { skip "no attributes.pm", 2 unless eval { require attributes }; |
b4c6bb84 FC |
840 | sub utf8::valid :lvalue; |
841 | require attributes; | |
842 | is "@{[ &attributes::get(\&utf8::valid) ]}", 'lvalue', | |
4dbb339a FC |
843 | 'sub declaration with :lvalue applies it to XSUBs'; |
844 | ||
b4c6bb84 FC |
845 | BEGIN { *wonky = \&marjibberous } |
846 | sub wonky :lvalue; | |
847 | is "@{[ &attributes::get(\&wonky) ]}", 'lvalue', | |
4dbb339a | 848 | 'sub declaration with :lvalue applies it to assigned stub'; |
c70e3f2a | 849 | } |
4dbb339a | 850 | |
f71f472f FC |
851 | sub fleen : lvalue { $pnare } |
852 | $pnare = __PACKAGE__; | |
853 | ok eval { fleen = 1 }, "lvalues can return COWs (CATTLE?) [perl #75656]";\ | |
854 | is $pnare, 1, 'and returning CATTLE actually works'; | |
a0aa6076 FC |
855 | $pnare = __PACKAGE__; |
856 | ok eval { (fleen) = 1 }, "lvalues can return COWs in list context"; | |
857 | is $pnare, 1, 'and returning COWs in list context actually works'; | |
a1302723 FC |
858 | $pnare = __PACKAGE__; |
859 | ok eval { $_ = 1 for(fleen); 1 }, "lvalues can return COWs in ref cx"; | |
860 | is $pnare, 1, 'and returning COWs in reference context actually works'; | |
145b2bbb FC |
861 | |
862 | ||
863 | # Returning an arbitrary expression, not necessarily lvalue | |
864 | +sub :lvalue { return $ambaga || $ambaga }->() = 73; | |
865 | is $ambaga, 73, 'explicit return of arbitrary expression (scalar context)'; | |
866 | (sub :lvalue { return $ambaga || $ambaga }->()) = 74; | |
867 | is $ambaga, 74, 'explicit return of arbitrary expression (list context)'; | |
868 | +sub :lvalue { $ambaga || $ambaga }->() = 73; | |
869 | is $ambaga, 73, 'implicit return of arbitrary expression (scalar context)'; | |
870 | (sub :lvalue { $ambaga || $ambaga }->()) = 74; | |
871 | is $ambaga, 74, 'implicit return of arbitrary expression (list context)'; | |
145b2bbb FC |
872 | eval { +sub :lvalue { return 3 }->() = 4 }; |
873 | like $@, qr/Can\'t return a readonly value from lvalue subroutine at/, | |
874 | 'assignment to numeric constant explicitly returned from lv sub'; | |
875 | eval { (sub :lvalue { return 3 }->()) = 4 }; | |
876 | like $@, qr/Can\'t return a readonly value from lvalue subroutine at/, | |
877 | 'assignment to num constant explicitly returned (list cx)'; | |
145b2bbb FC |
878 | eval { +sub :lvalue { 3 }->() = 4 }; |
879 | like $@, qr/Can\'t return a readonly value from lvalue subroutine at/, | |
880 | 'assignment to numeric constant implicitly returned from lv sub'; | |
881 | eval { (sub :lvalue { 3 }->()) = 4 }; | |
882 | like $@, qr/Can\'t return a readonly value from lvalue subroutine at/, | |
883 | 'assignment to num constant implicitly returned (list cx)'; | |
bf8fb5eb FC |
884 | |
885 | # reference (potential lvalue) context | |
886 | $suffix = ''; | |
887 | for my $sub (sub :lvalue {$_}, sub :lvalue {return $_}) { | |
888 | &$sub()->${\sub { $_[0] = 37 }}; | |
889 | is $_, '37', 'lvalue->method'.$suffix; | |
890 | ${\scalar &$sub()} = 38; | |
891 | is $_, '38', 'scalar(lvalue)'.$suffix; | |
892 | sub assign39_with_proto ($) { $_[0] = 39 } | |
893 | assign39_with_proto(&$sub()); | |
894 | is $_, '39', 'func(lvalue) when func has $ proto'.$suffix; | |
895 | $_ = 1; | |
896 | ${\(&$sub()||undef)} = 40; | |
897 | is $_, '40', 'lvalue||...'.$suffix; | |
898 | ${\(${\undef}||&$sub())} = 41; # extra ${\...} to bypass const folding | |
899 | is $_, '41', '...||lvalue'.$suffix; | |
900 | $_ = 0; | |
901 | ${\(&$sub()&&undef)} = 42; | |
902 | is $_, '42', 'lvalue&&...'.$suffix; | |
903 | ${\(${\1}&&&$sub())} = 43; | |
904 | is $_, '43', '...&&lvalue'.$suffix; | |
905 | ${\(&$sub())[0]} = 44; | |
906 | is $_, '44', '(lvalue)[0]'.$suffix; | |
907 | } | |
908 | continue { $suffix = ' (explicit return)' } | |
767eda44 FC |
909 | |
910 | # autovivification | |
d507ecb9 | 911 | $suffix = ''; |
767eda44 FC |
912 | for my $sub (sub :lvalue {$_}, sub :lvalue {return $_}) { |
913 | undef $_; | |
914 | &$sub()->[3] = 4; | |
915 | is $_->[3], 4, 'func->[...] autovivification'.$suffix; | |
916 | undef $_; | |
917 | &$sub()->{3} = 4; | |
918 | is $_->{3}, 4, 'func->{...} autovivification'.$suffix; | |
919 | undef $_; | |
920 | ${&$sub()} = 4; | |
921 | is $$_, 4, '${func()} autovivification' .$suffix; | |
922 | undef $_; | |
923 | @{&$sub()} = 4; | |
924 | is "@$_", 4, '@{func()} autovivification' .$suffix; | |
925 | undef $_; | |
926 | %{&$sub()} = (4,5); | |
927 | is join('-',%$_), '4-5', '%{func()} autovivification'.$suffix; | |
0e9700df GG |
928 | undef $_; |
929 | ${ (), &$sub()} = 4; | |
930 | is $$_, 4, '${ (), func()} autovivification' .$suffix; | |
767eda44 FC |
931 | } |
932 | continue { $suffix = ' (explicit return)' } | |
e08be60b FC |
933 | |
934 | # [perl #92406] [perl #92290] Returning a pad var in rvalue context | |
935 | $suffix = ''; | |
936 | for my $sub ( | |
937 | sub :lvalue { my $x = 72; $x }, | |
938 | sub :lvalue { my $x = 72; return $x } | |
939 | ) { | |
940 | is scalar(&$sub), 72, "sub returning pad var in scalar context$suffix"; | |
941 | is +(&$sub)[0], 72, "sub returning pad var in list context$suffix"; | |
942 | } | |
943 | continue { $suffix = ' (explicit return)' } | |
ad37a74e FC |
944 | |
945 | # Returning read-only values in reference context | |
946 | $suffix = ''; | |
947 | for ( | |
948 | sub :lvalue { $] }->(), | |
949 | sub :lvalue { return $] }->() | |
950 | ) { | |
951 | is \$_, \$], 'read-only values are returned in reference context' | |
952 | .$suffix # (they used to be copied) | |
953 | } | |
954 | continue { $suffix = ' (explicit return)' } | |
777d9014 FC |
955 | |
956 | # Returning unwritables from nested lvalue sub call in in rvalue context | |
957 | # First, ensure we are testing what we think we are: | |
958 | if (!Internals::SvREADONLY($])) { Internals::SvREADONLY($],1); } | |
959 | sub squibble : lvalue { return $] } | |
960 | sub squebble : lvalue { squibble } | |
961 | sub squabble : lvalue { return squibble } | |
962 | is $x = squebble, $], 'returning ro from nested lv sub call in rv cx'; | |
963 | is $x = squabble, $], 'explct. returning ro from nested lv sub in rv cx'; | |
964 | is \squebble, \$], 'returning ro from nested lv sub call in ref cx'; | |
965 | is \squabble, \$], 'explct. returning ro from nested lv sub in ref cx'; | |
da1dff94 FC |
966 | |
967 | # [perl #102486] Sub calls as the last statement of an lvalue sub | |
968 | package _102486 { | |
969 | my $called; | |
970 | my $x = 'nonlv'; | |
971 | sub strictlv :lvalue { use strict 'refs'; &$x } | |
972 | sub lv :lvalue { &$x } | |
973 | sub nonlv { ++$called } | |
974 | eval { strictlv }; | |
975 | ::like $@, qr/^Can't use string \("nonlv"\) as a subroutine ref while/, | |
976 | 'strict mode applies to sub:lvalue{ &$string }'; | |
977 | $called = 0; | |
978 | ::ok eval { lv }, | |
979 | 'sub:lvalue{&$x}->() does not die for non-lvalue inner sub call'; | |
980 | ::is $called, 1, 'The &$x actually called the sub'; | |
981 | eval { +sub :lvalue { &$x }->() = 3 }; | |
982 | ::like $@, qr/^Can't modify non-lvalue subroutine call at /, | |
983 | 'sub:lvalue{&$x}->() dies in true lvalue context'; | |
984 | } | |
5811c07e FC |
985 | |
986 | # TARG should be copied in rvalue context | |
987 | sub ucf :lvalue { ucfirst $_[0] } | |
988 | is ucf("just another ") . ucf("perl hacker,\n"), | |
989 | "Just another Perl hacker,\n", 'TARG is copied in rvalue scalar cx'; | |
990 | is join('',ucf("just another "), ucf "perl hacker,\n"), | |
991 | "Just another Perl hacker,\n", 'TARG is copied in rvalue list cx'; | |
992 | sub ucfr : lvalue { | |
993 | @_ ? ucfirst $_[0] : do { | |
994 | is ucfr("just another ") . ucfr("perl hacker,\n"), | |
995 | "Just another Perl hacker,\n", | |
996 | 'TARG is copied in recursive rvalue scalar cx'; | |
997 | is join('',ucfr("just another "), ucfr("perl hacker,\n")), | |
998 | "Just another Perl hacker,\n", | |
999 | 'TARG is copied in recursive rvalue list cx'; | |
1000 | } | |
1001 | } | |
1002 | ucfr(); | |
4587c532 | 1003 | |
2d885586 FC |
1004 | # Test TARG with potential lvalue context, too |
1005 | for (sub : lvalue { "$x" }->()) { | |
1006 | is \$_, \$_, '\$_ == \$_ in for(sub :lvalue{"$x"}->()){...}' | |
1007 | } | |
1008 | ||
4587c532 FC |
1009 | # [perl #117947] XSUBs should not be treated as lvalues at run time |
1010 | eval { &{\&utf8::is_utf8}("") = 3 }; | |
1011 | like $@, qr/^Can't modify non-lvalue subroutine call at /, | |
1012 | 'XSUB not seen at compile time dies in lvalue context'; | |
2ec7f6f2 FC |
1013 | |
1014 | # [perl #119797] else implicitly returning value | |
1015 | # This used to cause Bizarre copy of ARRAY in pp_leave | |
1016 | sub else119797 : lvalue { | |
1017 | if ($_[0]) { | |
1018 | 1; # two statements force a leave op | |
1019 | @119797 | |
1020 | } | |
1021 | else { | |
1022 | @119797 | |
1023 | } | |
1024 | } | |
1025 | eval { (else119797(0)) = 1..3 }; | |
1026 | is $@, "", '$@ after writing to array returned by else'; | |
1027 | is "@119797", "1 2 3", 'writing to array returned by else'; | |
1028 | eval { (else119797(1)) = 4..6 }; | |
1029 | is $@, "", '$@ after writing to array returned by if (with else)'; | |
1030 | is "@119797", "4 5 6", 'writing to array returned by if (with else)'; | |
1031 | sub if119797 : lvalue { | |
1032 | if ($_[0]) { | |
1033 | @119797 | |
1034 | } | |
1035 | } | |
1036 | @119797 = (); | |
1037 | eval { (if119797(1)) = 4..6 }; | |
1038 | is $@, "", '$@ after writing to array returned by if'; | |
1039 | is "@119797", "4 5 6", 'writing to array returned by if'; | |
1040 | sub unless119797 : lvalue { | |
1041 | unless ($_[0]) { | |
1042 | @119797 | |
1043 | } | |
1044 | } | |
1045 | @119797 = (); | |
1046 | eval { (unless119797(0)) = 4..6 }; | |
1047 | is $@, "", '$@ after writing to array returned by unless'; | |
1048 | is "@119797", "4 5 6", 'writing to array returned by unless'; | |
a373464f FC |
1049 | sub bare119797 : lvalue { |
1050 | {; | |
1051 | @119797 | |
1052 | } | |
1053 | } | |
1054 | @119797 = (); | |
1055 | eval { (bare119797(0)) = 4..6 }; | |
1056 | is $@, "", '$@ after writing to array returned by bare block'; | |
1057 | is "@119797", "4 5 6", 'writing to array returned by bare block'; |