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