This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Subroutine reference assignment
[perl5.git] / t / op / lvref.t
CommitLineData
72ed4618
FC
1BEGIN {
2 chdir 't';
3 require './test.pl';
4 set_up_inc("../lib");
5}
6
408e9044 7plan 124;
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
FC
18
19use 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';
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';
72ed4618
FC
76
77# Array Elements
78
0ca7b7f7
FC
79sub expect_scalar_cx { wantarray ? 0 : \$_ }
80sub expect_list_cx { wantarray ? (\$_,\$_) : 0 }
81\$a[0] = expect_scalar_cx;
6102323a 82is \$a[0], \$_, '\$array[0]';
0ca7b7f7 83\($a[1]) = expect_list_cx;
6102323a
FC
84is \$a[1], \$_, '\($array[0])';
85{
86 my @a;
0ca7b7f7 87 \$a[0] = expect_scalar_cx;
6102323a 88 is \$a[0], \$_, '\$lexical_array[0]';
0ca7b7f7 89 \($a[1]) = expect_list_cx;
6102323a 90 is \$a[1], \$_, '\($lexical_array[0])';
40d2b828
FC
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';
6102323a 102}
0ca7b7f7
FC
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}
72ed4618
FC
116
117# Hash Elements
118
5f94141d
FC
119\$h{a} = expect_scalar_cx;
120is \$h{a}, \$_, '\$hash{a}';
121\($h{b}) = expect_list_cx;
122is \$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}
72ed4618
FC
154
155# Arrays
156
4779e7f9
FC
157package 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;
3f114923 165 \@a = expect_scalar_cx;
4779e7f9 166 is \@a, \@ThatArray, '\@lexical';
9782ce69 167 (\@b) = expect_list_cx_a;
4779e7f9
FC
168 is \@b, \@ThatArray, '(\@pkg)';
169 my @b;
9782ce69 170 (\@b) = expect_list_cx_a;
4779e7f9 171 is \@b, \@ThatArray, '(\@lexical)';
3f114923 172 \my @c = expect_scalar_cx;
4779e7f9 173 is \@c, \@ThatArray, '\my @lexical';
bdaf10a5 174 (\my @d) = expect_list_cx_a;
4779e7f9 175 is \@d, \@ThatArray, '(\my @lexical)';
bdaf10a5
FC
176 \(@e) = expect_list_cx;
177 is \$e[0].\$e[1], \$_.\$_, '\(@pkg)';
4779e7f9 178 my @e;
bdaf10a5
FC
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)';
30494daf 185 my $old = \@h;
30494daf
FC
186 {
187 \local @h = \@ThatArray;
188 is \@h, \@ThatArray, '\local @a';
189 }
30494daf
FC
190 is \@h, $old, '\local @a unwound';
191 $old = \@i;
30494daf
FC
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';
4779e7f9 197}
72ed4618
FC
198
199# Hashes
200
87da42eb
FC
201package HashTest {
202 BEGIN { *is = *main::is }
203 sub expect_scalar_cx { wantarray ? 0 : \%ThatHash }
204 sub expect_list_cx { wantarray ? (\%ThatHash)x2 : 0 }
3f114923 205 \%a = expect_scalar_cx;
87da42eb
FC
206 is \%a, \%ThatHash, '\%pkg';
207 my %a;
3f114923 208 \%a = expect_scalar_cx;
87da42eb 209 is \%a, \%ThatHash, '\%lexical';
9782ce69
FC
210 (\%b) = expect_list_cx;
211 is \%b, \%ThatHash, '(\%pkg)';
87da42eb 212 my %b;
9782ce69 213 (\%b) = expect_list_cx;
87da42eb 214 is \%b, \%ThatHash, '(\%lexical)';
3f114923 215 \my %c = expect_scalar_cx;
87da42eb 216 is \%c, \%ThatHash, '\my %lexical';
9782ce69 217 (\my %d) = expect_list_cx;
87da42eb 218 is \%d, \%ThatHash, '(\my %lexical)';
30494daf 219 my $old = \%h;
30494daf
FC
220 {
221 \local %h = \%ThatHash;
222 is \%h, \%ThatHash, '\local %a';
223 }
30494daf
FC
224 is \%h, $old, '\local %a unwound';
225 $old = \%i;
30494daf
FC
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';
87da42eb 231}
72ed4618
FC
232
233# Subroutines
234
408e9044
FC
235package 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}
72ed4618 266
b7ae253e 267# Mixed List Assignments
72ed4618 268
26a50d99 269(\$tahi, $rua) = \(1,2);
9fc71ff4
FC
270is join(' ', $tahi, $$rua), '1 2',
271 'mixed scalar ref and scalar list assignment';
b7ae253e
FC
272
273# Conditional expressions
274
9fc71ff4 275$_ = 3;
d1094c5b 276$_ == 3 ? \$tahi : $rua = \3;
9fc71ff4 277is $tahi, 3, 'cond assignment resolving to scalar ref';
d1094c5b 278$_ == 0 ? \$toru : $wha = \3;
9fc71ff4 279is $$wha, 3, 'cond assignment resolving to scalar';
d1094c5b 280$_ == 3 ? \$rima : \$ono = \5;
9e592f5a 281is $rima, 5, 'cond assignment with refgens on both branches';
7664512e
FC
282\($_ == 3 ? $whitu : $waru) = \5;
283is $whitu, 5, '\( ?: ) assignment';
72ed4618 284
096cc2cc
FC
285# Foreach
286
9e592f5a 287on;
096cc2cc
FC
288eval '
289 for \my $a(\$for1, \$for2) {
290 push @for, \$a;
291 }
292';
293is "@for", \$for1 . ' ' . \$for2, 'foreach \my $a';
294
295@for = ();
296eval '
297 for \my @a([1,2], [3,4]) {
298 push @for, @a;
299 }
300';
301is "@for", "1 2 3 4", 'foreach \my @a [perl #22335]';
302
303@for = ();
304eval '
305 for \my %a({5,6}, {7,8}) {
306 push @for, %a;
307 }
308';
309is "@for", "5 6 7 8", 'foreach \my %a [perl #22335]';
310
311@for = ();
312eval '
313 for \my &a(sub {9}, sub {10}) {
314 push @for, &a;
315 }
316';
317is "@for", "9 10", 'foreach \my &a';
318
319
72ed4618
FC
320# Errors
321
b3717a0e
FC
322off;
323eval { my $x; \$x = 3 };
324like $@, qr/^Assigned value is not a reference at/, 'assigning non-ref';
325eval { my $x; \$x = [] };
326like $@, qr/^Assigned value is not a SCALAR reference at/,
327 'assigning non-scalar ref to scalar ref';
d8a875d9
FC
328eval { \$::x = [] };
329like $@, qr/^Assigned value is not a SCALAR reference at/,
330 'assigning non-scalar ref to package scalar ref';
0719038d
FC
331eval { my @x; \@x = {} };
332like $@, qr/^Assigned value is not an ARRAY reference at/,
333 'assigning non-array ref to array ref';
334eval { \@::x = {} };
335like $@, qr/^Assigned value is not an ARRAY reference at/,
336 'assigning non-array ref to package array ref';
337eval { my %x; \%x = [] };
338like $@, qr/^Assigned value is not a HASH reference at/,
339 'assigning non-hash ref to hash ref';
340eval { \%::x = [] };
341like $@, qr/^Assigned value is not a HASH reference at/,
342 'assigning non-hash ref to package hash ref';
408e9044
FC
343eval { use feature 'lexical_subs';
344 no warnings 'experimental::lexical_subs';
345 my sub x; \&x = [] };
346like $@, qr/^Assigned value is not a CODE reference at/,
347 'assigning non-code ref to lexical code ref';
348eval { \&::x = [] };
349like $@, qr/^Assigned value is not a CODE reference at/,
350 'assigning non-code ref to package code ref';
d6378458 351
bd9bf01b
FC
352eval { my $x; (\$x) = 3 };
353like $@, qr/^Assigned value is not a reference at/,
354 'list-assigning non-ref';
355eval { my $x; (\$x) = [] };
356like $@, qr/^Assigned value is not a SCALAR reference at/,
357 'list-assigning non-scalar ref to scalar ref';
358eval { (\$::x = []) };
359like $@, qr/^Assigned value is not a SCALAR reference at/,
360 'list-assigning non-scalar ref to package scalar ref';
361eval { my @x; (\@x) = {} };
362like $@, qr/^Assigned value is not an ARRAY reference at/,
363 'list-assigning non-array ref to array ref';
364eval { (\@::x) = {} };
365like $@, qr/^Assigned value is not an ARRAY reference at/,
366 'list-assigning non-array ref to package array ref';
367eval { my %x; (\%x) = [] };
368like $@, qr/^Assigned value is not a HASH reference at/,
369 'list-assigning non-hash ref to hash ref';
370eval { (\%::x) = [] };
371like $@, qr/^Assigned value is not a HASH reference at/,
372 'list-assigning non-hash ref to package hash ref';
408e9044
FC
373eval { use feature 'lexical_subs';
374 no warnings 'experimental::lexical_subs';
375 my sub x; (\&x) = [] };
376like $@, qr/^Assigned value is not a CODE reference at/,
377 'list-assigning non-code ref to lexical code ref';
378eval { (\&::x) = [] };
379like $@, qr/^Assigned value is not a CODE reference at/,
380 'list-assigning non-code ref to package code ref';
bd9bf01b 381
d6378458
FC
382eval '(\do{}) = 42';
383like $@, qr/^Can't modify reference to do block in list assignment at /,
384 "Can't modify reference to do block in list assignment";
d6378458
FC
385eval '(\pos) = 42';
386like $@,
387 qr/^Can't modify reference to match position in list assignment at /,
388 "Can't modify ref to some scalar-returning op in list assignment";
d6378458
FC
389eval '(\glob) = 42';
390like $@,
391 qr/^Can't modify reference to glob in list assignment at /,
392 "Can't modify reference to some list-returning op in list assignment";
d6b7592f
FC
393eval '\pos = 42';
394like $@,
395 qr/^Can't modify reference to match position in scalar assignment at /,
396 "Can't modify ref to some scalar-returning op in scalar assignment";
30494daf
FC
397eval '\(local @b) = 42';
398like $@,
bdaf10a5 399 qr/^Can't modify reference to localized parenthesized array in list(?x:
30494daf
FC
400 ) assignment at /,
401 q"Can't modify \(local @array) in list assignment";
402eval '\local(@b) = 42';
403like $@,
bdaf10a5 404 qr/^Can't modify reference to localized parenthesized array in list(?x:
30494daf
FC
405 ) assignment at /,
406 q"Can't modify \local(@array) in list assignment";
bdaf10a5
FC
407eval '\local(@{foo()}) = 42';
408like $@,
409 qr/^Can't modify reference to array dereference in list assignment at/,
410 q"'Array deref' error takes prec. over 'local paren' error";
87da42eb
FC
411eval '\(%b) = 42';
412like $@,
413 qr/^Can't modify reference to parenthesized hash in list assignment a/,
414 "Can't modify ref to parenthesized package hash in scalar assignment";
415eval '\(my %b) = 42';
416like $@,
417 qr/^Can't modify reference to parenthesized hash in list assignment a/,
418 "Can't modify ref to parenthesized hash (\(my %b)) in list assignment";
419eval '\my(%b) = 42';
420like $@,
421 qr/^Can't modify reference to parenthesized hash in list assignment a/,
422 "Can't modify ref to parenthesized hash (\my(%b)) in list assignment";
423eval '\%{"42"} = 42';
424like $@,
425 qr/^Can't modify reference to hash dereference in scalar assignment a/,
426 "Can't modify reference to hash dereference in scalar assignment";
3f114923 427on;
87da42eb 428
781ff25d
FC
429
430# Miscellaneous
431
432{
433 my($x,$y);
434 sub {
435 sub {
436 \$x = \$y;
437 }->();
438 is \$x, \$y, 'lexical alias affects outer closure';
439 }->();
440 is \$x, \$y, 'lexical alias affects outer sub where vars are declared';
441}
81cb1af6
FC
442
443{ # PADSTALE has a double meaning
444 use feature 'lexical_subs', 'signatures', 'state';
445 no warnings 'experimental';
446 my $c;
447 my sub s ($arg) {
448 state $x = ++$c;
449 if ($arg == 3) { return $c }
450 goto skip if $arg == 2;
451 my $y;
452 skip:
453 # $y is PADSTALE the 2nd time
454 \$x = \$y if $arg == 2;
455 }
456 s(1);
457 s(2);
458 is s(3), 1, 'padstale alias should not reset state'
459}
cf5d2d91
FC
460
461off;
462SKIP: {
463 skip_without_dynamic_extension('List/Util');
464 require Scalar::Util;
465 my $a;
466 Scalar::Util::weaken($r = \$a);
467 \$a = $r;
468 pass 'no crash when assigning \$lex = $weakref_to_lex'
469}