1#!./perl 2 3BEGIN { 4 chdir 't' if -d 't'; 5 @INC = qw(. ../lib); 6 require './test.pl'; 7} 8plan tests => 310; 9 10my $list_assignment_supported = 1; 11 12#mg.c says list assignment not supported on VMS and SYMBIAN. 13$list_assignment_supported = 0 if ($^O eq 'VMS'); 14 15 16sub foo { 17 local($a, $b) = @_; 18 local($c, $d); 19 $c = "c 3"; 20 $d = "d 4"; 21 { local($a,$c) = ("a 9", "c 10"); ($x, $y) = ($a, $c); } 22 is($a, "a 1"); 23 is($b, "b 2"); 24 $c, $d; 25} 26 27$a = "a 5"; 28$b = "b 6"; 29$c = "c 7"; 30$d = "d 8"; 31 32my @res; 33@res = &foo("a 1","b 2"); 34is($res[0], "c 3"); 35is($res[1], "d 4"); 36 37is($a, "a 5"); 38is($b, "b 6"); 39is($c, "c 7"); 40is($d, "d 8"); 41is($x, "a 9"); 42is($y, "c 10"); 43 44# same thing, only with arrays and associative arrays 45 46sub foo2 { 47 local($a, @b) = @_; 48 local(@c, %d); 49 @c = "c 3"; 50 $d{''} = "d 4"; 51 { local($a,@c) = ("a 19", "c 20"); ($x, $y) = ($a, @c); } 52 is($a, "a 1"); 53 is("@b", "b 2"); 54 $c[0], $d{''}; 55} 56 57$a = "a 5"; 58@b = "b 6"; 59@c = "c 7"; 60$d{''} = "d 8"; 61 62@res = &foo2("a 1","b 2"); 63is($res[0], "c 3"); 64is($res[1], "d 4"); 65 66is($a, "a 5"); 67is("@b", "b 6"); 68is($c[0], "c 7"); 69is($d{''}, "d 8"); 70is($x, "a 19"); 71is($y, "c 20"); 72 73 74eval 'local($$e)'; 75like($@, qr/Can't localize through a reference/); 76 77eval '$e = []; local(@$e)'; 78like($@, qr/Can't localize through a reference/); 79 80eval '$e = {}; local(%$e)'; 81like($@, qr/Can't localize through a reference/); 82 83# Array and hash elements 84 85@a = ('a', 'b', 'c'); 86{ 87 local($a[1]) = 'foo'; 88 local($a[2]) = $a[2]; 89 is($a[1], 'foo'); 90 is($a[2], 'c'); 91 undef @a; 92} 93is($a[1], 'b'); 94is($a[2], 'c'); 95ok(!defined $a[0]); 96 97@a = ('a', 'b', 'c'); 98{ 99 local($a[4]) = 'x'; 100 ok(!defined $a[3]); 101 is($a[4], 'x'); 102} 103is(scalar(@a), 3); 104ok(!exists $a[3]); 105ok(!exists $a[4]); 106 107@a = ('a', 'b', 'c'); 108{ 109 local($a[5]) = 'z'; 110 $a[4] = 'y'; 111 ok(!defined $a[3]); 112 is($a[4], 'y'); 113 is($a[5], 'z'); 114} 115is(scalar(@a), 5); 116ok(!defined $a[3]); 117is($a[4], 'y'); 118ok(!exists $a[5]); 119 120@a = ('a', 'b', 'c'); 121{ 122 local(@a[4,6]) = ('x', 'z'); 123 ok(!defined $a[3]); 124 is($a[4], 'x'); 125 ok(!defined $a[5]); 126 is($a[6], 'z'); 127} 128is(scalar(@a), 3); 129ok(!exists $a[3]); 130ok(!exists $a[4]); 131ok(!exists $a[5]); 132ok(!exists $a[6]); 133 134@a = ('a', 'b', 'c'); 135{ 136 local(@a[4,6]) = ('x', 'z'); 137 $a[5] = 'y'; 138 ok(!defined $a[3]); 139 is($a[4], 'x'); 140 is($a[5], 'y'); 141 is($a[6], 'z'); 142} 143is(scalar(@a), 6); 144ok(!defined $a[3]); 145ok(!defined $a[4]); 146is($a[5], 'y'); 147ok(!exists $a[6]); 148 149@a = ('a', 'b', 'c'); 150{ 151 local($a[1]) = "X"; 152 shift @a; 153} 154is($a[0].$a[1], "Xb"); 155{ 156 my $d = "@a"; 157 local @a = @a; 158 is("@a", $d); 159} 160 161@a = ('a', 'b', 'c'); 162$a[4] = 'd'; 163{ 164 delete local $a[1]; 165 is(scalar(@a), 5); 166 is($a[0], 'a'); 167 ok(!exists($a[1])); 168 is($a[2], 'c'); 169 ok(!exists($a[3])); 170 is($a[4], 'd'); 171 172 ok(!exists($a[888])); 173 delete local $a[888]; 174 is(scalar(@a), 5); 175 ok(!exists($a[888])); 176 177 ok(!exists($a[999])); 178 my ($d, $zzz) = delete local @a[4, 999]; 179 is(scalar(@a), 3); 180 ok(!exists($a[4])); 181 ok(!exists($a[999])); 182 is($d, 'd'); 183 is($zzz, undef); 184 185 my $c = delete local $a[2]; 186 is(scalar(@a), 1); 187 ok(!exists($a[2])); 188 is($c, 'c'); 189 190 $a[888] = 'yyy'; 191 $a[999] = 'zzz'; 192} 193is(scalar(@a), 5); 194is($a[0], 'a'); 195is($a[1], 'b'); 196is($a[2], 'c'); 197ok(!defined($a[3])); 198is($a[4], 'd'); 199ok(!exists($a[5])); 200ok(!exists($a[888])); 201ok(!exists($a[999])); 202 203%h = (a => 1, b => 2, c => 3, d => 4); 204{ 205 delete local $h{b}; 206 is(scalar(keys(%h)), 3); 207 is($h{a}, 1); 208 ok(!exists($h{b})); 209 is($h{c}, 3); 210 is($h{d}, 4); 211 212 ok(!exists($h{yyy})); 213 delete local $h{yyy}; 214 is(scalar(keys(%h)), 3); 215 ok(!exists($h{yyy})); 216 217 ok(!exists($h{zzz})); 218 my ($d, $zzz) = delete local @h{qw/d zzz/}; 219 is(scalar(keys(%h)), 2); 220 ok(!exists($h{d})); 221 ok(!exists($h{zzz})); 222 is($d, 4); 223 is($zzz, undef); 224 225 my $c = delete local $h{c}; 226 is(scalar(keys(%h)), 1); 227 ok(!exists($h{c})); 228 is($c, 3); 229 230 $h{yyy} = 888; 231 $h{zzz} = 999; 232} 233is(scalar(keys(%h)), 4); 234is($h{a}, 1); 235is($h{b}, 2); 236is($h{c}, 3); 237ok($h{d}, 4); 238ok(!exists($h{yyy})); 239ok(!exists($h{zzz})); 240 241%h = ('a' => { 'b' => 1 }, 'c' => 2); 242{ 243 my $a = delete local $h{a}; 244 is(scalar(keys(%h)), 1); 245 ok(!exists($h{a})); 246 is($h{c}, 2); 247 is(scalar(keys(%$a)), 1); 248 249 my $b = delete local $a->{b}; 250 is(scalar(keys(%$a)), 0); 251 is($b, 1); 252 253 $a->{d} = 3; 254} 255is(scalar(keys(%h)), 2); 256{ 257 my $a = $h{a}; 258 is(scalar(keys(%$a)), 2); 259 is($a->{b}, 1); 260 is($a->{d}, 3); 261} 262is($h{c}, 2); 263 264%h = ('a' => 1, 'b' => 2, 'c' => 3); 265{ 266 local($h{'a'}) = 'foo'; 267 local($h{'b'}) = $h{'b'}; 268 is($h{'a'}, 'foo'); 269 is($h{'b'}, 2); 270 local($h{'c'}); 271 delete $h{'c'}; 272} 273is($h{'a'}, 1); 274is($h{'b'}, 2); 275{ 276 my $d = join("\n", map { "$_=>$h{$_}" } sort keys %h); 277 local %h = %h; 278 is(join("\n", map { "$_=>$h{$_}" } sort keys %h), $d); 279} 280is($h{'c'}, 3); 281 282# check for scope leakage 283$a = 'outer'; 284if (1) { local $a = 'inner' } 285is($a, 'outer'); 286 287# see if localization works when scope unwinds 288local $m = 5; 289eval { 290 for $m (6) { 291 local $m = 7; 292 die "bye"; 293 } 294}; 295is($m, 5); 296 297# see if localization works on tied arrays 298{ 299 package TA; 300 sub TIEARRAY { bless [], $_[0] } 301 sub STORE { print "# STORE [@_]\n"; $_[0]->[$_[1]] = $_[2] } 302 sub FETCH { my $v = $_[0]->[$_[1]]; print "# FETCH [@_=$v]\n"; $v } 303 sub EXISTS { print "# EXISTS [@_]\n"; exists $_[0]->[$_[1]]; } 304 sub DELETE { print "# DELETE [@_]\n"; delete $_[0]->[$_[1]]; } 305 sub CLEAR { print "# CLEAR [@_]\n"; @{$_[0]} = (); } 306 sub FETCHSIZE { scalar(@{$_[0]}) } 307 sub SHIFT { shift (@{$_[0]}) } 308 sub EXTEND {} 309} 310 311tie @a, 'TA'; 312@a = ('a', 'b', 'c'); 313{ 314 local($a[1]) = 'foo'; 315 local($a[2]) = $a[2]; 316 is($a[1], 'foo'); 317 is($a[2], 'c'); 318 @a = (); 319} 320is($a[1], 'b'); 321is($a[2], 'c'); 322ok(!defined $a[0]); 323{ 324 my $d = "@a"; 325 local @a = @a; 326 is("@a", $d); 327} 328# RT #7938: localising an array should make it temporarily untied 329{ 330 @a = qw(a b c); 331 local @a = (6,7,8); 332 is("@a", "6 7 8", 'local @a assigned 6,7,8'); 333 { 334 my $c = 0; 335 local *TA::STORE = sub { $c++ }; 336 $a[0] = 9; 337 is($c, 0, 'STORE not called after array localised'); 338 } 339 is("@a", "9 7 8", 'local @a should now be 9 7 8'); 340} 341is("@a", "a b c", '@a should now contain original value'); 342 343 344# local() should preserve the existenceness of tied array elements 345@a = ('a', 'b', 'c'); 346{ 347 local($a[4]) = 'x'; 348 ok(!defined $a[3]); 349 is($a[4], 'x'); 350} 351is(scalar(@a), 3); 352ok(!exists $a[3]); 353ok(!exists $a[4]); 354 355@a = ('a', 'b', 'c'); 356{ 357 local($a[5]) = 'z'; 358 $a[4] = 'y'; 359 ok(!defined $a[3]); 360 is($a[4], 'y'); 361 is($a[5], 'z'); 362} 363is(scalar(@a), 5); 364ok(!defined $a[3]); 365is($a[4], 'y'); 366ok(!exists $a[5]); 367 368@a = ('a', 'b', 'c'); 369{ 370 local(@a[4,6]) = ('x', 'z'); 371 ok(!defined $a[3]); 372 is($a[4], 'x'); 373 ok(!defined $a[5]); 374 is($a[6], 'z'); 375} 376is(scalar(@a), 3); 377ok(!exists $a[3]); 378ok(!exists $a[4]); 379ok(!exists $a[5]); 380ok(!exists $a[6]); 381 382@a = ('a', 'b', 'c'); 383{ 384 local(@a[4,6]) = ('x', 'z'); 385 $a[5] = 'y'; 386 ok(!defined $a[3]); 387 is($a[4], 'x'); 388 is($a[5], 'y'); 389 is($a[6], 'z'); 390} 391is(scalar(@a), 6); 392ok(!defined $a[3]); 393ok(!defined $a[4]); 394is($a[5], 'y'); 395ok(!exists $a[6]); 396 397@a = ('a', 'b', 'c'); 398$a[4] = 'd'; 399{ 400 delete local $a[1]; 401 is(scalar(@a), 5); 402 is($a[0], 'a'); 403 ok(!exists($a[1])); 404 is($a[2], 'c'); 405 ok(!exists($a[3])); 406 is($a[4], 'd'); 407 408 ok(!exists($a[888])); 409 delete local $a[888]; 410 is(scalar(@a), 5); 411 ok(!exists($a[888])); 412 413 ok(!exists($a[999])); 414 my ($d, $zzz) = delete local @a[4, 999]; 415 is(scalar(@a), 3); 416 ok(!exists($a[4])); 417 ok(!exists($a[999])); 418 is($d, 'd'); 419 is($zzz, undef); 420 421 my $c = delete local $a[2]; 422 is(scalar(@a), 1); 423 ok(!exists($a[2])); 424 is($c, 'c'); 425 426 $a[888] = 'yyy'; 427 $a[999] = 'zzz'; 428} 429is(scalar(@a), 5); 430is($a[0], 'a'); 431is($a[1], 'b'); 432is($a[2], 'c'); 433ok(!defined($a[3])); 434is($a[4], 'd'); 435ok(!exists($a[5])); 436ok(!exists($a[888])); 437ok(!exists($a[999])); 438 439# see if localization works on tied hashes 440{ 441 package TH; 442 sub TIEHASH { bless {}, $_[0] } 443 sub STORE { print "# STORE [@_]\n"; $_[0]->{$_[1]} = $_[2] } 444 sub FETCH { my $v = $_[0]->{$_[1]}; print "# FETCH [@_=$v]\n"; $v } 445 sub EXISTS { print "# EXISTS [@_]\n"; exists $_[0]->{$_[1]}; } 446 sub DELETE { print "# DELETE [@_]\n"; delete $_[0]->{$_[1]}; } 447 sub CLEAR { print "# CLEAR [@_]\n"; %{$_[0]} = (); } 448 sub FIRSTKEY { print "# FIRSTKEY [@_]\n"; keys %{$_[0]}; each %{$_[0]} } 449 sub NEXTKEY { print "# NEXTKEY [@_]\n"; each %{$_[0]} } 450} 451 452tie %h, 'TH'; 453%h = ('a' => 1, 'b' => 2, 'c' => 3); 454 455{ 456 local($h{'a'}) = 'foo'; 457 local($h{'b'}) = $h{'b'}; 458 local($h{'y'}); 459 local($h{'z'}) = 33; 460 is($h{'a'}, 'foo'); 461 is($h{'b'}, 2); 462 local($h{'c'}); 463 delete $h{'c'}; 464} 465is($h{'a'}, 1); 466is($h{'b'}, 2); 467is($h{'c'}, 3); 468 469# local() should preserve the existenceness of tied hash elements 470ok(! exists $h{'y'}); 471ok(! exists $h{'z'}); 472TODO: { 473 todo_skip("Localize entire tied hash"); 474 my $d = join("\n", map { "$_=>$h{$_}" } sort keys %h); 475 local %h = %h; 476 is(join("\n", map { "$_=>$h{$_}" } sort keys %h), $d); 477} 478 479# RT #7939: localising a hash should make it temporarily untied 480{ 481 %h = qw(a 1 b 2 c 3); 482 local %h = qw(x 6 y 7 z 8); 483 is(join('', sort keys %h), "xyz", 'local %h has new keys'); 484 is(join('', sort values %h), "678", 'local %h has new values'); 485 { 486 my $c = 0; 487 local *TH::STORE = sub { $c++ }; 488 $h{x} = 9; 489 is($c, 0, 'STORE not called after hash localised'); 490 } 491 is($h{x}, 9, '$h{x} should now be 9'); 492} 493is(join('', sort keys %h), "abc", 'restored %h has original keys'); 494is(join('', sort values %h), "123", 'restored %h has original values'); 495 496 497%h = (a => 1, b => 2, c => 3, d => 4); 498{ 499 delete local $h{b}; 500 is(scalar(keys(%h)), 3); 501 is($h{a}, 1); 502 ok(!exists($h{b})); 503 is($h{c}, 3); 504 is($h{d}, 4); 505 506 ok(!exists($h{yyy})); 507 delete local $h{yyy}; 508 is(scalar(keys(%h)), 3); 509 ok(!exists($h{yyy})); 510 511 ok(!exists($h{zzz})); 512 my ($d, $zzz) = delete local @h{qw/d zzz/}; 513 is(scalar(keys(%h)), 2); 514 ok(!exists($h{d})); 515 ok(!exists($h{zzz})); 516 is($d, 4); 517 is($zzz, undef); 518 519 my $c = delete local $h{c}; 520 is(scalar(keys(%h)), 1); 521 ok(!exists($h{c})); 522 is($c, 3); 523 524 $h{yyy} = 888; 525 $h{zzz} = 999; 526} 527is(scalar(keys(%h)), 4); 528is($h{a}, 1); 529is($h{b}, 2); 530is($h{c}, 3); 531ok($h{d}, 4); 532ok(!exists($h{yyy})); 533ok(!exists($h{zzz})); 534 535@a = ('a', 'b', 'c'); 536{ 537 local($a[1]) = "X"; 538 shift @a; 539} 540is($a[0].$a[1], "Xb"); 541 542# now try the same for %SIG 543 544$SIG{TERM} = 'foo'; 545$SIG{INT} = \&foo; 546$SIG{__WARN__} = $SIG{INT}; 547{ 548 local($SIG{TERM}) = $SIG{TERM}; 549 local($SIG{INT}) = $SIG{INT}; 550 local($SIG{__WARN__}) = $SIG{__WARN__}; 551 is($SIG{TERM}, 'main::foo'); 552 is($SIG{INT}, \&foo); 553 is($SIG{__WARN__}, \&foo); 554 local($SIG{INT}); 555 delete $SIG{__WARN__}; 556} 557is($SIG{TERM}, 'main::foo'); 558is($SIG{INT}, \&foo); 559is($SIG{__WARN__}, \&foo); 560{ 561 my $d = join("\n", map { "$_=>$SIG{$_}" } sort keys %SIG); 562 local %SIG = %SIG; 563 is(join("\n", map { "$_=>$SIG{$_}" } sort keys %SIG), $d); 564} 565 566# and for %ENV 567 568$ENV{_X_} = 'a'; 569$ENV{_Y_} = 'b'; 570$ENV{_Z_} = 'c'; 571{ 572 local($ENV{_A_}); 573 local($ENV{_B_}) = 'foo'; 574 local($ENV{_X_}) = 'foo'; 575 local($ENV{_Y_}) = $ENV{_Y_}; 576 is($ENV{_X_}, 'foo'); 577 is($ENV{_Y_}, 'b'); 578 local($ENV{_Z_}); 579 delete $ENV{_Z_}; 580} 581is($ENV{_X_}, 'a'); 582is($ENV{_Y_}, 'b'); 583is($ENV{_Z_}, 'c'); 584# local() should preserve the existenceness of %ENV elements 585ok(! exists $ENV{_A_}); 586ok(! exists $ENV{_B_}); 587 588SKIP: { 589 skip("Can't make list assignment to \%ENV on this system") 590 unless $list_assignment_supported; 591 my $d = join("\n", map { "$_=>$ENV{$_}" } sort keys %ENV); 592 local %ENV = %ENV; 593 is(join("\n", map { "$_=>$ENV{$_}" } sort keys %ENV), $d); 594} 595 596# does implicit localization in foreach skip magic? 597 598$_ = "o 0,o 1,"; 599my $iter = 0; 600while (/(o.+?),/gc) { 601 is($1, "o $iter"); 602 foreach (1..1) { $iter++ } 603 if ($iter > 2) { fail("endless loop"); last; } 604} 605 606{ 607 package UnderScore; 608 sub TIESCALAR { bless \my $self, shift } 609 sub FETCH { die "read \$_ forbidden" } 610 sub STORE { die "write \$_ forbidden" } 611 tie $_, __PACKAGE__; 612 my @tests = ( 613 "Nesting" => sub { print '#'; for (1..3) { print } 614 print "\n" }, 1, 615 "Reading" => sub { print }, 0, 616 "Matching" => sub { $x = /badness/ }, 0, 617 "Concat" => sub { $_ .= "a" }, 0, 618 "Chop" => sub { chop }, 0, 619 "Filetest" => sub { -x }, 0, 620 "Assignment" => sub { $_ = "Bad" }, 0, 621 "for local" => sub { for("#ok?\n"){ print } }, 1, 622 ); 623 while ( ($name, $code, $ok) = splice(@tests, 0, 3) ) { 624 eval { &$code }; 625 main::ok(($ok xor $@), "Underscore '$name'"); 626 } 627 untie $_; 628} 629 630{ 631 # BUG 20001205.022 (RT #4852) 632 my %x; 633 $x{a} = 1; 634 { local $x{b} = 1; } 635 ok(! exists $x{b}); 636 { local @x{c,d,e}; } 637 ok(! exists $x{c}); 638} 639 640# local() and readonly magic variables 641 642eval { local $1 = 1 }; 643like($@, qr/Modification of a read-only value attempted/); 644 645# local($_) always strips all magic 646eval { for ($1) { local $_ = 1 } }; 647is($@, ""); 648 649{ 650 my $STORE = my $FETCH = 0; 651 package TieHash; 652 sub TIEHASH { bless $_[1], $_[0] } 653 sub FETCH { ++$FETCH; 42 } 654 sub STORE { ++$STORE } 655 656 package main; 657 tie my %hash, "TieHash", {}; 658 659 eval { for ($hash{key}) {local $_ = 2} }; 660 is($STORE, 0); 661 is($FETCH, 0); 662} 663 664# The s/// adds 'g' magic to $_, but it should remain non-readonly 665eval { for("a") { for $x (1,2) { local $_="b"; s/(.*)/+$1/ } } }; 666is($@, ""); 667 668# sub localisation 669{ 670 package Other; 671 672 sub f1 { "f1" } 673 sub f2 { "f2" } 674 675 no warnings "redefine"; 676 { 677 local *f1 = sub { "g1" }; 678 ::ok(f1() eq "g1", "localised sub via glob"); 679 } 680 ::ok(f1() eq "f1", "localised sub restored"); 681 { 682 local $Other::{"f1"} = sub { "h1" }; 683 ::ok(f1() eq "h1", "localised sub via stash"); 684 } 685 ::ok(f1() eq "f1", "localised sub restored"); 686 { 687 local @Other::{qw/ f1 f2 /} = (sub { "j1" }, sub { "j2" }); 688 ::ok(f1() eq "j1", "localised sub via stash slice"); 689 ::ok(f2() eq "j2", "localised sub via stash slice"); 690 } 691 ::ok(f1() eq "f1", "localised sub restored"); 692 ::ok(f2() eq "f2", "localised sub restored"); 693} 694 695# Localising unicode keys (bug #38815) 696{ 697 my %h; 698 $h{"\243"} = "pound"; 699 $h{"\302\240"} = "octects"; 700 is(scalar keys %h, 2); 701 { 702 my $unicode = chr 256; 703 my $ambigous = "\240" . $unicode; 704 chop $ambigous; 705 local $h{$unicode} = 256; 706 local $h{$ambigous} = 160; 707 708 is(scalar keys %h, 4); 709 is($h{"\243"}, "pound"); 710 is($h{$unicode}, 256); 711 is($h{$ambigous}, 160); 712 is($h{"\302\240"}, "octects"); 713 } 714 is(scalar keys %h, 2); 715 is($h{"\243"}, "pound"); 716 is($h{"\302\240"}, "octects"); 717} 718 719# And with slices 720{ 721 my %h; 722 $h{"\243"} = "pound"; 723 $h{"\302\240"} = "octects"; 724 is(scalar keys %h, 2); 725 { 726 my $unicode = chr 256; 727 my $ambigous = "\240" . $unicode; 728 chop $ambigous; 729 local @h{$unicode, $ambigous} = (256, 160); 730 731 is(scalar keys %h, 4); 732 is($h{"\243"}, "pound"); 733 is($h{$unicode}, 256); 734 is($h{$ambigous}, 160); 735 is($h{"\302\240"}, "octects"); 736 } 737 is(scalar keys %h, 2); 738 is($h{"\243"}, "pound"); 739 is($h{"\302\240"}, "octects"); 740} 741 742# [perl #39012] localizing @_ element then shifting frees element too # soon 743 744{ 745 my $x; 746 my $y = bless [], 'X39012'; 747 sub X39012::DESTROY { $x++ } 748 sub { local $_[0]; shift }->($y); 749 ok(!$x, '[perl #39012]'); 750 751} 752 753# when localising a hash element, the key should be copied, not referenced 754 755{ 756 my %h=('k1' => 111); 757 my $k='k1'; 758 { 759 local $h{$k}=222; 760 761 is($h{'k1'},222); 762 $k='k2'; 763 } 764 ok(! exists($h{'k2'})); 765 is($h{'k1'},111); 766} 767{ 768 my %h=('k1' => 111); 769 our $k = 'k1'; # try dynamic too 770 { 771 local $h{$k}=222; 772 is($h{'k1'},222); 773 $k='k2'; 774 } 775 ok(! exists($h{'k2'})); 776 is($h{'k1'},111); 777} 778 779like( runperl(stderr => 1, 780 prog => 'use constant foo => q(a);' . 781 'index(q(a), foo);' . 782 'local *g=${::}{foo};print q(ok);'), "ok", "[perl #52740]"); 783 784# related to perl #112966 785# Magic should not cause elements not to be deleted after scope unwinding 786# when they did not exist before local() 787() = \$#squinch; # $#foo in lvalue context makes array magical 788{ 789 local $squinch[0]; 790 local @squinch[1..2]; 791 package Flibbert; 792 m??; # makes stash magical 793 local $Flibbert::{foo}; 794 local @Flibbert::{<bar baz>}; 795} 796ok !exists $Flibbert::{foo}, 797 'local helem on magic hash does not leave elems on scope exit'; 798ok !exists $Flibbert::{bar}, 799 'local hslice on magic hash does not leave elems on scope exit'; 800ok !exists $squinch[0], 801 'local aelem on magic hash does not leave elems on scope exit'; 802ok !exists $squinch[1], 803 'local aslice on magic hash does not leave elems on scope exit'; 804 805# Keep these tests last, as they can SEGV 806{ 807 local *@; 808 pass("Localised *@"); 809 eval {1}; 810 pass("Can eval with *@ localised"); 811 812 local @{"nugguton"}; 813 local %{"netgonch"}; 814 delete $::{$_} for 'nugguton','netgonch'; 815} 816pass ('localised arrays and hashes do not crash if glob is deleted'); 817 818# [perl #112966] Rmagic can cause delete local to crash 819package Grompits { 820local $SIG{__WARN__}; 821 delete local $ISA[0]; 822 delete local @ISA[1..10]; 823 m??; # makes stash magical 824 delete local $Grompits::{foo}; 825 delete local @Grompits::{<foo bar>}; 826} 827pass 'rmagic does not cause delete local to crash on nonexistent elems'; 828