This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
lvref.t: Fix hash elem tests
[perl5.git] / t / op / lvref.t
CommitLineData
72ed4618
FC
1BEGIN {
2 chdir 't';
3 require './test.pl';
4 set_up_inc("../lib");
5}
6
3ad7d304 7plan 140;
72ed4618 8
53abf431
FC
9sub on { $::TODO = ' ' }
10sub off{ $::TODO = '' }
72ed4618
FC
11
12eval '\$x = \$y';
13like $@, qr/^Experimental lvalue references not enabled/,
14 'error when feature is disabled';
26a50d99
FC
15eval '\($x) = \$y';
16like $@, qr/^Experimental lvalue references not enabled/,
17 'error when feature is disabled (aassign)';
72ed4618 18
3ad7d304 19use feature 'lvalue_refs', 'state';
72ed4618
FC
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';
26a50d99
FC
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';
72ed4618
FC
33}
34
35no warnings 'experimental::lvalue_refs';
36
37# Scalars
38
39eval '\$x = \$y';
40is \$x, \$y, '\$pkg_scalar = ...';
41my $m;
53abf431 42\$m = \$y;
72ed4618 43is \$m, \$y, '\$lexical = ...';
fc048fcf 44\my $n = \$y;
72ed4618
FC
45is \$n, \$y, '\my $lexical = ...';
46@_ = \$_;
26a50d99 47\($x) = @_;
72ed4618 48is \$x, \$_, '\($pkgvar) = ... gives list context';
238ef7dc 49undef *x;
26a50d99 50(\$x) = @_;
238ef7dc 51is \$x, \$_, '(\$pkgvar) = ... gives list context';
72ed4618 52my $o;
c146a62a 53\($o) = @_;
72ed4618 54is \$o, \$_, '\($lexical) = ... gives list cx';
26a50d99 55my $q;
c146a62a 56(\$q) = @_;
238ef7dc 57is \$q, \$_, '(\$lexical) = ... gives list cx';
c146a62a 58\(my $p) = @_;
72ed4618 59is \$p, \$_, '\(my $lexical) = ... gives list cx';
c146a62a 60(\my $r) = @_;
238ef7dc 61is \$r, \$_, '(\my $lexical) = ... gives list cx';
c146a62a 62\my($s) = @_;
238ef7dc 63is \$s, \$_, '\my($lexical) = ... gives list cx';
217e3565 64\($_a, my $a) = @{[\$b, \$c]};
72ed4618
FC
65is \$_a, \$b, 'package scalar in \(...)';
66is \$a, \$c, 'lex scalar in \(...)';
c146a62a 67(\$_b, \my $b) = @{[\$b, \$c]};
72ed4618
FC
68is \$_b, \$::b, 'package scalar in (\$foo, \$bar)';
69is \$b, \$c, 'lex scalar in (\$foo, \$bar)';
2a57afb1
FC
70is do { \local $l = \3; $l }, 3, '\local $scalar assignment';
71is $l, undef, 'localisation unwound';
72is do { \(local $l) = \4; $l }, 4, '\(local $scalar) assignment';
11ea28ee 73is $l, undef, 'localisation unwound';
29a3d628
FC
74\$foo = \*bar;
75is *foo{SCALAR}, *bar{GLOB}, 'globref-to-scalarref assignment';
30bccb25 76for (1,2) {
3ad7d304
FC
77 \my $x = \3,
78 \my($y) = \3,
79 \state $a = \3,
80 \state($b) = \3 if $_ == 1;
30bccb25
FC
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';
3ad7d304
FC
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';
30bccb25
FC
86 }
87}
72ed4618
FC
88
89# Array Elements
90
0ca7b7f7
FC
91sub expect_scalar_cx { wantarray ? 0 : \$_ }
92sub expect_list_cx { wantarray ? (\$_,\$_) : 0 }
93\$a[0] = expect_scalar_cx;
6102323a 94is \$a[0], \$_, '\$array[0]';
0ca7b7f7 95\($a[1]) = expect_list_cx;
6102323a
FC
96is \$a[1], \$_, '\($array[0])';
97{
98 my @a;
0ca7b7f7 99 \$a[0] = expect_scalar_cx;
6102323a 100 is \$a[0], \$_, '\$lexical_array[0]';
0ca7b7f7 101 \($a[1]) = expect_list_cx;
6102323a 102 is \$a[1], \$_, '\($lexical_array[0])';
40d2b828
FC
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';
6102323a 114}
0ca7b7f7
FC
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}
72ed4618
FC
128
129# Hash Elements
130
5f94141d
FC
131\$h{a} = expect_scalar_cx;
132is \$h{a}, \$_, '\$hash{a}';
133\($h{b}) = expect_list_cx;
134is \$h{b}, \$_, '\($hash{a})';
135{
901f0970 136 my %h;
5f94141d
FC
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{
901f0970 154 my %h;
5f94141d
FC
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}
72ed4618
FC
166
167# Arrays
168
4779e7f9
FC
169package 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 eval '\@a = expect_scalar_cx';
175 is \@a, \@ThatArray, '\@pkg';
176 my @a;
3f114923 177 \@a = expect_scalar_cx;
4779e7f9 178 is \@a, \@ThatArray, '\@lexical';
9782ce69 179 (\@b) = expect_list_cx_a;
4779e7f9
FC
180 is \@b, \@ThatArray, '(\@pkg)';
181 my @b;
9782ce69 182 (\@b) = expect_list_cx_a;
4779e7f9 183 is \@b, \@ThatArray, '(\@lexical)';
3f114923 184 \my @c = expect_scalar_cx;
4779e7f9 185 is \@c, \@ThatArray, '\my @lexical';
bdaf10a5 186 (\my @d) = expect_list_cx_a;
4779e7f9 187 is \@d, \@ThatArray, '(\my @lexical)';
bdaf10a5
FC
188 \(@e) = expect_list_cx;
189 is \$e[0].\$e[1], \$_.\$_, '\(@pkg)';
4779e7f9 190 my @e;
bdaf10a5
FC
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)';
30494daf 197 my $old = \@h;
30494daf
FC
198 {
199 \local @h = \@ThatArray;
200 is \@h, \@ThatArray, '\local @a';
201 }
30494daf
FC
202 is \@h, $old, '\local @a unwound';
203 $old = \@i;
30494daf
FC
204 eval q{
205 (\local @i) = \@ThatArray;
206 is \@i, \@ThatArray, '(\local @a)';
207 } or do { SKIP: { ::skip 'unimplemented' } };
208 is \@i, $old, '(\local @a) unwound';
4779e7f9 209}
30bccb25 210for (1,2) {
3ad7d304
FC
211 \my @x = [1..3],
212 \my(@y) = \3,
213 \state @a = [1..3],
214 \state(@b) = \3 if $_ == 1;
30bccb25
FC
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';
3ad7d304
FC
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';
30bccb25
FC
220 }
221}
72ed4618
FC
222
223# Hashes
224
87da42eb
FC
225package HashTest {
226 BEGIN { *is = *main::is }
227 sub expect_scalar_cx { wantarray ? 0 : \%ThatHash }
228 sub expect_list_cx { wantarray ? (\%ThatHash)x2 : 0 }
3f114923 229 \%a = expect_scalar_cx;
87da42eb
FC
230 is \%a, \%ThatHash, '\%pkg';
231 my %a;
3f114923 232 \%a = expect_scalar_cx;
87da42eb 233 is \%a, \%ThatHash, '\%lexical';
9782ce69
FC
234 (\%b) = expect_list_cx;
235 is \%b, \%ThatHash, '(\%pkg)';
87da42eb 236 my %b;
9782ce69 237 (\%b) = expect_list_cx;
87da42eb 238 is \%b, \%ThatHash, '(\%lexical)';
3f114923 239 \my %c = expect_scalar_cx;
87da42eb 240 is \%c, \%ThatHash, '\my %lexical';
9782ce69 241 (\my %d) = expect_list_cx;
87da42eb 242 is \%d, \%ThatHash, '(\my %lexical)';
30494daf 243 my $old = \%h;
30494daf
FC
244 {
245 \local %h = \%ThatHash;
246 is \%h, \%ThatHash, '\local %a';
247 }
30494daf
FC
248 is \%h, $old, '\local %a unwound';
249 $old = \%i;
30494daf
FC
250 eval q{
251 (\local %i) = \%ThatHash;
252 is \%i, \%ThatHash, '(\local %a)';
253 } or do { SKIP: { ::skip 'unimplemented' } };
254 is \%i, $old, '(\local %a) unwound';
87da42eb 255}
30bccb25 256for (1,2) {
3ad7d304 257 \state %y = {1,2},
30bccb25
FC
258 \my %x = {1,2} if $_ == 1;
259 if ($_ == 2) {
260 is %x, 0, '\my %x = ... clears %x on scope exit';
3ad7d304 261 is "@{[%y]}", "1 2", '\state %x = ... does not clear %x on scope exit';
30bccb25
FC
262 }
263}
72ed4618
FC
264
265# Subroutines
266
408e9044
FC
267package CodeTest {
268 BEGIN { *is = *main::is; }
3ad7d304 269 use feature 'lexical_subs';
408e9044
FC
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}
72ed4618 298
b7ae253e 299# Mixed List Assignments
72ed4618 300
26a50d99 301(\$tahi, $rua) = \(1,2);
9fc71ff4
FC
302is join(' ', $tahi, $$rua), '1 2',
303 'mixed scalar ref and scalar list assignment';
b7ae253e
FC
304
305# Conditional expressions
306
9fc71ff4 307$_ = 3;
d1094c5b 308$_ == 3 ? \$tahi : $rua = \3;
9fc71ff4 309is $tahi, 3, 'cond assignment resolving to scalar ref';
d1094c5b 310$_ == 0 ? \$toru : $wha = \3;
9fc71ff4 311is $$wha, 3, 'cond assignment resolving to scalar';
d1094c5b 312$_ == 3 ? \$rima : \$ono = \5;
9e592f5a 313is $rima, 5, 'cond assignment with refgens on both branches';
7664512e
FC
314\($_ == 3 ? $whitu : $waru) = \5;
315is $whitu, 5, '\( ?: ) assignment';
72ed4618 316
096cc2cc
FC
317# Foreach
318
362e758e
FC
319for \my $topic (\$for1, \$for2) {
320 push @for, \$topic;
321}
096cc2cc 322is "@for", \$for1 . ' ' . \$for2, 'foreach \my $a';
362e758e
FC
323is \$topic, \$::topic, 'for \my scoping';
324
325@for = ();
326for \$::a(\$for1, \$for2) {
327 push @for, \$::a;
328}
329is "@for", \$for1 . ' ' . \$for2, 'foreach \$::a';
096cc2cc
FC
330
331@for = ();
362e758e 332for \my @a([1,2], [3,4]) {
096cc2cc 333 push @for, @a;
362e758e 334}
096cc2cc
FC
335is "@for", "1 2 3 4", 'foreach \my @a [perl #22335]';
336
337@for = ();
362e758e
FC
338for \@::a([1,2], [3,4]) {
339 push @for, @::a;
340}
341is "@for", "1 2 3 4", 'foreach \@::a [perl #22335]';
342
343@for = ();
344for \my %a({5,6}, {7,8}) {
096cc2cc 345 push @for, %a;
362e758e 346}
096cc2cc
FC
347is "@for", "5 6 7 8", 'foreach \my %a [perl #22335]';
348
349@for = ();
362e758e
FC
350for \%::a({5,6}, {7,8}) {
351 push @for, %::a;
352}
353is "@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}) {
096cc2cc
FC
361 push @for, &a;
362 }
362e758e
FC
363}
364is "@for", "9 10", 'foreach \&padcv';
096cc2cc 365
362e758e
FC
366@for = ();
367for \&::a(sub {9}, sub {10}) {
368 push @for, &::a;
369}
370is "@for", "9 10", 'foreach \&rv2cv';
096cc2cc 371
72ed4618
FC
372# Errors
373
b3717a0e
FC
374eval { my $x; \$x = 3 };
375like $@, qr/^Assigned value is not a reference at/, 'assigning non-ref';
376eval { my $x; \$x = [] };
377like $@, qr/^Assigned value is not a SCALAR reference at/,
378 'assigning non-scalar ref to scalar ref';
d8a875d9
FC
379eval { \$::x = [] };
380like $@, qr/^Assigned value is not a SCALAR reference at/,
381 'assigning non-scalar ref to package scalar ref';
0719038d
FC
382eval { my @x; \@x = {} };
383like $@, qr/^Assigned value is not an ARRAY reference at/,
384 'assigning non-array ref to array ref';
385eval { \@::x = {} };
386like $@, qr/^Assigned value is not an ARRAY reference at/,
387 'assigning non-array ref to package array ref';
388eval { my %x; \%x = [] };
389like $@, qr/^Assigned value is not a HASH reference at/,
390 'assigning non-hash ref to hash ref';
391eval { \%::x = [] };
392like $@, qr/^Assigned value is not a HASH reference at/,
393 'assigning non-hash ref to package hash ref';
408e9044
FC
394eval { use feature 'lexical_subs';
395 no warnings 'experimental::lexical_subs';
396 my sub x; \&x = [] };
397like $@, qr/^Assigned value is not a CODE reference at/,
398 'assigning non-code ref to lexical code ref';
399eval { \&::x = [] };
400like $@, qr/^Assigned value is not a CODE reference at/,
401 'assigning non-code ref to package code ref';
d6378458 402
bd9bf01b
FC
403eval { my $x; (\$x) = 3 };
404like $@, qr/^Assigned value is not a reference at/,
405 'list-assigning non-ref';
406eval { my $x; (\$x) = [] };
407like $@, qr/^Assigned value is not a SCALAR reference at/,
408 'list-assigning non-scalar ref to scalar ref';
409eval { (\$::x = []) };
410like $@, qr/^Assigned value is not a SCALAR reference at/,
411 'list-assigning non-scalar ref to package scalar ref';
412eval { my @x; (\@x) = {} };
413like $@, qr/^Assigned value is not an ARRAY reference at/,
414 'list-assigning non-array ref to array ref';
415eval { (\@::x) = {} };
416like $@, qr/^Assigned value is not an ARRAY reference at/,
417 'list-assigning non-array ref to package array ref';
418eval { my %x; (\%x) = [] };
419like $@, qr/^Assigned value is not a HASH reference at/,
420 'list-assigning non-hash ref to hash ref';
421eval { (\%::x) = [] };
422like $@, qr/^Assigned value is not a HASH reference at/,
423 'list-assigning non-hash ref to package hash ref';
408e9044
FC
424eval { use feature 'lexical_subs';
425 no warnings 'experimental::lexical_subs';
426 my sub x; (\&x) = [] };
427like $@, qr/^Assigned value is not a CODE reference at/,
428 'list-assigning non-code ref to lexical code ref';
429eval { (\&::x) = [] };
430like $@, qr/^Assigned value is not a CODE reference at/,
431 'list-assigning non-code ref to package code ref';
bd9bf01b 432
d6378458
FC
433eval '(\do{}) = 42';
434like $@, qr/^Can't modify reference to do block in list assignment at /,
435 "Can't modify reference to do block in list assignment";
d6378458
FC
436eval '(\pos) = 42';
437like $@,
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";
d6378458
FC
440eval '(\glob) = 42';
441like $@,
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";
d6b7592f
FC
444eval '\pos = 42';
445like $@,
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";
30494daf
FC
448eval '\(local @b) = 42';
449like $@,
bdaf10a5 450 qr/^Can't modify reference to localized parenthesized array in list(?x:
30494daf
FC
451 ) assignment at /,
452 q"Can't modify \(local @array) in list assignment";
453eval '\local(@b) = 42';
454like $@,
bdaf10a5 455 qr/^Can't modify reference to localized parenthesized array in list(?x:
30494daf
FC
456 ) assignment at /,
457 q"Can't modify \local(@array) in list assignment";
bdaf10a5
FC
458eval '\local(@{foo()}) = 42';
459like $@,
460 qr/^Can't modify reference to array dereference in list assignment at/,
461 q"'Array deref' error takes prec. over 'local paren' error";
87da42eb
FC
462eval '\(%b) = 42';
463like $@,
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";
466eval '\(my %b) = 42';
467like $@,
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";
470eval '\my(%b) = 42';
471like $@,
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";
474eval '\%{"42"} = 42';
475like $@,
476 qr/^Can't modify reference to hash dereference in scalar assignment a/,
477 "Can't modify reference to hash dereference in scalar assignment";
63702de8
FC
478eval '$foo ? \%{"42"} : \%43 = 42';
479like $@,
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";
3f114923 482on;
87da42eb 483
781ff25d
FC
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}
81cb1af6
FC
497
498{ # PADSTALE has a double meaning
3ad7d304 499 use feature 'lexical_subs', 'signatures';
81cb1af6
FC
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}
cf5d2d91
FC
515
516off;
517SKIP: {
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}