This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
lvref.t: Tests for \my assignment and scope exit
[perl5.git] / t / op / lvref.t
1 BEGIN {
2     chdir 't';
3     require './test.pl';
4     set_up_inc("../lib");
5 }
6
7 plan 135;
8
9 sub on { $::TODO = ' ' }
10 sub off{ $::TODO = ''  }
11
12 eval '\$x = \$y';
13 like $@, qr/^Experimental lvalue references not enabled/,
14     'error when feature is disabled';
15 eval '\($x) = \$y';
16 like $@, qr/^Experimental lvalue references not enabled/,
17     'error when feature is disabled (aassign)';
18
19 use feature 'lvalue_refs';
20
21 {
22     my($w,$c);
23     local $SIG{__WARN__} = sub { $c++; $w = shift };
24     eval '\$x = \$y';
25     is $c, 1, 'one warning from lv ref assignment';
26     like $w, qr/^Lvalue references are experimental/,
27         'experimental warning';
28     undef $c;
29     eval '\($x) = \$y';
30     is $c, 1, 'one warning from lv ref list assignment';
31     like $w, qr/^Lvalue references are experimental/,
32         'experimental warning';
33 }
34
35 no warnings 'experimental::lvalue_refs';
36
37 # Scalars
38
39 eval '\$x = \$y';
40 is \$x, \$y, '\$pkg_scalar = ...';
41 my $m;
42 \$m = \$y;
43 is \$m, \$y, '\$lexical = ...';
44 \my $n = \$y;
45 is \$n, \$y, '\my $lexical = ...';
46 @_ = \$_;
47 \($x) = @_;
48 is \$x, \$_, '\($pkgvar) = ... gives list context';
49 undef *x;
50 (\$x) = @_;
51 is \$x, \$_, '(\$pkgvar) = ... gives list context';
52 my $o;
53 \($o) = @_;
54 is \$o, \$_, '\($lexical) = ... gives list cx';
55 my $q;
56 (\$q) = @_;
57 is \$q, \$_, '(\$lexical) = ... gives list cx';
58 \(my $p) = @_;
59 is \$p, \$_, '\(my $lexical) = ... gives list cx';
60 (\my $r) = @_;
61 is \$r, \$_, '(\my $lexical) = ... gives list cx';
62 \my($s) = @_;
63 is \$s, \$_, '\my($lexical) = ... gives list cx';
64 \($_a, my $a) = @{[\$b, \$c]};
65 is \$_a, \$b, 'package scalar in \(...)';
66 is \$a, \$c, 'lex scalar in \(...)';
67 (\$_b, \my $b) = @{[\$b, \$c]};
68 is \$_b, \$::b, 'package scalar in (\$foo, \$bar)';
69 is \$b, \$c, 'lex scalar in (\$foo, \$bar)';
70 is do { \local $l = \3; $l }, 3, '\local $scalar assignment';
71 is $l, undef, 'localisation unwound';
72 is do { \(local $l) = \4; $l }, 4, '\(local $scalar) assignment';
73 is $l, undef, 'localisation unwound';
74 \$foo = \*bar;
75 is *foo{SCALAR}, *bar{GLOB}, 'globref-to-scalarref assignment';
76 for (1,2) {
77   \my $x = \3 if $_ == 1;
78   \my($y) = \3 if $_ == 1;
79   if ($_ == 2) {
80     is $x, undef, '\my $x = ... clears $x on scope exit';
81     is $y, undef, '\my($x) = ... clears $x on scope exit';
82   }
83 }
84
85 # Array Elements
86
87 sub expect_scalar_cx { wantarray ? 0 : \$_ }
88 sub expect_list_cx { wantarray ? (\$_,\$_) : 0 }
89 \$a[0] = expect_scalar_cx;
90 is \$a[0], \$_, '\$array[0]';
91 \($a[1]) = expect_list_cx;
92 is \$a[1], \$_, '\($array[0])';
93 {
94   my @a;
95   \$a[0] = expect_scalar_cx;
96   is \$a[0], \$_, '\$lexical_array[0]';
97   \($a[1]) = expect_list_cx;
98   is \$a[1], \$_, '\($lexical_array[0])';
99   my $tmp;
100   {
101     \local $a[0] = \$tmp;
102     is \$a[0], \$tmp, '\local $a[0]';
103   }
104   is \$a[0], \$_, '\local $a[0] unwound';
105   {
106     \local ($a[1]) = \$tmp;
107     is \$a[1], \$tmp, '\local ($a[0])';
108   }
109   is \$a[1], \$_, '\local $a[0] unwound';
110 }
111 {
112   my @a;
113   \@a[0,1] = expect_list_cx;
114   is \$a[0].\$a[1], \$_.\$_, '\@array[indices]';
115   \(@a[2,3]) = expect_list_cx;
116   is \$a[0].\$a[1], \$_.\$_, '\(@array[indices])';
117   my $tmp;
118   {
119     \local @a[0,1] = (\$tmp)x2;
120     is \$a[0].\$a[1], \$tmp.\$tmp, '\local @a[indices]';
121   }
122   is \$a[0].\$a[1], \$_.\$_, '\local @a[indices] unwound';
123 }
124
125 # Hash Elements
126
127 \$h{a} = expect_scalar_cx;
128 is \$h{a}, \$_, '\$hash{a}';
129 \($h{b}) = expect_list_cx;
130 is \$h{b}, \$_, '\($hash{a})';
131 {
132   my @h;
133   \$h{a} = expect_scalar_cx;
134   is \$h{a}, \$_, '\$lexical_array{a}';
135   \($h{b}) = expect_list_cx;
136   is \$h{b}, \$_, '\($lexical_array{a})';
137   my $tmp;
138   {
139     \local $h{a} = \$tmp;
140     is \$h{a}, \$tmp, '\local $h{a}';
141   }
142   is \$h{a}, \$_, '\local $h{a} unwound';
143   {
144     \local ($h{b}) = \$tmp;
145     is \$h{b}, \$tmp, '\local ($h{a})';
146   }
147   is \$h{b}, \$_, '\local $h{a} unwound';
148 }
149 {
150   my @h;
151   \@h{"a","b"} = expect_list_cx;
152   is \$h{a}.\$h{b}, \$_.\$_, '\@hash{indices}';
153   \(@h{2,3}) = expect_list_cx;
154   is \$h{a}.\$h{b}, \$_.\$_, '\(@hash{indices})';
155   my $tmp;
156   {
157     \local @h{"a","b"} = (\$tmp)x2;
158     is \$h{a}.\$h{b}, \$tmp.\$tmp, '\local @h{indices}';
159   }
160   is \$h{a}.\$h{b}, \$_.\$_, '\local @h{indices} unwound';
161 }
162
163 # Arrays
164
165 package ArrayTest {
166   BEGIN { *is = *main::is }
167   sub expect_scalar_cx { wantarray ? 0 : \@ThatArray }
168   sub expect_list_cx   { wantarray ? (\$_,\$_) : 0 }
169   sub expect_list_cx_a { wantarray ? (\@ThatArray)x2 : 0 }
170   eval '\@a = expect_scalar_cx';
171   is \@a, \@ThatArray, '\@pkg';
172   my @a;
173   \@a = expect_scalar_cx;
174   is \@a, \@ThatArray, '\@lexical';
175   (\@b) = expect_list_cx_a;
176   is \@b, \@ThatArray, '(\@pkg)';
177   my @b;
178   (\@b) = expect_list_cx_a;
179   is \@b, \@ThatArray, '(\@lexical)';
180   \my @c = expect_scalar_cx;
181   is \@c, \@ThatArray, '\my @lexical';
182   (\my @d) = expect_list_cx_a;
183   is \@d, \@ThatArray, '(\my @lexical)';
184   \(@e) = expect_list_cx;
185   is \$e[0].\$e[1], \$_.\$_, '\(@pkg)';
186   my @e;
187   \(@e) = expect_list_cx;
188   is \$e[0].\$e[1], \$_.\$_, '\(@lexical)';
189   \(my @f) = expect_list_cx;
190   is \$f[0].\$f[1], \$_.\$_, '\(my @lexical)';
191   \my(@g) = expect_list_cx;
192   is \$g[0].\$g[1], \$_.\$_, '\my(@lexical)';
193   my $old = \@h;
194   {
195     \local @h = \@ThatArray;
196     is \@h, \@ThatArray, '\local @a';
197   }
198   is \@h, $old, '\local @a unwound';
199   $old = \@i;
200   eval q{
201     (\local @i) = \@ThatArray;
202     is \@i, \@ThatArray, '(\local @a)';
203   } or do { SKIP: { ::skip 'unimplemented' } };
204   is \@i, $old, '(\local @a) unwound';
205 }
206 for (1,2) {
207   \my @x = [1..3] if $_ == 1;
208   \my(@y) = \3 if $_ == 1;
209   if ($_ == 2) {
210     is @x, 0, '\my @x = ... clears @x on scope exit';
211     is @y, 0, '\my(@x) = ... clears @x on scope exit';
212   }
213 }
214
215 # Hashes
216
217 package HashTest {
218   BEGIN { *is = *main::is }
219   sub expect_scalar_cx { wantarray ? 0 : \%ThatHash }
220   sub expect_list_cx   { wantarray ? (\%ThatHash)x2 : 0 }
221   \%a = expect_scalar_cx;
222   is \%a, \%ThatHash, '\%pkg';
223   my %a;
224   \%a = expect_scalar_cx;
225   is \%a, \%ThatHash, '\%lexical';
226   (\%b) = expect_list_cx;
227   is \%b, \%ThatHash, '(\%pkg)';
228   my %b;
229   (\%b) = expect_list_cx;
230   is \%b, \%ThatHash, '(\%lexical)';
231   \my %c = expect_scalar_cx;
232   is \%c, \%ThatHash, '\my %lexical';
233   (\my %d) = expect_list_cx;
234   is \%d, \%ThatHash, '(\my %lexical)';
235   my $old = \%h;
236   {
237     \local %h = \%ThatHash;
238     is \%h, \%ThatHash, '\local %a';
239   }
240   is \%h, $old, '\local %a unwound';
241   $old = \%i;
242   eval q{
243     (\local %i) = \%ThatHash;
244     is \%i, \%ThatHash, '(\local %a)';
245   } or do { SKIP: { ::skip 'unimplemented' } };
246   is \%i, $old, '(\local %a) unwound';
247 }
248 for (1,2) {
249   \my %x = {1,2} if $_ == 1;
250   if ($_ == 2) {
251     is %x, 0, '\my %x = ... clears %x on scope exit';
252   }
253 }
254
255 # Subroutines
256
257 package CodeTest {
258   BEGIN { *is = *main::is; }
259   use feature 'lexical_subs', 'state';
260   no warnings 'experimental::lexical_subs';
261   sub expect_scalar_cx { wantarray ? 0 : \&ThatSub }
262   sub expect_list_cx   { wantarray ? (\&ThatSub)x2 : 0 }
263   \&a = expect_scalar_cx;
264   is \&a, \&ThatSub, '\&pkg';
265   my sub a;
266   \&a = expect_scalar_cx;
267   is \&a, \&ThatSub, '\&mysub';
268   state sub as;
269   \&as = expect_scalar_cx;
270   is \&as, \&ThatSub, '\&statesub';
271   (\&b) = expect_list_cx;
272   is \&b, \&ThatSub, '(\&pkg)';
273   my sub b;
274   (\&b) = expect_list_cx;
275   is \&b, \&ThatSub, '(\&mysub)';
276   my sub bs;
277   (\&bs) = expect_list_cx;
278   is \&bs, \&ThatSub, '(\&statesub)';
279   \(&c) = expect_list_cx;
280   is \&c, \&ThatSub, '\(&pkg)';
281   my sub b;
282   \(&c) = expect_list_cx;
283   is \&c, \&ThatSub, '\(&mysub)';
284   my sub bs;
285   \(&cs) = expect_list_cx;
286   is \&cs, \&ThatSub, '\(&statesub)';
287 }
288
289 # Mixed List Assignments
290
291 (\$tahi, $rua) = \(1,2);
292 is join(' ', $tahi, $$rua), '1 2',
293   'mixed scalar ref and scalar list assignment';
294
295 # Conditional expressions
296
297 $_ = 3;
298 $_ == 3 ? \$tahi : $rua = \3;
299 is $tahi, 3, 'cond assignment resolving to scalar ref';
300 $_ == 0 ? \$toru : $wha = \3;
301 is $$wha, 3, 'cond assignment resolving to scalar';
302 $_ == 3 ? \$rima : \$ono = \5;
303 is $rima, 5, 'cond assignment with refgens on both branches';
304 \($_ == 3 ? $whitu : $waru) = \5;
305 is $whitu, 5, '\( ?: ) assignment';
306
307 # Foreach
308
309 for \my $topic (\$for1, \$for2) {
310     push @for, \$topic;
311 }
312 is "@for", \$for1 . ' ' . \$for2, 'foreach \my $a';
313 is \$topic, \$::topic, 'for \my scoping';
314
315 @for = ();
316 for \$::a(\$for1, \$for2) {
317     push @for, \$::a;
318 }
319 is "@for", \$for1 . ' ' . \$for2, 'foreach \$::a';
320
321 @for = ();
322 for \my @a([1,2], [3,4]) {
323     push @for, @a;
324 }
325 is "@for", "1 2 3 4", 'foreach \my @a [perl #22335]';
326
327 @for = ();
328 for \@::a([1,2], [3,4]) {
329     push @for, @::a;
330 }
331 is "@for", "1 2 3 4", 'foreach \@::a [perl #22335]';
332
333 @for = ();
334 for \my %a({5,6}, {7,8}) {
335     push @for, %a;
336 }
337 is "@for", "5 6 7 8", 'foreach \my %a [perl #22335]';
338
339 @for = ();
340 for \%::a({5,6}, {7,8}) {
341     push @for, %::a;
342 }
343 is "@for", "5 6 7 8", 'foreach \%::a [perl #22335]';
344
345 @for = ();
346 {
347   use feature 'lexical_subs';
348   no warnings 'experimental::lexical_subs';
349   my sub a;
350   for \&a(sub {9}, sub {10}) {
351     push @for, &a;
352   }
353 }
354 is "@for", "9 10", 'foreach \&padcv';
355
356 @for = ();
357 for \&::a(sub {9}, sub {10}) {
358   push @for, &::a;
359 }
360 is "@for", "9 10", 'foreach \&rv2cv';
361
362 # Errors
363
364 eval { my $x; \$x = 3 };
365 like $@, qr/^Assigned value is not a reference at/, 'assigning non-ref';
366 eval { my $x; \$x = [] };
367 like $@, qr/^Assigned value is not a SCALAR reference at/,
368     'assigning non-scalar ref to scalar ref';
369 eval { \$::x = [] };
370 like $@, qr/^Assigned value is not a SCALAR reference at/,
371     'assigning non-scalar ref to package scalar ref';
372 eval { my @x; \@x = {} };
373 like $@, qr/^Assigned value is not an ARRAY reference at/,
374     'assigning non-array ref to array ref';
375 eval { \@::x = {} };
376 like $@, qr/^Assigned value is not an ARRAY reference at/,
377     'assigning non-array ref to package array ref';
378 eval { my %x; \%x = [] };
379 like $@, qr/^Assigned value is not a HASH reference at/,
380     'assigning non-hash ref to hash ref';
381 eval { \%::x = [] };
382 like $@, qr/^Assigned value is not a HASH reference at/,
383     'assigning non-hash ref to package hash ref';
384 eval { use feature 'lexical_subs';
385        no warnings 'experimental::lexical_subs';
386        my sub x; \&x = [] };
387 like $@, qr/^Assigned value is not a CODE reference at/,
388     'assigning non-code ref to lexical code ref';
389 eval { \&::x = [] };
390 like $@, qr/^Assigned value is not a CODE reference at/,
391     'assigning non-code ref to package code ref';
392
393 eval { my $x; (\$x) = 3 };
394 like $@, qr/^Assigned value is not a reference at/,
395     'list-assigning non-ref';
396 eval { my $x; (\$x) = [] };
397 like $@, qr/^Assigned value is not a SCALAR reference at/,
398     'list-assigning non-scalar ref to scalar ref';
399 eval { (\$::x = []) };
400 like $@, qr/^Assigned value is not a SCALAR reference at/,
401     'list-assigning non-scalar ref to package scalar ref';
402 eval { my @x; (\@x) = {} };
403 like $@, qr/^Assigned value is not an ARRAY reference at/,
404     'list-assigning non-array ref to array ref';
405 eval { (\@::x) = {} };
406 like $@, qr/^Assigned value is not an ARRAY reference at/,
407     'list-assigning non-array ref to package array ref';
408 eval { my %x; (\%x) = [] };
409 like $@, qr/^Assigned value is not a HASH reference at/,
410     'list-assigning non-hash ref to hash ref';
411 eval { (\%::x) = [] };
412 like $@, qr/^Assigned value is not a HASH reference at/,
413     'list-assigning non-hash ref to package hash ref';
414 eval { use feature 'lexical_subs';
415        no warnings 'experimental::lexical_subs';
416        my sub x; (\&x) = [] };
417 like $@, qr/^Assigned value is not a CODE reference at/,
418     'list-assigning non-code ref to lexical code ref';
419 eval { (\&::x) = [] };
420 like $@, qr/^Assigned value is not a CODE reference at/,
421     'list-assigning non-code ref to package code ref';
422
423 eval '(\do{}) = 42';
424 like $@, qr/^Can't modify reference to do block in list assignment at /,
425     "Can't modify reference to do block in list assignment";
426 eval '(\pos) = 42';
427 like $@,
428      qr/^Can't modify reference to match position in list assignment at /,
429     "Can't modify ref to some scalar-returning op in list assignment";
430 eval '(\glob) = 42';
431 like $@,
432      qr/^Can't modify reference to glob in list assignment at /,
433     "Can't modify reference to some list-returning op in list assignment";
434 eval '\pos = 42';
435 like $@,
436     qr/^Can't modify reference to match position in scalar assignment at /,
437    "Can't modify ref to some scalar-returning op in scalar assignment";
438 eval '\(local @b) = 42';
439 like $@,
440     qr/^Can't modify reference to localized parenthesized array in list(?x:
441       ) assignment at /,
442    q"Can't modify \(local @array) in list assignment";
443 eval '\local(@b) = 42';
444 like $@,
445     qr/^Can't modify reference to localized parenthesized array in list(?x:
446       ) assignment at /,
447    q"Can't modify \local(@array) in list assignment";
448 eval '\local(@{foo()}) = 42';
449 like $@,
450     qr/^Can't modify reference to array dereference in list assignment at/,
451    q"'Array deref' error takes prec. over 'local paren' error";
452 eval '\(%b) = 42';
453 like $@,
454     qr/^Can't modify reference to parenthesized hash in list assignment a/,
455    "Can't modify ref to parenthesized package hash in scalar assignment";
456 eval '\(my %b) = 42';
457 like $@,
458     qr/^Can't modify reference to parenthesized hash in list assignment a/,
459    "Can't modify ref to parenthesized hash (\(my %b)) in list assignment";
460 eval '\my(%b) = 42';
461 like $@,
462     qr/^Can't modify reference to parenthesized hash in list assignment a/,
463    "Can't modify ref to parenthesized hash (\my(%b)) in list assignment";
464 eval '\%{"42"} = 42';
465 like $@,
466     qr/^Can't modify reference to hash dereference in scalar assignment a/,
467    "Can't modify reference to hash dereference in scalar assignment";
468 eval '$foo ? \%{"42"} : \%43 = 42';
469 like $@,
470     qr/^Can't modify reference to hash dereference in scalar assignment a/,
471    "Can't modify ref to whatever in scalar assignment via cond expr";
472 on;
473
474
475 # Miscellaneous
476
477 {
478   my($x,$y);
479   sub {
480     sub {
481       \$x = \$y;
482     }->();
483     is \$x, \$y, 'lexical alias affects outer closure';
484   }->();
485   is \$x, \$y, 'lexical alias affects outer sub where vars are declared';
486 }
487
488 { # PADSTALE has a double meaning
489   use feature 'lexical_subs', 'signatures', 'state';
490   no warnings 'experimental';
491   my $c;
492   my sub s ($arg) {
493     state $x = ++$c;
494     if ($arg == 3) { return $c }
495     goto skip if $arg == 2;
496     my $y;
497    skip:
498     # $y is PADSTALE the 2nd time
499     \$x = \$y if $arg == 2;
500   }
501   s(1);
502   s(2);
503   is s(3), 1, 'padstale alias should not reset state'
504 }
505
506 off;
507 SKIP: {
508     skip_without_dynamic_extension('List/Util');
509     require Scalar::Util;
510     my $a;
511     Scalar::Util::weaken($r = \$a);
512     \$a = $r;
513     pass 'no crash when assigning \$lex = $weakref_to_lex'
514 }