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