Commit | Line | Data |
---|---|---|
40258daf | 1 | #!perl |
72ed4618 FC |
2 | BEGIN { |
3 | chdir 't'; | |
4 | require './test.pl'; | |
5 | set_up_inc("../lib"); | |
6 | } | |
7 | ||
40258daf | 8 | plan 167; |
72ed4618 | 9 | |
72ed4618 | 10 | eval '\$x = \$y'; |
baabe3fb | 11 | like $@, qr/^Experimental aliasing via reference not enabled/, |
72ed4618 | 12 | 'error when feature is disabled'; |
26a50d99 | 13 | eval '\($x) = \$y'; |
baabe3fb | 14 | like $@, qr/^Experimental aliasing via reference not enabled/, |
26a50d99 | 15 | 'error when feature is disabled (aassign)'; |
72ed4618 | 16 | |
baabe3fb | 17 | use feature 'refaliasing', 'state'; |
72ed4618 FC |
18 | |
19 | { | |
20 | my($w,$c); | |
21 | local $SIG{__WARN__} = sub { $c++; $w = shift }; | |
22 | eval '\$x = \$y'; | |
23 | is $c, 1, 'one warning from lv ref assignment'; | |
baabe3fb | 24 | like $w, qr/^Aliasing via reference is experimental/, |
72ed4618 | 25 | 'experimental warning'; |
26a50d99 FC |
26 | undef $c; |
27 | eval '\($x) = \$y'; | |
28 | is $c, 1, 'one warning from lv ref list assignment'; | |
baabe3fb | 29 | like $w, qr/^Aliasing via reference is experimental/, |
26a50d99 | 30 | 'experimental warning'; |
72ed4618 FC |
31 | } |
32 | ||
baabe3fb | 33 | no warnings 'experimental::refaliasing'; |
72ed4618 FC |
34 | |
35 | # Scalars | |
36 | ||
3813a8f3 | 37 | \$x = \$y; |
72ed4618 FC |
38 | is \$x, \$y, '\$pkg_scalar = ...'; |
39 | my $m; | |
53abf431 | 40 | \$m = \$y; |
72ed4618 | 41 | is \$m, \$y, '\$lexical = ...'; |
fc048fcf | 42 | \my $n = \$y; |
72ed4618 FC |
43 | is \$n, \$y, '\my $lexical = ...'; |
44 | @_ = \$_; | |
26a50d99 | 45 | \($x) = @_; |
72ed4618 | 46 | is \$x, \$_, '\($pkgvar) = ... gives list context'; |
238ef7dc | 47 | undef *x; |
26a50d99 | 48 | (\$x) = @_; |
238ef7dc | 49 | is \$x, \$_, '(\$pkgvar) = ... gives list context'; |
72ed4618 | 50 | my $o; |
c146a62a | 51 | \($o) = @_; |
72ed4618 | 52 | is \$o, \$_, '\($lexical) = ... gives list cx'; |
26a50d99 | 53 | my $q; |
c146a62a | 54 | (\$q) = @_; |
238ef7dc | 55 | is \$q, \$_, '(\$lexical) = ... gives list cx'; |
c146a62a | 56 | \(my $p) = @_; |
72ed4618 | 57 | is \$p, \$_, '\(my $lexical) = ... gives list cx'; |
c146a62a | 58 | (\my $r) = @_; |
238ef7dc | 59 | is \$r, \$_, '(\my $lexical) = ... gives list cx'; |
c146a62a | 60 | \my($s) = @_; |
238ef7dc | 61 | is \$s, \$_, '\my($lexical) = ... gives list cx'; |
217e3565 | 62 | \($_a, my $a) = @{[\$b, \$c]}; |
72ed4618 FC |
63 | is \$_a, \$b, 'package scalar in \(...)'; |
64 | is \$a, \$c, 'lex scalar in \(...)'; | |
c146a62a | 65 | (\$_b, \my $b) = @{[\$b, \$c]}; |
72ed4618 FC |
66 | is \$_b, \$::b, 'package scalar in (\$foo, \$bar)'; |
67 | is \$b, \$c, 'lex scalar in (\$foo, \$bar)'; | |
2a57afb1 FC |
68 | is do { \local $l = \3; $l }, 3, '\local $scalar assignment'; |
69 | is $l, undef, 'localisation unwound'; | |
70 | is do { \(local $l) = \4; $l }, 4, '\(local $scalar) assignment'; | |
11ea28ee | 71 | is $l, undef, 'localisation unwound'; |
29a3d628 FC |
72 | \$foo = \*bar; |
73 | is *foo{SCALAR}, *bar{GLOB}, 'globref-to-scalarref assignment'; | |
30bccb25 | 74 | for (1,2) { |
3ad7d304 FC |
75 | \my $x = \3, |
76 | \my($y) = \3, | |
77 | \state $a = \3, | |
78 | \state($b) = \3 if $_ == 1; | |
30bccb25 FC |
79 | if ($_ == 2) { |
80 | is $x, undef, '\my $x = ... clears $x on scope exit'; | |
81 | is $y, undef, '\my($x) = ... clears $x on scope exit'; | |
3ad7d304 FC |
82 | is $a, 3, '\state $x = ... does not clear $x on scope exit'; |
83 | is $b, 3, '\state($x) = ... does not clear $x on scope exit'; | |
30bccb25 FC |
84 | } |
85 | } | |
72ed4618 FC |
86 | |
87 | # Array Elements | |
88 | ||
0ca7b7f7 FC |
89 | sub expect_scalar_cx { wantarray ? 0 : \$_ } |
90 | sub expect_list_cx { wantarray ? (\$_,\$_) : 0 } | |
91 | \$a[0] = expect_scalar_cx; | |
6102323a | 92 | is \$a[0], \$_, '\$array[0]'; |
0ca7b7f7 | 93 | \($a[1]) = expect_list_cx; |
6102323a FC |
94 | is \$a[1], \$_, '\($array[0])'; |
95 | { | |
96 | my @a; | |
0ca7b7f7 | 97 | \$a[0] = expect_scalar_cx; |
6102323a | 98 | is \$a[0], \$_, '\$lexical_array[0]'; |
0ca7b7f7 | 99 | \($a[1]) = expect_list_cx; |
6102323a | 100 | is \$a[1], \$_, '\($lexical_array[0])'; |
40d2b828 FC |
101 | my $tmp; |
102 | { | |
103 | \local $a[0] = \$tmp; | |
104 | is \$a[0], \$tmp, '\local $a[0]'; | |
105 | } | |
106 | is \$a[0], \$_, '\local $a[0] unwound'; | |
107 | { | |
108 | \local ($a[1]) = \$tmp; | |
109 | is \$a[1], \$tmp, '\local ($a[0])'; | |
110 | } | |
111 | is \$a[1], \$_, '\local $a[0] unwound'; | |
6102323a | 112 | } |
0ca7b7f7 FC |
113 | { |
114 | my @a; | |
115 | \@a[0,1] = expect_list_cx; | |
116 | is \$a[0].\$a[1], \$_.\$_, '\@array[indices]'; | |
117 | \(@a[2,3]) = expect_list_cx; | |
118 | is \$a[0].\$a[1], \$_.\$_, '\(@array[indices])'; | |
119 | my $tmp; | |
120 | { | |
121 | \local @a[0,1] = (\$tmp)x2; | |
122 | is \$a[0].\$a[1], \$tmp.\$tmp, '\local @a[indices]'; | |
123 | } | |
124 | is \$a[0].\$a[1], \$_.\$_, '\local @a[indices] unwound'; | |
125 | } | |
72ed4618 FC |
126 | |
127 | # Hash Elements | |
128 | ||
5f94141d FC |
129 | \$h{a} = expect_scalar_cx; |
130 | is \$h{a}, \$_, '\$hash{a}'; | |
131 | \($h{b}) = expect_list_cx; | |
132 | is \$h{b}, \$_, '\($hash{a})'; | |
133 | { | |
901f0970 | 134 | my %h; |
5f94141d FC |
135 | \$h{a} = expect_scalar_cx; |
136 | is \$h{a}, \$_, '\$lexical_array{a}'; | |
137 | \($h{b}) = expect_list_cx; | |
138 | is \$h{b}, \$_, '\($lexical_array{a})'; | |
139 | my $tmp; | |
140 | { | |
141 | \local $h{a} = \$tmp; | |
142 | is \$h{a}, \$tmp, '\local $h{a}'; | |
143 | } | |
144 | is \$h{a}, \$_, '\local $h{a} unwound'; | |
145 | { | |
146 | \local ($h{b}) = \$tmp; | |
147 | is \$h{b}, \$tmp, '\local ($h{a})'; | |
148 | } | |
149 | is \$h{b}, \$_, '\local $h{a} unwound'; | |
150 | } | |
151 | { | |
901f0970 | 152 | my %h; |
5f94141d FC |
153 | \@h{"a","b"} = expect_list_cx; |
154 | is \$h{a}.\$h{b}, \$_.\$_, '\@hash{indices}'; | |
155 | \(@h{2,3}) = expect_list_cx; | |
156 | is \$h{a}.\$h{b}, \$_.\$_, '\(@hash{indices})'; | |
157 | my $tmp; | |
158 | { | |
159 | \local @h{"a","b"} = (\$tmp)x2; | |
160 | is \$h{a}.\$h{b}, \$tmp.\$tmp, '\local @h{indices}'; | |
161 | } | |
162 | is \$h{a}.\$h{b}, \$_.\$_, '\local @h{indices} unwound'; | |
163 | } | |
72ed4618 FC |
164 | |
165 | # Arrays | |
166 | ||
4779e7f9 FC |
167 | package ArrayTest { |
168 | BEGIN { *is = *main::is } | |
169 | sub expect_scalar_cx { wantarray ? 0 : \@ThatArray } | |
170 | sub expect_list_cx { wantarray ? (\$_,\$_) : 0 } | |
171 | sub expect_list_cx_a { wantarray ? (\@ThatArray)x2 : 0 } | |
3813a8f3 | 172 | \@a = expect_scalar_cx; |
4779e7f9 FC |
173 | is \@a, \@ThatArray, '\@pkg'; |
174 | my @a; | |
3f114923 | 175 | \@a = expect_scalar_cx; |
4779e7f9 | 176 | is \@a, \@ThatArray, '\@lexical'; |
9782ce69 | 177 | (\@b) = expect_list_cx_a; |
4779e7f9 FC |
178 | is \@b, \@ThatArray, '(\@pkg)'; |
179 | my @b; | |
9782ce69 | 180 | (\@b) = expect_list_cx_a; |
4779e7f9 | 181 | is \@b, \@ThatArray, '(\@lexical)'; |
3f114923 | 182 | \my @c = expect_scalar_cx; |
4779e7f9 | 183 | is \@c, \@ThatArray, '\my @lexical'; |
bdaf10a5 | 184 | (\my @d) = expect_list_cx_a; |
4779e7f9 | 185 | is \@d, \@ThatArray, '(\my @lexical)'; |
bdaf10a5 FC |
186 | \(@e) = expect_list_cx; |
187 | is \$e[0].\$e[1], \$_.\$_, '\(@pkg)'; | |
4779e7f9 | 188 | my @e; |
bdaf10a5 FC |
189 | \(@e) = expect_list_cx; |
190 | is \$e[0].\$e[1], \$_.\$_, '\(@lexical)'; | |
191 | \(my @f) = expect_list_cx; | |
192 | is \$f[0].\$f[1], \$_.\$_, '\(my @lexical)'; | |
193 | \my(@g) = expect_list_cx; | |
194 | is \$g[0].\$g[1], \$_.\$_, '\my(@lexical)'; | |
30494daf | 195 | my $old = \@h; |
30494daf FC |
196 | { |
197 | \local @h = \@ThatArray; | |
198 | is \@h, \@ThatArray, '\local @a'; | |
199 | } | |
30494daf FC |
200 | is \@h, $old, '\local @a unwound'; |
201 | $old = \@i; | |
3813a8f3 | 202 | { |
30494daf FC |
203 | (\local @i) = \@ThatArray; |
204 | is \@i, \@ThatArray, '(\local @a)'; | |
3813a8f3 | 205 | } |
30494daf | 206 | is \@i, $old, '(\local @a) unwound'; |
4779e7f9 | 207 | } |
30bccb25 | 208 | for (1,2) { |
3ad7d304 FC |
209 | \my @x = [1..3], |
210 | \my(@y) = \3, | |
211 | \state @a = [1..3], | |
212 | \state(@b) = \3 if $_ == 1; | |
30bccb25 FC |
213 | if ($_ == 2) { |
214 | is @x, 0, '\my @x = ... clears @x on scope exit'; | |
215 | is @y, 0, '\my(@x) = ... clears @x on scope exit'; | |
3ad7d304 FC |
216 | is "@a", "1 2 3", '\state @x = ... does not clear @x on scope exit'; |
217 | is "@b", 3, '\state(@x) = ... does not clear @x on scope exit'; | |
30bccb25 FC |
218 | } |
219 | } | |
72ed4618 FC |
220 | |
221 | # Hashes | |
222 | ||
87da42eb FC |
223 | package HashTest { |
224 | BEGIN { *is = *main::is } | |
225 | sub expect_scalar_cx { wantarray ? 0 : \%ThatHash } | |
226 | sub expect_list_cx { wantarray ? (\%ThatHash)x2 : 0 } | |
3f114923 | 227 | \%a = expect_scalar_cx; |
87da42eb FC |
228 | is \%a, \%ThatHash, '\%pkg'; |
229 | my %a; | |
3f114923 | 230 | \%a = expect_scalar_cx; |
87da42eb | 231 | is \%a, \%ThatHash, '\%lexical'; |
9782ce69 FC |
232 | (\%b) = expect_list_cx; |
233 | is \%b, \%ThatHash, '(\%pkg)'; | |
87da42eb | 234 | my %b; |
9782ce69 | 235 | (\%b) = expect_list_cx; |
87da42eb | 236 | is \%b, \%ThatHash, '(\%lexical)'; |
3f114923 | 237 | \my %c = expect_scalar_cx; |
87da42eb | 238 | is \%c, \%ThatHash, '\my %lexical'; |
9782ce69 | 239 | (\my %d) = expect_list_cx; |
87da42eb | 240 | is \%d, \%ThatHash, '(\my %lexical)'; |
30494daf | 241 | my $old = \%h; |
30494daf FC |
242 | { |
243 | \local %h = \%ThatHash; | |
244 | is \%h, \%ThatHash, '\local %a'; | |
245 | } | |
30494daf FC |
246 | is \%h, $old, '\local %a unwound'; |
247 | $old = \%i; | |
3813a8f3 | 248 | { |
30494daf FC |
249 | (\local %i) = \%ThatHash; |
250 | is \%i, \%ThatHash, '(\local %a)'; | |
3813a8f3 | 251 | } |
30494daf | 252 | is \%i, $old, '(\local %a) unwound'; |
87da42eb | 253 | } |
30bccb25 | 254 | for (1,2) { |
3ad7d304 | 255 | \state %y = {1,2}, |
30bccb25 FC |
256 | \my %x = {1,2} if $_ == 1; |
257 | if ($_ == 2) { | |
258 | is %x, 0, '\my %x = ... clears %x on scope exit'; | |
3ad7d304 | 259 | is "@{[%y]}", "1 2", '\state %x = ... does not clear %x on scope exit'; |
30bccb25 FC |
260 | } |
261 | } | |
72ed4618 FC |
262 | |
263 | # Subroutines | |
264 | ||
408e9044 FC |
265 | package CodeTest { |
266 | BEGIN { *is = *main::is; } | |
3ad7d304 | 267 | use feature 'lexical_subs'; |
408e9044 FC |
268 | no warnings 'experimental::lexical_subs'; |
269 | sub expect_scalar_cx { wantarray ? 0 : \&ThatSub } | |
270 | sub expect_list_cx { wantarray ? (\&ThatSub)x2 : 0 } | |
271 | \&a = expect_scalar_cx; | |
272 | is \&a, \&ThatSub, '\&pkg'; | |
273 | my sub a; | |
274 | \&a = expect_scalar_cx; | |
275 | is \&a, \&ThatSub, '\&mysub'; | |
276 | state sub as; | |
277 | \&as = expect_scalar_cx; | |
278 | is \&as, \&ThatSub, '\&statesub'; | |
279 | (\&b) = expect_list_cx; | |
280 | is \&b, \&ThatSub, '(\&pkg)'; | |
281 | my sub b; | |
282 | (\&b) = expect_list_cx; | |
283 | is \&b, \&ThatSub, '(\&mysub)'; | |
284 | my sub bs; | |
285 | (\&bs) = expect_list_cx; | |
286 | is \&bs, \&ThatSub, '(\&statesub)'; | |
287 | \(&c) = expect_list_cx; | |
288 | is \&c, \&ThatSub, '\(&pkg)'; | |
289 | my sub b; | |
290 | \(&c) = expect_list_cx; | |
291 | is \&c, \&ThatSub, '\(&mysub)'; | |
292 | my sub bs; | |
293 | \(&cs) = expect_list_cx; | |
294 | is \&cs, \&ThatSub, '\(&statesub)'; | |
40258daf TC |
295 | |
296 | package main { | |
297 | # this is only a problem in main:: due to 1e2cfe157ca | |
298 | sub sx { "x" } | |
299 | sub sy { "y" } | |
300 | is sx(), "x", "check original"; | |
301 | my $temp = \&sx; | |
302 | \&sx = \&sy; | |
303 | is sx(), "y", "aliased"; | |
304 | \&sx = $temp; | |
305 | is sx(), "x", "and restored"; | |
306 | } | |
408e9044 | 307 | } |
72ed4618 | 308 | |
b7ae253e | 309 | # Mixed List Assignments |
72ed4618 | 310 | |
26a50d99 | 311 | (\$tahi, $rua) = \(1,2); |
9fc71ff4 FC |
312 | is join(' ', $tahi, $$rua), '1 2', |
313 | 'mixed scalar ref and scalar list assignment'; | |
f52983f2 FC |
314 | $_ = 1; |
315 | \($bb, @cc, %dd, &ee, $_==1 ? $ff : @ff, $_==2 ? $gg : @gg, (@hh)) = | |
316 | (\$BB, \@CC, \%DD, \&EE, \$FF, \@GG, \1, \2, \3); | |
317 | is \$bb, \$BB, '\$scalar in list assignment'; | |
318 | is \@cc, \@CC, '\@array in list assignment'; | |
319 | is \%dd, \%DD, '\%hash in list assignment'; | |
320 | is \&ee, \&EE, '\&code in list assignment'; | |
321 | is \$ff, \$FF, '$scalar in \ternary in list assignment'; | |
322 | is \@gg, \@GG, '@gg in \ternary in list assignment'; | |
323 | is "@hh", '1 2 3', '\(@array) in list assignment'; | |
b7ae253e FC |
324 | |
325 | # Conditional expressions | |
326 | ||
9fc71ff4 | 327 | $_ = 3; |
d1094c5b | 328 | $_ == 3 ? \$tahi : $rua = \3; |
9fc71ff4 | 329 | is $tahi, 3, 'cond assignment resolving to scalar ref'; |
d1094c5b | 330 | $_ == 0 ? \$toru : $wha = \3; |
9fc71ff4 | 331 | is $$wha, 3, 'cond assignment resolving to scalar'; |
d1094c5b | 332 | $_ == 3 ? \$rima : \$ono = \5; |
9e592f5a | 333 | is $rima, 5, 'cond assignment with refgens on both branches'; |
7664512e FC |
334 | \($_ == 3 ? $whitu : $waru) = \5; |
335 | is $whitu, 5, '\( ?: ) assignment'; | |
f52983f2 FC |
336 | \($_ == 3 ? $_ < 4 ? $ii : $_ : $_) = \$_; |
337 | is \$ii, \$_, 'nested \ternary assignment'; | |
72ed4618 | 338 | |
096cc2cc FC |
339 | # Foreach |
340 | ||
362e758e FC |
341 | for \my $topic (\$for1, \$for2) { |
342 | push @for, \$topic; | |
343 | } | |
096cc2cc | 344 | is "@for", \$for1 . ' ' . \$for2, 'foreach \my $a'; |
362e758e FC |
345 | is \$topic, \$::topic, 'for \my scoping'; |
346 | ||
347 | @for = (); | |
348 | for \$::a(\$for1, \$for2) { | |
349 | push @for, \$::a; | |
350 | } | |
351 | is "@for", \$for1 . ' ' . \$for2, 'foreach \$::a'; | |
096cc2cc FC |
352 | |
353 | @for = (); | |
362e758e | 354 | for \my @a([1,2], [3,4]) { |
096cc2cc | 355 | push @for, @a; |
362e758e | 356 | } |
096cc2cc FC |
357 | is "@for", "1 2 3 4", 'foreach \my @a [perl #22335]'; |
358 | ||
359 | @for = (); | |
362e758e FC |
360 | for \@::a([1,2], [3,4]) { |
361 | push @for, @::a; | |
362 | } | |
363 | is "@for", "1 2 3 4", 'foreach \@::a [perl #22335]'; | |
364 | ||
365 | @for = (); | |
366 | for \my %a({5,6}, {7,8}) { | |
096cc2cc | 367 | push @for, %a; |
362e758e | 368 | } |
096cc2cc FC |
369 | is "@for", "5 6 7 8", 'foreach \my %a [perl #22335]'; |
370 | ||
371 | @for = (); | |
362e758e FC |
372 | for \%::a({5,6}, {7,8}) { |
373 | push @for, %::a; | |
374 | } | |
375 | is "@for", "5 6 7 8", 'foreach \%::a [perl #22335]'; | |
376 | ||
377 | @for = (); | |
378 | { | |
379 | use feature 'lexical_subs'; | |
380 | no warnings 'experimental::lexical_subs'; | |
381 | my sub a; | |
382 | for \&a(sub {9}, sub {10}) { | |
096cc2cc FC |
383 | push @for, &a; |
384 | } | |
362e758e FC |
385 | } |
386 | is "@for", "9 10", 'foreach \&padcv'; | |
096cc2cc | 387 | |
362e758e FC |
388 | @for = (); |
389 | for \&::a(sub {9}, sub {10}) { | |
390 | push @for, &::a; | |
391 | } | |
392 | is "@for", "9 10", 'foreach \&rv2cv'; | |
096cc2cc | 393 | |
72ed4618 FC |
394 | # Errors |
395 | ||
b3717a0e FC |
396 | eval { my $x; \$x = 3 }; |
397 | like $@, qr/^Assigned value is not a reference at/, 'assigning non-ref'; | |
398 | eval { my $x; \$x = [] }; | |
399 | like $@, qr/^Assigned value is not a SCALAR reference at/, | |
400 | 'assigning non-scalar ref to scalar ref'; | |
d8a875d9 FC |
401 | eval { \$::x = [] }; |
402 | like $@, qr/^Assigned value is not a SCALAR reference at/, | |
403 | 'assigning non-scalar ref to package scalar ref'; | |
0719038d FC |
404 | eval { my @x; \@x = {} }; |
405 | like $@, qr/^Assigned value is not an ARRAY reference at/, | |
406 | 'assigning non-array ref to array ref'; | |
407 | eval { \@::x = {} }; | |
408 | like $@, qr/^Assigned value is not an ARRAY reference at/, | |
409 | 'assigning non-array ref to package array ref'; | |
410 | eval { my %x; \%x = [] }; | |
411 | like $@, qr/^Assigned value is not a HASH reference at/, | |
412 | 'assigning non-hash ref to hash ref'; | |
413 | eval { \%::x = [] }; | |
414 | like $@, qr/^Assigned value is not a HASH reference at/, | |
415 | 'assigning non-hash ref to package hash ref'; | |
408e9044 FC |
416 | eval { use feature 'lexical_subs'; |
417 | no warnings 'experimental::lexical_subs'; | |
418 | my sub x; \&x = [] }; | |
419 | like $@, qr/^Assigned value is not a CODE reference at/, | |
420 | 'assigning non-code ref to lexical code ref'; | |
421 | eval { \&::x = [] }; | |
422 | like $@, qr/^Assigned value is not a CODE reference at/, | |
423 | 'assigning non-code ref to package code ref'; | |
d6378458 | 424 | |
bd9bf01b FC |
425 | eval { my $x; (\$x) = 3 }; |
426 | like $@, qr/^Assigned value is not a reference at/, | |
427 | 'list-assigning non-ref'; | |
428 | eval { my $x; (\$x) = [] }; | |
429 | like $@, qr/^Assigned value is not a SCALAR reference at/, | |
430 | 'list-assigning non-scalar ref to scalar ref'; | |
431 | eval { (\$::x = []) }; | |
432 | like $@, qr/^Assigned value is not a SCALAR reference at/, | |
433 | 'list-assigning non-scalar ref to package scalar ref'; | |
434 | eval { my @x; (\@x) = {} }; | |
435 | like $@, qr/^Assigned value is not an ARRAY reference at/, | |
436 | 'list-assigning non-array ref to array ref'; | |
437 | eval { (\@::x) = {} }; | |
438 | like $@, qr/^Assigned value is not an ARRAY reference at/, | |
439 | 'list-assigning non-array ref to package array ref'; | |
440 | eval { my %x; (\%x) = [] }; | |
441 | like $@, qr/^Assigned value is not a HASH reference at/, | |
442 | 'list-assigning non-hash ref to hash ref'; | |
443 | eval { (\%::x) = [] }; | |
444 | like $@, qr/^Assigned value is not a HASH reference at/, | |
445 | 'list-assigning non-hash ref to package hash ref'; | |
408e9044 FC |
446 | eval { use feature 'lexical_subs'; |
447 | no warnings 'experimental::lexical_subs'; | |
448 | my sub x; (\&x) = [] }; | |
449 | like $@, qr/^Assigned value is not a CODE reference at/, | |
450 | 'list-assigning non-code ref to lexical code ref'; | |
451 | eval { (\&::x) = [] }; | |
452 | like $@, qr/^Assigned value is not a CODE reference at/, | |
453 | 'list-assigning non-code ref to package code ref'; | |
bd9bf01b | 454 | |
d6378458 FC |
455 | eval '(\do{}) = 42'; |
456 | like $@, qr/^Can't modify reference to do block in list assignment at /, | |
457 | "Can't modify reference to do block in list assignment"; | |
d6378458 FC |
458 | eval '(\pos) = 42'; |
459 | like $@, | |
460 | qr/^Can't modify reference to match position in list assignment at /, | |
461 | "Can't modify ref to some scalar-returning op in list assignment"; | |
d6378458 FC |
462 | eval '(\glob) = 42'; |
463 | like $@, | |
464 | qr/^Can't modify reference to glob in list assignment at /, | |
465 | "Can't modify reference to some list-returning op in list assignment"; | |
d6b7592f FC |
466 | eval '\pos = 42'; |
467 | like $@, | |
468 | qr/^Can't modify reference to match position in scalar assignment at /, | |
469 | "Can't modify ref to some scalar-returning op in scalar assignment"; | |
30494daf FC |
470 | eval '\(local @b) = 42'; |
471 | like $@, | |
bdaf10a5 | 472 | qr/^Can't modify reference to localized parenthesized array in list(?x: |
30494daf FC |
473 | ) assignment at /, |
474 | q"Can't modify \(local @array) in list assignment"; | |
475 | eval '\local(@b) = 42'; | |
476 | like $@, | |
bdaf10a5 | 477 | qr/^Can't modify reference to localized parenthesized array in list(?x: |
30494daf FC |
478 | ) assignment at /, |
479 | q"Can't modify \local(@array) in list assignment"; | |
bdaf10a5 FC |
480 | eval '\local(@{foo()}) = 42'; |
481 | like $@, | |
482 | qr/^Can't modify reference to array dereference in list assignment at/, | |
483 | q"'Array deref' error takes prec. over 'local paren' error"; | |
87da42eb FC |
484 | eval '\(%b) = 42'; |
485 | like $@, | |
486 | qr/^Can't modify reference to parenthesized hash in list assignment a/, | |
487 | "Can't modify ref to parenthesized package hash in scalar assignment"; | |
488 | eval '\(my %b) = 42'; | |
489 | like $@, | |
490 | qr/^Can't modify reference to parenthesized hash in list assignment a/, | |
491 | "Can't modify ref to parenthesized hash (\(my %b)) in list assignment"; | |
492 | eval '\my(%b) = 42'; | |
493 | like $@, | |
494 | qr/^Can't modify reference to parenthesized hash in list assignment a/, | |
495 | "Can't modify ref to parenthesized hash (\my(%b)) in list assignment"; | |
496 | eval '\%{"42"} = 42'; | |
497 | like $@, | |
498 | qr/^Can't modify reference to hash dereference in scalar assignment a/, | |
499 | "Can't modify reference to hash dereference in scalar assignment"; | |
63702de8 FC |
500 | eval '$foo ? \%{"42"} : \%43 = 42'; |
501 | like $@, | |
502 | qr/^Can't modify reference to hash dereference in scalar assignment a/, | |
503 | "Can't modify ref to whatever in scalar assignment via cond expr"; | |
38a3df78 Z |
504 | eval '\$0=~y///=0'; |
505 | like $@, | |
506 | qr#^Can't modify transliteration \(tr///\) in scalar assignment a#, | |
507 | "Can't modify transliteration (tr///) in scalar assignment"; | |
781ff25d FC |
508 | |
509 | # Miscellaneous | |
510 | ||
511 | { | |
88cc83cb | 512 | local $::TODO = ' '; |
781ff25d FC |
513 | my($x,$y); |
514 | sub { | |
515 | sub { | |
516 | \$x = \$y; | |
517 | }->(); | |
518 | is \$x, \$y, 'lexical alias affects outer closure'; | |
519 | }->(); | |
520 | is \$x, \$y, 'lexical alias affects outer sub where vars are declared'; | |
521 | } | |
81cb1af6 FC |
522 | |
523 | { # PADSTALE has a double meaning | |
3ad7d304 | 524 | use feature 'lexical_subs', 'signatures'; |
81cb1af6 FC |
525 | no warnings 'experimental'; |
526 | my $c; | |
527 | my sub s ($arg) { | |
528 | state $x = ++$c; | |
529 | if ($arg == 3) { return $c } | |
530 | goto skip if $arg == 2; | |
531 | my $y; | |
532 | skip: | |
533 | # $y is PADSTALE the 2nd time | |
534 | \$x = \$y if $arg == 2; | |
535 | } | |
536 | s(1); | |
537 | s(2); | |
538 | is s(3), 1, 'padstale alias should not reset state' | |
539 | } | |
cf5d2d91 | 540 | |
8d55e914 | 541 | { |
cf5d2d91 | 542 | my $a; |
e678439a | 543 | no warnings 'experimental::builtin'; |
8d55e914 | 544 | builtin::weaken($r = \$a); |
cf5d2d91 FC |
545 | \$a = $r; |
546 | pass 'no crash when assigning \$lex = $weakref_to_lex' | |
547 | } | |
6f5dab3c FC |
548 | |
549 | { | |
550 | \my $x = \my $y; | |
551 | $x = 3; | |
552 | ($x, my $z) = (1, $y); | |
553 | is $z, 3, 'list assignment after aliasing lexical scalars'; | |
554 | } | |
555 | { | |
556 | (\my $x) = \my $y; | |
557 | $x = 3; | |
558 | ($x, my $z) = (1, $y); | |
559 | is $z, 3, | |
560 | 'regular list assignment after aliasing via list assignment'; | |
561 | } | |
562 | { | |
563 | my $y; | |
564 | goto do_aliasing; | |
565 | ||
566 | do_test: | |
567 | $y = 3; | |
568 | my($x,$z) = (1, $y); | |
569 | is $z, 3, 'list assignment "before" aliasing lexical scalars'; | |
570 | last; | |
571 | ||
572 | do_aliasing: | |
573 | \$x = \$y; | |
574 | goto do_test; | |
575 | } | |
576 | { | |
577 | my $y; | |
578 | goto do_aliasing2; | |
579 | ||
580 | do_test2: | |
581 | $y = 3; | |
582 | my($x,$z) = (1, $y); | |
583 | is $z, 3, | |
584 | 'list assignment "before" aliasing lex scalars via list assignment'; | |
585 | last; | |
586 | ||
587 | do_aliasing2: | |
588 | \($x) = \$y; | |
589 | goto do_test2; | |
590 | } | |
cb93cfd8 FC |
591 | { |
592 | my @a; | |
593 | goto do_aliasing3; | |
594 | ||
595 | do_test3: | |
596 | @a[0,1] = qw<a b>; | |
597 | my($y,$x) = ($a[0],$a[1]); | |
598 | is "@a", 'b a', | |
599 | 'aelemfast_lex-to-scalar list assignment "before" aliasing'; | |
600 | last; | |
601 | ||
602 | do_aliasing3: | |
603 | \(@a) = \($x,$y); | |
604 | goto do_test3; | |
605 | } | |
71488339 FC |
606 | |
607 | # Used to fail an assertion [perl #123821] | |
608 | eval '\(&$0)=0'; | |
c61e1036 DM |
609 | pass("RT #123821"); |
610 | ||
611 | # Used to fail an assertion [perl #128252] | |
612 | { | |
613 | no feature 'refaliasing'; | |
614 | use warnings; | |
615 | eval q{sub{\@0[0]=0};}; | |
616 | pass("RT #128252"); | |
617 | } | |
b97fe865 DM |
618 | |
619 | # RT #133538 slices were inadvertently always localising | |
620 | ||
621 | { | |
622 | use feature 'refaliasing'; | |
623 | no warnings 'experimental'; | |
624 | ||
625 | my @src = (100,200,300); | |
626 | ||
627 | my @a = (1,2,3); | |
628 | my %h = qw(one 10 two 20 three 30); | |
629 | ||
630 | { | |
631 | use feature 'declared_refs'; | |
632 | local \(@a[0,1,2]) = \(@src); | |
633 | local \(@h{qw(one two three)}) = \(@src); | |
634 | $src[0]++; | |
635 | is("@a", "101 200 300", "rt #133538 \@a aliased"); | |
636 | is("$h{one} $h{two} $h{three}", "101 200 300", "rt #133538 %h aliased"); | |
637 | } | |
638 | is("@a", "1 2 3", "rt #133538 \@a restored"); | |
639 | is("$h{one} $h{two} $h{three}", "10 20 30", "rt #133538 %h restored"); | |
640 | ||
641 | { | |
642 | \(@a[0,1,2]) = \(@src); | |
643 | \(@h{qw(one two three)}) = \(@src); | |
644 | $src[0]++; | |
645 | is("@a", "102 200 300", "rt #133538 \@a aliased try 2"); | |
646 | is("$h{one} $h{two} $h{three}", "102 200 300", | |
647 | "rt #133538 %h aliased try 2"); | |
648 | } | |
649 | $src[2]++; | |
650 | is("@a", "102 200 301", "rt #133538 \@a still aliased"); | |
651 | is("$h{one} $h{two} $h{three}", "102 200 301", "rt #133538 %h still aliased"); | |
652 | ||
653 | } |