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