xref: /openbsd-src/gnu/usr.bin/perl/t/op/lvref.t (revision 3d61058aa5c692477b6d18acfbbdb653a9930ff9)
156d68f1eSafresh1#!perl
2b8851fccSafresh1BEGIN {
3b8851fccSafresh1    chdir 't';
4b8851fccSafresh1    require './test.pl';
5b8851fccSafresh1    set_up_inc("../lib");
6b8851fccSafresh1}
7b8851fccSafresh1
8*3d61058aSafresh1plan 201;
9b8851fccSafresh1
10b8851fccSafresh1eval '\$x = \$y';
11b8851fccSafresh1like $@, qr/^Experimental aliasing via reference not enabled/,
12b8851fccSafresh1    'error when feature is disabled';
13b8851fccSafresh1eval '\($x) = \$y';
14b8851fccSafresh1like $@, qr/^Experimental aliasing via reference not enabled/,
15b8851fccSafresh1    'error when feature is disabled (aassign)';
16b8851fccSafresh1
17b8851fccSafresh1use feature 'refaliasing', 'state';
18b8851fccSafresh1
19b8851fccSafresh1{
20b8851fccSafresh1    my($w,$c);
21b8851fccSafresh1    local $SIG{__WARN__} = sub { $c++; $w = shift };
22b8851fccSafresh1    eval '\$x = \$y';
23b8851fccSafresh1    is $c, 1, 'one warning from lv ref assignment';
24b8851fccSafresh1    like $w, qr/^Aliasing via reference is experimental/,
25b8851fccSafresh1        'experimental warning';
26b8851fccSafresh1    undef $c;
27b8851fccSafresh1    eval '\($x) = \$y';
28b8851fccSafresh1    is $c, 1, 'one warning from lv ref list assignment';
29b8851fccSafresh1    like $w, qr/^Aliasing via reference is experimental/,
30b8851fccSafresh1        'experimental warning';
31b8851fccSafresh1}
32b8851fccSafresh1
33b8851fccSafresh1no warnings 'experimental::refaliasing';
34b8851fccSafresh1
35b8851fccSafresh1# Scalars
36b8851fccSafresh1
37b8851fccSafresh1\$x = \$y;
38b8851fccSafresh1is \$x, \$y, '\$pkg_scalar = ...';
39b8851fccSafresh1my $m;
40b8851fccSafresh1\$m = \$y;
41b8851fccSafresh1is \$m, \$y, '\$lexical = ...';
42b8851fccSafresh1\my $n = \$y;
43b8851fccSafresh1is \$n, \$y, '\my $lexical = ...';
44b8851fccSafresh1@_ = \$_;
45b8851fccSafresh1\($x) = @_;
46b8851fccSafresh1is \$x, \$_, '\($pkgvar) = ... gives list context';
47b8851fccSafresh1undef *x;
48b8851fccSafresh1(\$x) = @_;
49b8851fccSafresh1is \$x, \$_, '(\$pkgvar) = ... gives list context';
50b8851fccSafresh1my $o;
51b8851fccSafresh1\($o) = @_;
52b8851fccSafresh1is \$o, \$_, '\($lexical) = ... gives list cx';
53b8851fccSafresh1my $q;
54b8851fccSafresh1(\$q) = @_;
55b8851fccSafresh1is \$q, \$_, '(\$lexical) = ... gives list cx';
56b8851fccSafresh1\(my $p) = @_;
57b8851fccSafresh1is \$p, \$_, '\(my $lexical) = ... gives list cx';
58b8851fccSafresh1(\my $r) = @_;
59b8851fccSafresh1is \$r, \$_, '(\my $lexical) = ... gives list cx';
60b8851fccSafresh1\my($s) = @_;
61b8851fccSafresh1is \$s, \$_, '\my($lexical) = ... gives list cx';
62b8851fccSafresh1\($_a, my $a) = @{[\$b, \$c]};
63b8851fccSafresh1is \$_a, \$b, 'package scalar in \(...)';
64b8851fccSafresh1is \$a, \$c, 'lex scalar in \(...)';
65b8851fccSafresh1(\$_b, \my $b) = @{[\$b, \$c]};
66b8851fccSafresh1is \$_b, \$::b, 'package scalar in (\$foo, \$bar)';
67b8851fccSafresh1is \$b, \$c, 'lex scalar in (\$foo, \$bar)';
68b8851fccSafresh1is do { \local $l = \3; $l }, 3, '\local $scalar assignment';
69b8851fccSafresh1is $l, undef, 'localisation unwound';
70b8851fccSafresh1is do { \(local $l) = \4; $l }, 4, '\(local $scalar) assignment';
71b8851fccSafresh1is $l, undef, 'localisation unwound';
72b8851fccSafresh1\$foo = \*bar;
73b8851fccSafresh1is *foo{SCALAR}, *bar{GLOB}, 'globref-to-scalarref assignment';
74b8851fccSafresh1for (1,2) {
75b8851fccSafresh1  \my $x = \3,
76b8851fccSafresh1  \my($y) = \3,
77b8851fccSafresh1  \state $a = \3,
78b8851fccSafresh1  \state($b) = \3 if $_ == 1;
79*3d61058aSafresh1  \state $c = \$_;
80b8851fccSafresh1  if ($_ == 2) {
81b8851fccSafresh1    is $x, undef, '\my $x = ... clears $x on scope exit';
82b8851fccSafresh1    is $y, undef, '\my($x) = ... clears $x on scope exit';
83b8851fccSafresh1    is $a, 3, '\state $x = ... does not clear $x on scope exit';
84b8851fccSafresh1    is $b, 3, '\state($x) = ... does not clear $x on scope exit';
85*3d61058aSafresh1    is $c, 1, '\state $x = ... can be used with refaliasing';
86b8851fccSafresh1  }
87b8851fccSafresh1}
88b8851fccSafresh1
89*3d61058aSafresh1# Scalars in lvalue context
90*3d61058aSafresh1
91*3d61058aSafresh1{
92*3d61058aSafresh1    my $s = 3;
93*3d61058aSafresh1    my $t = 5;
94*3d61058aSafresh1
95*3d61058aSafresh1    sub foo1 {
96*3d61058aSafresh1        ok ref($_[0]),   "foo1(alias) passes ref";
97*3d61058aSafresh1        is ${$_[0]}, 5,  "foo1(alias) passes ref to t";
98*3d61058aSafresh1        ${$_[0]} = 7;
99*3d61058aSafresh1    }
100*3d61058aSafresh1    foo1(\$s = \$t);
101*3d61058aSafresh1    is $s, 7,  "foo1(alias) passes ref to t"
102*3d61058aSafresh1}
103*3d61058aSafresh1
104*3d61058aSafresh1
105*3d61058aSafresh1
106b8851fccSafresh1# Array Elements
107b8851fccSafresh1
108b8851fccSafresh1sub expect_scalar_cx { wantarray ? 0 : \$_ }
109b8851fccSafresh1sub expect_list_cx { wantarray ? (\$_,\$_) : 0 }
110b8851fccSafresh1\$a[0] = expect_scalar_cx;
111b8851fccSafresh1is \$a[0], \$_, '\$array[0]';
112b8851fccSafresh1\($a[1]) = expect_list_cx;
113b8851fccSafresh1is \$a[1], \$_, '\($array[0])';
114b8851fccSafresh1{
115b8851fccSafresh1  my @a;
116b8851fccSafresh1  \$a[0] = expect_scalar_cx;
117b8851fccSafresh1  is \$a[0], \$_, '\$lexical_array[0]';
118b8851fccSafresh1  \($a[1]) = expect_list_cx;
119b8851fccSafresh1  is \$a[1], \$_, '\($lexical_array[0])';
120b8851fccSafresh1  my $tmp;
121b8851fccSafresh1  {
122b8851fccSafresh1    \local $a[0] = \$tmp;
123b8851fccSafresh1    is \$a[0], \$tmp, '\local $a[0]';
124b8851fccSafresh1  }
125b8851fccSafresh1  is \$a[0], \$_, '\local $a[0] unwound';
126b8851fccSafresh1  {
127b8851fccSafresh1    \local ($a[1]) = \$tmp;
128b8851fccSafresh1    is \$a[1], \$tmp, '\local ($a[0])';
129b8851fccSafresh1  }
130b8851fccSafresh1  is \$a[1], \$_, '\local $a[0] unwound';
131b8851fccSafresh1}
132b8851fccSafresh1{
133b8851fccSafresh1  my @a;
134b8851fccSafresh1  \@a[0,1] = expect_list_cx;
135b8851fccSafresh1  is \$a[0].\$a[1], \$_.\$_, '\@array[indices]';
136b8851fccSafresh1  \(@a[2,3]) = expect_list_cx;
137b8851fccSafresh1  is \$a[0].\$a[1], \$_.\$_, '\(@array[indices])';
138b8851fccSafresh1  my $tmp;
139b8851fccSafresh1  {
140b8851fccSafresh1    \local @a[0,1] = (\$tmp)x2;
141b8851fccSafresh1    is \$a[0].\$a[1], \$tmp.\$tmp, '\local @a[indices]';
142b8851fccSafresh1  }
143b8851fccSafresh1  is \$a[0].\$a[1], \$_.\$_, '\local @a[indices] unwound';
144b8851fccSafresh1}
145b8851fccSafresh1
146b8851fccSafresh1# Hash Elements
147b8851fccSafresh1
148b8851fccSafresh1\$h{a} = expect_scalar_cx;
149b8851fccSafresh1is \$h{a}, \$_, '\$hash{a}';
150b8851fccSafresh1\($h{b}) = expect_list_cx;
151b8851fccSafresh1is \$h{b}, \$_, '\($hash{a})';
152b8851fccSafresh1{
153b8851fccSafresh1  my %h;
154b8851fccSafresh1  \$h{a} = expect_scalar_cx;
155b8851fccSafresh1  is \$h{a}, \$_, '\$lexical_array{a}';
156b8851fccSafresh1  \($h{b}) = expect_list_cx;
157b8851fccSafresh1  is \$h{b}, \$_, '\($lexical_array{a})';
158b8851fccSafresh1  my $tmp;
159b8851fccSafresh1  {
160b8851fccSafresh1    \local $h{a} = \$tmp;
161b8851fccSafresh1    is \$h{a}, \$tmp, '\local $h{a}';
162b8851fccSafresh1  }
163b8851fccSafresh1  is \$h{a}, \$_, '\local $h{a} unwound';
164b8851fccSafresh1  {
165b8851fccSafresh1    \local ($h{b}) = \$tmp;
166b8851fccSafresh1    is \$h{b}, \$tmp, '\local ($h{a})';
167b8851fccSafresh1  }
168b8851fccSafresh1  is \$h{b}, \$_, '\local $h{a} unwound';
169b8851fccSafresh1}
170b8851fccSafresh1{
171b8851fccSafresh1  my %h;
172b8851fccSafresh1  \@h{"a","b"} = expect_list_cx;
173b8851fccSafresh1  is \$h{a}.\$h{b}, \$_.\$_, '\@hash{indices}';
174b8851fccSafresh1  \(@h{2,3}) = expect_list_cx;
175b8851fccSafresh1  is \$h{a}.\$h{b}, \$_.\$_, '\(@hash{indices})';
176b8851fccSafresh1  my $tmp;
177b8851fccSafresh1  {
178b8851fccSafresh1    \local @h{"a","b"} = (\$tmp)x2;
179b8851fccSafresh1    is \$h{a}.\$h{b}, \$tmp.\$tmp, '\local @h{indices}';
180b8851fccSafresh1  }
181b8851fccSafresh1  is \$h{a}.\$h{b}, \$_.\$_, '\local @h{indices} unwound';
182b8851fccSafresh1}
183b8851fccSafresh1
184b8851fccSafresh1# Arrays
185b8851fccSafresh1
186b8851fccSafresh1package ArrayTest {
187b8851fccSafresh1  BEGIN { *is = *main::is }
188b8851fccSafresh1  sub expect_scalar_cx { wantarray ? 0 : \@ThatArray }
189b8851fccSafresh1  sub expect_list_cx   { wantarray ? (\$_,\$_) : 0 }
190b8851fccSafresh1  sub expect_list_cx_a { wantarray ? (\@ThatArray)x2 : 0 }
191b8851fccSafresh1  \@a = expect_scalar_cx;
192b8851fccSafresh1  is \@a, \@ThatArray, '\@pkg';
193b8851fccSafresh1  my @a;
194b8851fccSafresh1  \@a = expect_scalar_cx;
195b8851fccSafresh1  is \@a, \@ThatArray, '\@lexical';
196b8851fccSafresh1  (\@b) = expect_list_cx_a;
197b8851fccSafresh1  is \@b, \@ThatArray, '(\@pkg)';
198b8851fccSafresh1  my @b;
199b8851fccSafresh1  (\@b) = expect_list_cx_a;
200b8851fccSafresh1  is \@b, \@ThatArray, '(\@lexical)';
201b8851fccSafresh1  \my @c = expect_scalar_cx;
202b8851fccSafresh1  is \@c, \@ThatArray, '\my @lexical';
203b8851fccSafresh1  (\my @d) = expect_list_cx_a;
204b8851fccSafresh1  is \@d, \@ThatArray, '(\my @lexical)';
205b8851fccSafresh1  \(@e) = expect_list_cx;
206b8851fccSafresh1  is \$e[0].\$e[1], \$_.\$_, '\(@pkg)';
207b8851fccSafresh1  my @e;
208b8851fccSafresh1  \(@e) = expect_list_cx;
209b8851fccSafresh1  is \$e[0].\$e[1], \$_.\$_, '\(@lexical)';
210b8851fccSafresh1  \(my @f) = expect_list_cx;
211b8851fccSafresh1  is \$f[0].\$f[1], \$_.\$_, '\(my @lexical)';
212b8851fccSafresh1  \my(@g) = expect_list_cx;
213b8851fccSafresh1  is \$g[0].\$g[1], \$_.\$_, '\my(@lexical)';
214b8851fccSafresh1  my $old = \@h;
215b8851fccSafresh1  {
216b8851fccSafresh1    \local @h = \@ThatArray;
217b8851fccSafresh1    is \@h, \@ThatArray, '\local @a';
218b8851fccSafresh1  }
219b8851fccSafresh1  is \@h, $old, '\local @a unwound';
220b8851fccSafresh1  $old = \@i;
221b8851fccSafresh1  {
222b8851fccSafresh1    (\local @i) = \@ThatArray;
223b8851fccSafresh1    is \@i, \@ThatArray, '(\local @a)';
224b8851fccSafresh1  }
225b8851fccSafresh1  is \@i, $old, '(\local @a) unwound';
226b8851fccSafresh1}
227*3d61058aSafresh1
228*3d61058aSafresh1# Test list assignments in both lval and rval list context
229*3d61058aSafresh1#
230*3d61058aSafresh1# Note that these tests essentially just codify current behaviour.
231*3d61058aSafresh1# Whether that behaviour is sane is a debatable point. (See
232*3d61058aSafresh1# http://nntp.perl.org/group/perl.perl5.porters/267074
233*3d61058aSafresh1# "refaliasing list assignment in list context")
234*3d61058aSafresh1
235*3d61058aSafresh1{
236*3d61058aSafresh1    # First, confirm behaviour in void context
237*3d61058aSafresh1
238*3d61058aSafresh1    {
239*3d61058aSafresh1        my (@a, @b, $p);
240*3d61058aSafresh1        my ($x, $y, $z) = qw(X Y Z);
241*3d61058aSafresh1
242*3d61058aSafresh1        (\$p, \(@a)) = (\$x, \$y, \$z);
243*3d61058aSafresh1
244*3d61058aSafresh1        is \$p,    \$x, '(\$p, \(@a)) = ...;    $p    is alias';
245*3d61058aSafresh1        is \$a[0], \$y, '(\$p, \(@a)) = ...;    $a[0] is alias';
246*3d61058aSafresh1        is \$a[1], \$z, '(\$p, \(@a)) = ...;    $a[1] is alias';
247*3d61058aSafresh1    }
248*3d61058aSafresh1
249*3d61058aSafresh1    # then confirm behaviour in scalar context
250*3d61058aSafresh1
251*3d61058aSafresh1    {
252*3d61058aSafresh1        my (@a, @b, $p);
253*3d61058aSafresh1        my ($x, $y, $z) = qw(X Y Z);
254*3d61058aSafresh1
255*3d61058aSafresh1        my $n = ((\$p, \(@a)) = (\$x, \$y, \$z));
256*3d61058aSafresh1
257*3d61058aSafresh1        is \$p,    \$x, '$n = (\$p, \(@a)) = ...;    $p    is alias';
258*3d61058aSafresh1        is \$a[0], \$y, '$n = (\$p, \(@a)) = ...;    $a[0] is alias';
259*3d61058aSafresh1        is \$a[1], \$z, '$n = (\$p, \(@a)) = ...;    $a[1] is alias';
260*3d61058aSafresh1        is $n, 3,       '$n = (\$p, \(@a)) = ...;    n is 3';
261*3d61058aSafresh1    }
262*3d61058aSafresh1
263*3d61058aSafresh1    # Now the real tests, first in rvalue list context
264*3d61058aSafresh1
265*3d61058aSafresh1    {
266*3d61058aSafresh1        my (@a, @b, $p);
267*3d61058aSafresh1        my ($x, $y, $z) = qw(X Y Z);
268*3d61058aSafresh1
269*3d61058aSafresh1        @b = ((\$p, \(@a)) = (\$x, \$y, \$z));
270*3d61058aSafresh1
271*3d61058aSafresh1        is \$p,    \$x, '@b = (\$p, \(@a) = ...);    $p    is alias';
272*3d61058aSafresh1        is \$a[0], \$y, '@b = (\$p, \(@a) = ...);    $a[0] is alias';
273*3d61058aSafresh1        is \$a[1], \$z, '@b = (\$p, \(@a) = ...);    $a[1] is alias';
274*3d61058aSafresh1        ok ref $b[0],   '@b = (\$p, \(@a) = ...);    $b[0] is ref';
275*3d61058aSafresh1        ok ref $b[1],   '@b = (\$p, \(@a) = ...);    $b[1] is ref';
276*3d61058aSafresh1        ok ref $b[2],   '@b = (\$p, \(@a) = ...);    $b[2] is ref';
277*3d61058aSafresh1        is $b[0], \$x,  '@b = (\$p, \(@a) = ...);    $b[0] is ref to alias';
278*3d61058aSafresh1        is $b[1], \$y,  '@b = (\$p, \(@a) = ...);    $b[1] is ref to alias';
279*3d61058aSafresh1        is $b[2], \$z,  '@b = (\$p, \(@a) = ...);    $b[2] is ref to alias';
280*3d61058aSafresh1    }
281*3d61058aSafresh1
282*3d61058aSafresh1    # The same, now in lvalue list context
283*3d61058aSafresh1    #
284*3d61058aSafresh1    # Note that the outer assign just (uselessly) modifies temporary
285*3d61058aSafresh1    # references to $x etc; it doesn't do any aliasing.
286*3d61058aSafresh1
287*3d61058aSafresh1    {
288*3d61058aSafresh1        my (@a, @b, $p);
289*3d61058aSafresh1        my ($x, $y, $z) = qw(X Y Z);
290*3d61058aSafresh1        my ($rx, $ry, $rz) = \($x, $y, $z);
291*3d61058aSafresh1
292*3d61058aSafresh1        ((\$p, \(@a)) = ($rx, $ry, $rz)) = \(qw(A B C));
293*3d61058aSafresh1
294*3d61058aSafresh1        is \$p,    \$x, '(\$p, \(@a) = ...) = @b;    $p    is alias';
295*3d61058aSafresh1        is \$a[0], \$y, '(\$p, \(@a) = ...) = @b;    $a[0] is alias';
296*3d61058aSafresh1        is \$a[1], \$z, '(\$p, \(@a) = ...) = @b;    $a[1] is alias';
297*3d61058aSafresh1        ok ref $rx,     '(\$p, \(@a) = ...) = @b;    $rx   is still ref';
298*3d61058aSafresh1        ok ref $ry,     '(\$p, \(@a) = ...) = @b;    $ry   is still ref';
299*3d61058aSafresh1        ok ref $rz,     '(\$p, \(@a) = ...) = @b;    $ry   is still ref';
300*3d61058aSafresh1        is $rx, \$x,    '(\$p, \(@a) = ...) = @b;    $rx   is still ref to $x';
301*3d61058aSafresh1        is $ry, \$y,    '(\$p, \(@a) = ...) = @b;    $ry   is still ref to $y';
302*3d61058aSafresh1        is $rz, \$z,    '(\$p, \(@a) = ...) = @b;    $rz   is still ref to $z';
303*3d61058aSafresh1        is $x, 'X',     '(\$p, \(@a) = ...) = @b;    $x    is still X';
304*3d61058aSafresh1        is $y, 'Y',     '(\$p, \(@a) = ...) = @b;    $y    is still Y';
305*3d61058aSafresh1        is $z, 'Z',     '(\$p, \(@a) = ...) = @b;    $z    is still Z';
306*3d61058aSafresh1    }
307*3d61058aSafresh1}
308*3d61058aSafresh1
309*3d61058aSafresh1
310b8851fccSafresh1for (1,2) {
311b8851fccSafresh1  \my @x = [1..3],
312b8851fccSafresh1  \my(@y) = \3,
313b8851fccSafresh1  \state @a = [1..3],
314b8851fccSafresh1  \state(@b) = \3 if $_ == 1;
315*3d61058aSafresh1  \state @c = [$_];
316b8851fccSafresh1  if ($_ == 2) {
317b8851fccSafresh1    is @x, 0, '\my @x = ... clears @x on scope exit';
318b8851fccSafresh1    is @y, 0, '\my(@x) = ... clears @x on scope exit';
319b8851fccSafresh1    is "@a", "1 2 3", '\state @x = ... does not clear @x on scope exit';
320b8851fccSafresh1    is "@b", 3, '\state(@x) = ... does not clear @x on scope exit';
321*3d61058aSafresh1    is $c[0], 1, '\state @x = ... can be used with refaliasing';
322b8851fccSafresh1  }
323b8851fccSafresh1}
324b8851fccSafresh1
325b8851fccSafresh1# Hashes
326b8851fccSafresh1
327b8851fccSafresh1package HashTest {
328b8851fccSafresh1  BEGIN { *is = *main::is }
329b8851fccSafresh1  sub expect_scalar_cx { wantarray ? 0 : \%ThatHash }
330b8851fccSafresh1  sub expect_list_cx   { wantarray ? (\%ThatHash)x2 : 0 }
331b8851fccSafresh1  \%a = expect_scalar_cx;
332b8851fccSafresh1  is \%a, \%ThatHash, '\%pkg';
333b8851fccSafresh1  my %a;
334b8851fccSafresh1  \%a = expect_scalar_cx;
335b8851fccSafresh1  is \%a, \%ThatHash, '\%lexical';
336b8851fccSafresh1  (\%b) = expect_list_cx;
337b8851fccSafresh1  is \%b, \%ThatHash, '(\%pkg)';
338b8851fccSafresh1  my %b;
339b8851fccSafresh1  (\%b) = expect_list_cx;
340b8851fccSafresh1  is \%b, \%ThatHash, '(\%lexical)';
341b8851fccSafresh1  \my %c = expect_scalar_cx;
342b8851fccSafresh1  is \%c, \%ThatHash, '\my %lexical';
343b8851fccSafresh1  (\my %d) = expect_list_cx;
344b8851fccSafresh1  is \%d, \%ThatHash, '(\my %lexical)';
345b8851fccSafresh1  my $old = \%h;
346b8851fccSafresh1  {
347b8851fccSafresh1    \local %h = \%ThatHash;
348b8851fccSafresh1    is \%h, \%ThatHash, '\local %a';
349b8851fccSafresh1  }
350b8851fccSafresh1  is \%h, $old, '\local %a unwound';
351b8851fccSafresh1  $old = \%i;
352b8851fccSafresh1  {
353b8851fccSafresh1    (\local %i) = \%ThatHash;
354b8851fccSafresh1    is \%i, \%ThatHash, '(\local %a)';
355b8851fccSafresh1  }
356b8851fccSafresh1  is \%i, $old, '(\local %a) unwound';
357b8851fccSafresh1}
358b8851fccSafresh1for (1,2) {
359b8851fccSafresh1  \state %y = {1,2},
360b8851fccSafresh1  \my %x = {1,2} if $_ == 1;
361*3d61058aSafresh1  \state %c = {X => $_};
362b8851fccSafresh1  if ($_ == 2) {
363b8851fccSafresh1    is %x, 0, '\my %x = ... clears %x on scope exit';
364b8851fccSafresh1    is "@{[%y]}", "1 2", '\state %x = ... does not clear %x on scope exit';
365*3d61058aSafresh1    is $c{X}, 1, '\state %x = ... can be used with refaliasing';
366b8851fccSafresh1  }
367b8851fccSafresh1}
368b8851fccSafresh1
369b8851fccSafresh1# Subroutines
370b8851fccSafresh1
371b8851fccSafresh1package CodeTest {
372b8851fccSafresh1  BEGIN { *is = *main::is; }
373b8851fccSafresh1  use feature 'lexical_subs';
374b8851fccSafresh1  no warnings 'experimental::lexical_subs';
375b8851fccSafresh1  sub expect_scalar_cx { wantarray ? 0 : \&ThatSub }
376b8851fccSafresh1  sub expect_list_cx   { wantarray ? (\&ThatSub)x2 : 0 }
377b8851fccSafresh1  \&a = expect_scalar_cx;
378b8851fccSafresh1  is \&a, \&ThatSub, '\&pkg';
379b8851fccSafresh1  my sub a;
380b8851fccSafresh1  \&a = expect_scalar_cx;
381b8851fccSafresh1  is \&a, \&ThatSub, '\&mysub';
382b8851fccSafresh1  state sub as;
383b8851fccSafresh1  \&as = expect_scalar_cx;
384b8851fccSafresh1  is \&as, \&ThatSub, '\&statesub';
385b8851fccSafresh1  (\&b) = expect_list_cx;
386b8851fccSafresh1  is \&b, \&ThatSub, '(\&pkg)';
387b8851fccSafresh1  my sub b;
388b8851fccSafresh1  (\&b) = expect_list_cx;
389b8851fccSafresh1  is \&b, \&ThatSub, '(\&mysub)';
390b8851fccSafresh1  my sub bs;
391b8851fccSafresh1  (\&bs) = expect_list_cx;
392b8851fccSafresh1  is \&bs, \&ThatSub, '(\&statesub)';
393b8851fccSafresh1  \(&c) = expect_list_cx;
394b8851fccSafresh1  is \&c, \&ThatSub, '\(&pkg)';
395b8851fccSafresh1  my sub b;
396b8851fccSafresh1  \(&c) = expect_list_cx;
397b8851fccSafresh1  is \&c, \&ThatSub, '\(&mysub)';
398b8851fccSafresh1  my sub bs;
399b8851fccSafresh1  \(&cs) = expect_list_cx;
400b8851fccSafresh1  is \&cs, \&ThatSub, '\(&statesub)';
40156d68f1eSafresh1
40256d68f1eSafresh1  package main {
40356d68f1eSafresh1    # this is only a problem in main:: due to 1e2cfe157ca
40456d68f1eSafresh1    sub sx { "x" }
40556d68f1eSafresh1    sub sy { "y" }
40656d68f1eSafresh1    is sx(), "x", "check original";
40756d68f1eSafresh1    my $temp = \&sx;
40856d68f1eSafresh1    \&sx = \&sy;
40956d68f1eSafresh1    is sx(), "y", "aliased";
41056d68f1eSafresh1    \&sx = $temp;
41156d68f1eSafresh1    is sx(), "x", "and restored";
41256d68f1eSafresh1  }
413b8851fccSafresh1}
414b8851fccSafresh1
415b8851fccSafresh1# Mixed List Assignments
416b8851fccSafresh1
417b8851fccSafresh1(\$tahi, $rua) = \(1,2);
418b8851fccSafresh1is join(' ', $tahi, $$rua), '1 2',
419b8851fccSafresh1  'mixed scalar ref and scalar list assignment';
420b8851fccSafresh1$_ = 1;
421b8851fccSafresh1\($bb, @cc, %dd, &ee, $_==1 ? $ff : @ff, $_==2 ? $gg : @gg, (@hh)) =
422b8851fccSafresh1    (\$BB, \@CC, \%DD, \&EE, \$FF, \@GG, \1, \2, \3);
423b8851fccSafresh1is \$bb, \$BB, '\$scalar in list assignment';
424b8851fccSafresh1is \@cc, \@CC, '\@array in list assignment';
425b8851fccSafresh1is \%dd, \%DD, '\%hash in list assignment';
426b8851fccSafresh1is \&ee, \&EE, '\&code in list assignment';
427b8851fccSafresh1is \$ff, \$FF, '$scalar in \ternary in list assignment';
428b8851fccSafresh1is \@gg, \@GG, '@gg in \ternary in list assignment';
429b8851fccSafresh1is "@hh", '1 2 3', '\(@array) in list assignment';
430b8851fccSafresh1
431b8851fccSafresh1# Conditional expressions
432b8851fccSafresh1
433b8851fccSafresh1$_ = 3;
434b8851fccSafresh1$_ == 3 ? \$tahi : $rua = \3;
435b8851fccSafresh1is $tahi, 3, 'cond assignment resolving to scalar ref';
436b8851fccSafresh1$_ == 0 ? \$toru : $wha = \3;
437b8851fccSafresh1is $$wha, 3, 'cond assignment resolving to scalar';
438b8851fccSafresh1$_ == 3 ? \$rima : \$ono = \5;
439b8851fccSafresh1is $rima, 5, 'cond assignment with refgens on both branches';
440b8851fccSafresh1\($_ == 3 ? $whitu : $waru) = \5;
441b8851fccSafresh1is $whitu, 5, '\( ?: ) assignment';
442b8851fccSafresh1\($_ == 3 ? $_ < 4 ? $ii : $_ : $_) = \$_;
443b8851fccSafresh1is \$ii, \$_, 'nested \ternary assignment';
444b8851fccSafresh1
445b8851fccSafresh1# Foreach
446b8851fccSafresh1
447b8851fccSafresh1for \my $topic (\$for1, \$for2) {
448b8851fccSafresh1    push @for, \$topic;
449b8851fccSafresh1}
450b8851fccSafresh1is "@for", \$for1 . ' ' . \$for2, 'foreach \my $a';
451b8851fccSafresh1is \$topic, \$::topic, 'for \my scoping';
452b8851fccSafresh1
453b8851fccSafresh1@for = ();
454b8851fccSafresh1for \$::a(\$for1, \$for2) {
455b8851fccSafresh1    push @for, \$::a;
456b8851fccSafresh1}
457b8851fccSafresh1is "@for", \$for1 . ' ' . \$for2, 'foreach \$::a';
458b8851fccSafresh1
459b8851fccSafresh1@for = ();
460b8851fccSafresh1for \my @a([1,2], [3,4]) {
461b8851fccSafresh1    push @for, @a;
462b8851fccSafresh1}
463b8851fccSafresh1is "@for", "1 2 3 4", 'foreach \my @a [perl #22335]';
464b8851fccSafresh1
465b8851fccSafresh1@for = ();
466b8851fccSafresh1for \@::a([1,2], [3,4]) {
467b8851fccSafresh1    push @for, @::a;
468b8851fccSafresh1}
469b8851fccSafresh1is "@for", "1 2 3 4", 'foreach \@::a [perl #22335]';
470b8851fccSafresh1
471b8851fccSafresh1@for = ();
472b8851fccSafresh1for \my %a({5,6}, {7,8}) {
473b8851fccSafresh1    push @for, %a;
474b8851fccSafresh1}
475b8851fccSafresh1is "@for", "5 6 7 8", 'foreach \my %a [perl #22335]';
476b8851fccSafresh1
477b8851fccSafresh1@for = ();
478b8851fccSafresh1for \%::a({5,6}, {7,8}) {
479b8851fccSafresh1    push @for, %::a;
480b8851fccSafresh1}
481b8851fccSafresh1is "@for", "5 6 7 8", 'foreach \%::a [perl #22335]';
482b8851fccSafresh1
483b8851fccSafresh1@for = ();
484b8851fccSafresh1{
485b8851fccSafresh1  use feature 'lexical_subs';
486b8851fccSafresh1  no warnings 'experimental::lexical_subs';
487b8851fccSafresh1  my sub a;
488b8851fccSafresh1  for \&a(sub {9}, sub {10}) {
489b8851fccSafresh1    push @for, &a;
490b8851fccSafresh1  }
491b8851fccSafresh1}
492b8851fccSafresh1is "@for", "9 10", 'foreach \&padcv';
493b8851fccSafresh1
494b8851fccSafresh1@for = ();
495b8851fccSafresh1for \&::a(sub {9}, sub {10}) {
496b8851fccSafresh1  push @for, &::a;
497b8851fccSafresh1}
498b8851fccSafresh1is "@for", "9 10", 'foreach \&rv2cv';
499b8851fccSafresh1
500b8851fccSafresh1# Errors
501b8851fccSafresh1
502b8851fccSafresh1eval { my $x; \$x = 3 };
503b8851fccSafresh1like $@, qr/^Assigned value is not a reference at/, 'assigning non-ref';
504b8851fccSafresh1eval { my $x; \$x = [] };
505b8851fccSafresh1like $@, qr/^Assigned value is not a SCALAR reference at/,
506b8851fccSafresh1    'assigning non-scalar ref to scalar ref';
507b8851fccSafresh1eval { \$::x = [] };
508b8851fccSafresh1like $@, qr/^Assigned value is not a SCALAR reference at/,
509b8851fccSafresh1    'assigning non-scalar ref to package scalar ref';
510b8851fccSafresh1eval { my @x; \@x = {} };
511b8851fccSafresh1like $@, qr/^Assigned value is not an ARRAY reference at/,
512b8851fccSafresh1    'assigning non-array ref to array ref';
513b8851fccSafresh1eval { \@::x = {} };
514b8851fccSafresh1like $@, qr/^Assigned value is not an ARRAY reference at/,
515b8851fccSafresh1    'assigning non-array ref to package array ref';
516b8851fccSafresh1eval { my %x; \%x = [] };
517b8851fccSafresh1like $@, qr/^Assigned value is not a HASH reference at/,
518b8851fccSafresh1    'assigning non-hash ref to hash ref';
519b8851fccSafresh1eval { \%::x = [] };
520b8851fccSafresh1like $@, qr/^Assigned value is not a HASH reference at/,
521b8851fccSafresh1    'assigning non-hash ref to package hash ref';
522b8851fccSafresh1eval { use feature 'lexical_subs';
523b8851fccSafresh1       no warnings 'experimental::lexical_subs';
524b8851fccSafresh1       my sub x; \&x = [] };
525b8851fccSafresh1like $@, qr/^Assigned value is not a CODE reference at/,
526b8851fccSafresh1    'assigning non-code ref to lexical code ref';
527b8851fccSafresh1eval { \&::x = [] };
528b8851fccSafresh1like $@, qr/^Assigned value is not a CODE reference at/,
529b8851fccSafresh1    'assigning non-code ref to package code ref';
530b8851fccSafresh1
531b8851fccSafresh1eval { my $x; (\$x) = 3 };
532b8851fccSafresh1like $@, qr/^Assigned value is not a reference at/,
533b8851fccSafresh1    'list-assigning non-ref';
534b8851fccSafresh1eval { my $x; (\$x) = [] };
535b8851fccSafresh1like $@, qr/^Assigned value is not a SCALAR reference at/,
536b8851fccSafresh1    'list-assigning non-scalar ref to scalar ref';
537b8851fccSafresh1eval { (\$::x = []) };
538b8851fccSafresh1like $@, qr/^Assigned value is not a SCALAR reference at/,
539b8851fccSafresh1    'list-assigning non-scalar ref to package scalar ref';
540b8851fccSafresh1eval { my @x; (\@x) = {} };
541b8851fccSafresh1like $@, qr/^Assigned value is not an ARRAY reference at/,
542b8851fccSafresh1    'list-assigning non-array ref to array ref';
543b8851fccSafresh1eval { (\@::x) = {} };
544b8851fccSafresh1like $@, qr/^Assigned value is not an ARRAY reference at/,
545b8851fccSafresh1    'list-assigning non-array ref to package array ref';
546b8851fccSafresh1eval { my %x; (\%x) = [] };
547b8851fccSafresh1like $@, qr/^Assigned value is not a HASH reference at/,
548b8851fccSafresh1    'list-assigning non-hash ref to hash ref';
549b8851fccSafresh1eval { (\%::x) = [] };
550b8851fccSafresh1like $@, qr/^Assigned value is not a HASH reference at/,
551b8851fccSafresh1    'list-assigning non-hash ref to package hash ref';
552b8851fccSafresh1eval { use feature 'lexical_subs';
553b8851fccSafresh1       no warnings 'experimental::lexical_subs';
554b8851fccSafresh1       my sub x; (\&x) = [] };
555b8851fccSafresh1like $@, qr/^Assigned value is not a CODE reference at/,
556b8851fccSafresh1    'list-assigning non-code ref to lexical code ref';
557b8851fccSafresh1eval { (\&::x) = [] };
558b8851fccSafresh1like $@, qr/^Assigned value is not a CODE reference at/,
559b8851fccSafresh1    'list-assigning non-code ref to package code ref';
560b8851fccSafresh1
561b8851fccSafresh1eval '(\do{}) = 42';
562b8851fccSafresh1like $@, qr/^Can't modify reference to do block in list assignment at /,
563b8851fccSafresh1    "Can't modify reference to do block in list assignment";
564b8851fccSafresh1eval '(\pos) = 42';
565b8851fccSafresh1like $@,
566b8851fccSafresh1     qr/^Can't modify reference to match position in list assignment at /,
567b8851fccSafresh1    "Can't modify ref to some scalar-returning op in list assignment";
568b8851fccSafresh1eval '(\glob) = 42';
569b8851fccSafresh1like $@,
570b8851fccSafresh1     qr/^Can't modify reference to glob in list assignment at /,
571b8851fccSafresh1    "Can't modify reference to some list-returning op in list assignment";
572b8851fccSafresh1eval '\pos = 42';
573b8851fccSafresh1like $@,
574b8851fccSafresh1    qr/^Can't modify reference to match position in scalar assignment at /,
575b8851fccSafresh1   "Can't modify ref to some scalar-returning op in scalar assignment";
576b8851fccSafresh1eval '\(local @b) = 42';
577b8851fccSafresh1like $@,
578b8851fccSafresh1    qr/^Can't modify reference to localized parenthesized array in list(?x:
579b8851fccSafresh1      ) assignment at /,
580b8851fccSafresh1   q"Can't modify \(local @array) in list assignment";
581b8851fccSafresh1eval '\local(@b) = 42';
582b8851fccSafresh1like $@,
583b8851fccSafresh1    qr/^Can't modify reference to localized parenthesized array in list(?x:
584b8851fccSafresh1      ) assignment at /,
585b8851fccSafresh1   q"Can't modify \local(@array) in list assignment";
586b8851fccSafresh1eval '\local(@{foo()}) = 42';
587b8851fccSafresh1like $@,
588b8851fccSafresh1    qr/^Can't modify reference to array dereference in list assignment at/,
589b8851fccSafresh1   q"'Array deref' error takes prec. over 'local paren' error";
590b8851fccSafresh1eval '\(%b) = 42';
591b8851fccSafresh1like $@,
592b8851fccSafresh1    qr/^Can't modify reference to parenthesized hash in list assignment a/,
593b8851fccSafresh1   "Can't modify ref to parenthesized package hash in scalar assignment";
594b8851fccSafresh1eval '\(my %b) = 42';
595b8851fccSafresh1like $@,
596b8851fccSafresh1    qr/^Can't modify reference to parenthesized hash in list assignment a/,
597b8851fccSafresh1   "Can't modify ref to parenthesized hash (\(my %b)) in list assignment";
598b8851fccSafresh1eval '\my(%b) = 42';
599b8851fccSafresh1like $@,
600b8851fccSafresh1    qr/^Can't modify reference to parenthesized hash in list assignment a/,
601b8851fccSafresh1   "Can't modify ref to parenthesized hash (\my(%b)) in list assignment";
602b8851fccSafresh1eval '\%{"42"} = 42';
603b8851fccSafresh1like $@,
604b8851fccSafresh1    qr/^Can't modify reference to hash dereference in scalar assignment a/,
605b8851fccSafresh1   "Can't modify reference to hash dereference in scalar assignment";
606b8851fccSafresh1eval '$foo ? \%{"42"} : \%43 = 42';
607b8851fccSafresh1like $@,
608b8851fccSafresh1    qr/^Can't modify reference to hash dereference in scalar assignment a/,
609b8851fccSafresh1   "Can't modify ref to whatever in scalar assignment via cond expr";
6105759b3d2Safresh1eval '\$0=~y///=0';
6115759b3d2Safresh1like $@,
6125759b3d2Safresh1    qr#^Can't modify transliteration \(tr///\) in scalar assignment a#,
6135759b3d2Safresh1   "Can't modify transliteration (tr///) in scalar assignment";
614b8851fccSafresh1
615b8851fccSafresh1# Miscellaneous
616b8851fccSafresh1
617b8851fccSafresh1{
618b8851fccSafresh1  local $::TODO = ' ';
619b8851fccSafresh1  my($x,$y);
620b8851fccSafresh1  sub {
621b8851fccSafresh1    sub {
622b8851fccSafresh1      \$x = \$y;
623b8851fccSafresh1    }->();
624b8851fccSafresh1    is \$x, \$y, 'lexical alias affects outer closure';
625b8851fccSafresh1  }->();
626b8851fccSafresh1  is \$x, \$y, 'lexical alias affects outer sub where vars are declared';
627b8851fccSafresh1}
628b8851fccSafresh1
629b8851fccSafresh1{ # PADSTALE has a double meaning
630b8851fccSafresh1  use feature 'lexical_subs', 'signatures';
631b8851fccSafresh1  no warnings 'experimental';
632b8851fccSafresh1  my $c;
633b8851fccSafresh1  my sub s ($arg) {
634b8851fccSafresh1    state $x = ++$c;
635b8851fccSafresh1    if ($arg == 3) { return $c }
636b8851fccSafresh1    goto skip if $arg == 2;
637b8851fccSafresh1    my $y;
638b8851fccSafresh1   skip:
639b8851fccSafresh1    # $y is PADSTALE the 2nd time
640b8851fccSafresh1    \$x = \$y if $arg == 2;
641b8851fccSafresh1  }
642b8851fccSafresh1  s(1);
643b8851fccSafresh1  s(2);
644b8851fccSafresh1  is s(3), 1, 'padstale alias should not reset state'
645b8851fccSafresh1}
646b8851fccSafresh1
647eac174f2Safresh1{
648b8851fccSafresh1    my $a;
649eac174f2Safresh1    no warnings 'experimental::builtin';
650eac174f2Safresh1    builtin::weaken($r = \$a);
651b8851fccSafresh1    \$a = $r;
652b8851fccSafresh1    pass 'no crash when assigning \$lex = $weakref_to_lex'
653b8851fccSafresh1}
654b8851fccSafresh1
655b8851fccSafresh1{
656b8851fccSafresh1    \my $x = \my $y;
657b8851fccSafresh1    $x = 3;
658b8851fccSafresh1    ($x, my $z) = (1, $y);
659b8851fccSafresh1    is $z, 3, 'list assignment after aliasing lexical scalars';
660b8851fccSafresh1}
661b8851fccSafresh1{
662b8851fccSafresh1    (\my $x) = \my $y;
663b8851fccSafresh1    $x = 3;
664b8851fccSafresh1    ($x, my $z) = (1, $y);
665b8851fccSafresh1    is $z, 3,
666b8851fccSafresh1      'regular list assignment after aliasing via list assignment';
667b8851fccSafresh1}
668b8851fccSafresh1{
669b8851fccSafresh1    my $y;
670b8851fccSafresh1    goto do_aliasing;
671b8851fccSafresh1
672b8851fccSafresh1   do_test:
673b8851fccSafresh1    $y = 3;
674b8851fccSafresh1    my($x,$z) = (1, $y);
675b8851fccSafresh1    is $z, 3, 'list assignment "before" aliasing lexical scalars';
676b8851fccSafresh1    last;
677b8851fccSafresh1
678b8851fccSafresh1   do_aliasing:
679b8851fccSafresh1    \$x = \$y;
680b8851fccSafresh1    goto do_test;
681b8851fccSafresh1}
682b8851fccSafresh1{
683b8851fccSafresh1    my $y;
684b8851fccSafresh1    goto do_aliasing2;
685b8851fccSafresh1
686b8851fccSafresh1   do_test2:
687b8851fccSafresh1    $y = 3;
688b8851fccSafresh1    my($x,$z) = (1, $y);
689b8851fccSafresh1    is $z, 3,
690b8851fccSafresh1     'list assignment "before" aliasing lex scalars via list assignment';
691b8851fccSafresh1    last;
692b8851fccSafresh1
693b8851fccSafresh1   do_aliasing2:
694b8851fccSafresh1    \($x) = \$y;
695b8851fccSafresh1    goto do_test2;
696b8851fccSafresh1}
697b8851fccSafresh1{
698b8851fccSafresh1    my @a;
699b8851fccSafresh1    goto do_aliasing3;
700b8851fccSafresh1
701b8851fccSafresh1   do_test3:
702b8851fccSafresh1    @a[0,1] = qw<a b>;
703b8851fccSafresh1    my($y,$x) = ($a[0],$a[1]);
704b8851fccSafresh1    is "@a", 'b a',
705b8851fccSafresh1       'aelemfast_lex-to-scalar list assignment "before" aliasing';
706b8851fccSafresh1    last;
707b8851fccSafresh1
708b8851fccSafresh1   do_aliasing3:
709b8851fccSafresh1    \(@a) = \($x,$y);
710b8851fccSafresh1    goto do_test3;
711b8851fccSafresh1}
712b8851fccSafresh1
713b8851fccSafresh1# Used to fail an assertion [perl #123821]
714b8851fccSafresh1eval '\(&$0)=0';
7155759b3d2Safresh1pass("RT #123821");
7165759b3d2Safresh1
7175759b3d2Safresh1# Used to fail an assertion [perl #128252]
7185759b3d2Safresh1{
7195759b3d2Safresh1    no feature 'refaliasing';
7205759b3d2Safresh1    use warnings;
7215759b3d2Safresh1    eval q{sub{\@0[0]=0};};
7225759b3d2Safresh1    pass("RT #128252");
7235759b3d2Safresh1}
724b46d8ef2Safresh1
725b46d8ef2Safresh1# RT #133538 slices were inadvertently always localising
726b46d8ef2Safresh1
727b46d8ef2Safresh1{
728b46d8ef2Safresh1    use feature 'refaliasing';
729b46d8ef2Safresh1    no warnings 'experimental';
730b46d8ef2Safresh1
731b46d8ef2Safresh1    my @src = (100,200,300);
732b46d8ef2Safresh1
733b46d8ef2Safresh1    my @a = (1,2,3);
734b46d8ef2Safresh1    my %h = qw(one 10 two 20 three 30);
735b46d8ef2Safresh1
736b46d8ef2Safresh1    {
737b46d8ef2Safresh1        use feature 'declared_refs';
738b46d8ef2Safresh1        local \(@a[0,1,2]) = \(@src);
739b46d8ef2Safresh1        local \(@h{qw(one two three)}) = \(@src);
740b46d8ef2Safresh1        $src[0]++;
741b46d8ef2Safresh1        is("@a", "101 200 300", "rt #133538 \@a aliased");
742b46d8ef2Safresh1        is("$h{one} $h{two} $h{three}", "101 200 300", "rt #133538 %h aliased");
743b46d8ef2Safresh1    }
744b46d8ef2Safresh1    is("@a", "1 2 3", "rt #133538 \@a restored");
745b46d8ef2Safresh1    is("$h{one} $h{two} $h{three}", "10 20 30", "rt #133538 %h restored");
746b46d8ef2Safresh1
747b46d8ef2Safresh1    {
748b46d8ef2Safresh1        \(@a[0,1,2]) = \(@src);
749b46d8ef2Safresh1        \(@h{qw(one two three)}) = \(@src);
750b46d8ef2Safresh1        $src[0]++;
751b46d8ef2Safresh1        is("@a", "102 200 300", "rt #133538 \@a aliased try 2");
752b46d8ef2Safresh1        is("$h{one} $h{two} $h{three}", "102 200 300",
753b46d8ef2Safresh1                "rt #133538 %h aliased try 2");
754b46d8ef2Safresh1    }
755b46d8ef2Safresh1    $src[2]++;
756b46d8ef2Safresh1    is("@a", "102 200 301", "rt #133538 \@a still aliased");
757b46d8ef2Safresh1    is("$h{one} $h{two} $h{three}", "102 200 301", "rt #133538 %h still aliased");
758b46d8ef2Safresh1
759b46d8ef2Safresh1}
760