1#!./perl 2 3BEGIN { 4 chdir 't' if -d 't'; 5 require './test.pl'; 6 set_up_inc( qw(. ../lib) ); 7} 8plan tests => 319; 9 10my $list_assignment_supported = 1; 11 12#mg.c says list assignment not supported on VMS 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'}); 472{ 473 my $d = join("\n", map { "$_=>$h{$_}" } sort keys %h); 474 local %h = %h; 475 is(join("\n", map { "$_=>$h{$_}" } sort keys %h), $d); 476} 477 478# RT #7939: localising a hash should make it temporarily untied 479{ 480 %h = qw(a 1 b 2 c 3); 481 local %h = qw(x 6 y 7 z 8); 482 is(join('', sort keys %h), "xyz", 'local %h has new keys'); 483 is(join('', sort values %h), "678", 'local %h has new values'); 484 { 485 my $c = 0; 486 local *TH::STORE = sub { $c++ }; 487 $h{x} = 9; 488 is($c, 0, 'STORE not called after hash localised'); 489 } 490 is($h{x}, 9, '$h{x} should now be 9'); 491} 492is(join('', sort keys %h), "abc", 'restored %h has original keys'); 493is(join('', sort values %h), "123", 'restored %h has original values'); 494 495 496%h = (a => 1, b => 2, c => 3, d => 4); 497{ 498 delete local $h{b}; 499 is(scalar(keys(%h)), 3); 500 is($h{a}, 1); 501 ok(!exists($h{b})); 502 is($h{c}, 3); 503 is($h{d}, 4); 504 505 ok(!exists($h{yyy})); 506 delete local $h{yyy}; 507 is(scalar(keys(%h)), 3); 508 ok(!exists($h{yyy})); 509 510 ok(!exists($h{zzz})); 511 my ($d, $zzz) = delete local @h{qw/d zzz/}; 512 is(scalar(keys(%h)), 2); 513 ok(!exists($h{d})); 514 ok(!exists($h{zzz})); 515 is($d, 4); 516 is($zzz, undef); 517 518 my $c = delete local $h{c}; 519 is(scalar(keys(%h)), 1); 520 ok(!exists($h{c})); 521 is($c, 3); 522 523 $h{yyy} = 888; 524 $h{zzz} = 999; 525} 526is(scalar(keys(%h)), 4); 527is($h{a}, 1); 528is($h{b}, 2); 529is($h{c}, 3); 530ok($h{d}, 4); 531ok(!exists($h{yyy})); 532ok(!exists($h{zzz})); 533 534@a = ('a', 'b', 'c'); 535{ 536 local($a[1]) = "X"; 537 shift @a; 538} 539is($a[0].$a[1], "Xb"); 540 541# now try the same for %SIG 542 543$SIG{TERM} = 'foo'; 544$SIG{INT} = \&foo; 545$SIG{__WARN__} = $SIG{INT}; 546{ 547 local($SIG{TERM}) = $SIG{TERM}; 548 local($SIG{INT}) = $SIG{INT}; 549 local($SIG{__WARN__}) = $SIG{__WARN__}; 550 is($SIG{TERM}, 'main::foo'); 551 is($SIG{INT}, \&foo); 552 is($SIG{__WARN__}, \&foo); 553 local($SIG{INT}); 554 delete $SIG{__WARN__}; 555} 556is($SIG{TERM}, 'main::foo'); 557is($SIG{INT}, \&foo); 558is($SIG{__WARN__}, \&foo); 559{ 560 my $d = join("\n", map { "$_=>$SIG{$_}" } sort keys %SIG); 561 local %SIG = %SIG; 562 is(join("\n", map { "$_=>$SIG{$_}" } sort keys %SIG), $d); 563} 564 565# and for %ENV 566 567$ENV{_X_} = 'a'; 568$ENV{_Y_} = 'b'; 569$ENV{_Z_} = 'c'; 570{ 571 local($ENV{_A_}); 572 local($ENV{_B_}) = 'foo'; 573 local($ENV{_X_}) = 'foo'; 574 local($ENV{_Y_}) = $ENV{_Y_}; 575 is($ENV{_X_}, 'foo'); 576 is($ENV{_Y_}, 'b'); 577 local($ENV{_Z_}); 578 delete $ENV{_Z_}; 579} 580is($ENV{_X_}, 'a'); 581is($ENV{_Y_}, 'b'); 582is($ENV{_Z_}, 'c'); 583# local() should preserve the existenceness of %ENV elements 584ok(! exists $ENV{_A_}); 585ok(! exists $ENV{_B_}); 586 587SKIP: { 588 skip("Can't make list assignment to \%ENV on this system") 589 unless $list_assignment_supported; 590 my $d = join("\n", map { "$_=>$ENV{$_}" } sort keys %ENV); 591 local %ENV = %ENV; 592 is(join("\n", map { "$_=>$ENV{$_}" } sort keys %ENV), $d); 593} 594 595# does implicit localization in foreach skip magic? 596 597$_ = "o 0,o 1,"; 598my $iter = 0; 599while (/(o.+?),/gc) { 600 is($1, "o $iter"); 601 foreach (1..1) { $iter++ } 602 if ($iter > 2) { fail("endless loop"); last; } 603} 604 605{ 606 package UnderScore; 607 sub TIESCALAR { bless \my $self, shift } 608 sub FETCH { die "read \$_ forbidden" } 609 sub STORE { die "write \$_ forbidden" } 610 tie $_, __PACKAGE__; 611 my @tests = ( 612 "Nesting" => sub { my $x = '#'; for (1..3) { $x .= $_ } 613 print "$x\n" }, 1, 614 "Reading" => sub { print }, 0, 615 "Matching" => sub { $x = /badness/ }, 0, 616 "Concat" => sub { $_ .= "a" }, 0, 617 "Chop" => sub { chop }, 0, 618 "Filetest" => sub { -x }, 0, 619 "Assignment" => sub { $_ = "Bad" }, 0, 620 "for local" => sub { for("#ok?\n"){ print } }, 1, 621 ); 622 while ( ($name, $code, $ok) = splice(@tests, 0, 3) ) { 623 eval { &$code }; 624 main::ok(($ok xor $@), "Underscore '$name'"); 625 } 626 untie $_; 627} 628 629{ 630 # BUG 20001205.022 (RT #4852) 631 my %x; 632 $x{a} = 1; 633 { local $x{b} = 1; } 634 ok(! exists $x{b}); 635 { local @x{c,d,e}; } 636 ok(! exists $x{c}); 637} 638 639# local() and readonly magic variables 640 641eval { local $1 = 1 }; 642like($@, qr/Modification of a read-only value attempted/); 643 644# local($_) always strips all magic 645eval { for ($1) { local $_ = 1 } }; 646is($@, ""); 647 648{ 649 my $STORE = my $FETCH = 0; 650 package TieHash; 651 sub TIEHASH { bless $_[1], $_[0] } 652 sub FETCH { ++$FETCH; 42 } 653 sub STORE { ++$STORE } 654 655 package main; 656 tie my %hash, "TieHash", {}; 657 658 eval { for ($hash{key}) {local $_ = 2} }; 659 is($STORE, 0); 660 is($FETCH, 0); 661} 662 663# The s/// adds 'g' magic to $_, but it should remain non-readonly 664eval { for("a") { for $x (1,2) { local $_="b"; s/(.*)/+$1/ } } }; 665is($@, ""); 666 667# sub localisation 668{ 669 package Other; 670 671 sub f1 { "f1" } 672 sub f2 { "f2" } 673 sub f3 { "f3" } 674 sub f4 { "f4" } 675 676 no warnings "redefine"; 677 { 678 local *f1 = sub { "g1" }; 679 ::ok(f1() eq "g1", "localised sub via glob"); 680 } 681 ::ok(f1() eq "f1", "localised sub restored"); 682 { 683 local $Other::{"f1"} = sub { "h1" }; 684 ::ok(f1() eq "h1", "localised sub via stash"); 685 } 686 ::ok(f1() eq "f1", "localised sub restored"); 687 # Do that test again, but with a different glob, to make sure that 688 # localisation via multideref can handle a subref in a stash. 689 # (The local *f1 above will have ensured that we have a full glob, 690 # not a sub ref.) 691 { 692 local $Other::{"f3"} = sub { "h1" }; 693 ::ok(f3() eq "h1", "localised sub via stash"); 694 } 695 ::ok(f3() eq "f3", "localised sub restored"); 696 # Also, we need to test pp_helem, which we can do by using a more 697 # complex subscript. 698 { 699 local $Other::{${\"f4"}} = sub { "h1" }; 700 ::ok(f4() eq "h1", "localised sub via stash"); 701 } 702 ::ok(f4() eq "f4", "localised sub restored"); 703 { 704 local @Other::{qw/ f1 f2 /} = (sub { "j1" }, sub { "j2" }); 705 ::ok(f1() eq "j1", "localised sub via stash slice"); 706 ::ok(f2() eq "j2", "localised sub via stash slice"); 707 } 708 ::ok(f1() eq "f1", "localised sub restored"); 709 ::ok(f2() eq "f2", "localised sub restored"); 710} 711 712# Localising unicode keys (bug #38815) 713{ 714 my %h; 715 $h{"\243"} = "pound"; 716 $h{"\302\240"} = "octects"; 717 is(scalar keys %h, 2); 718 { 719 my $unicode = chr 256; 720 my $ambigous = "\240" . $unicode; 721 chop $ambigous; 722 local $h{$unicode} = 256; 723 local $h{$ambigous} = 160; 724 725 is(scalar keys %h, 4); 726 is($h{"\243"}, "pound"); 727 is($h{$unicode}, 256); 728 is($h{$ambigous}, 160); 729 is($h{"\302\240"}, "octects"); 730 } 731 is(scalar keys %h, 2); 732 is($h{"\243"}, "pound"); 733 is($h{"\302\240"}, "octects"); 734} 735 736# And with slices 737{ 738 my %h; 739 $h{"\243"} = "pound"; 740 $h{"\302\240"} = "octects"; 741 is(scalar keys %h, 2); 742 { 743 my $unicode = chr 256; 744 my $ambigous = "\240" . $unicode; 745 chop $ambigous; 746 local @h{$unicode, $ambigous} = (256, 160); 747 748 is(scalar keys %h, 4); 749 is($h{"\243"}, "pound"); 750 is($h{$unicode}, 256); 751 is($h{$ambigous}, 160); 752 is($h{"\302\240"}, "octects"); 753 } 754 is(scalar keys %h, 2); 755 is($h{"\243"}, "pound"); 756 is($h{"\302\240"}, "octects"); 757} 758 759# [perl #39012] localizing @_ element then shifting frees element too # soon 760 761{ 762 my $x; 763 my $y = bless [], 'X39012'; 764 sub X39012::DESTROY { $x++ } 765 sub { local $_[0]; shift }->($y); 766 ok(!$x, '[perl #39012]'); 767 768} 769 770# when localising a hash element, the key should be copied, not referenced 771 772{ 773 my %h=('k1' => 111); 774 my $k='k1'; 775 { 776 local $h{$k}=222; 777 778 is($h{'k1'},222); 779 $k='k2'; 780 } 781 ok(! exists($h{'k2'})); 782 is($h{'k1'},111); 783} 784{ 785 my %h=('k1' => 111); 786 our $k = 'k1'; # try dynamic too 787 { 788 local $h{$k}=222; 789 is($h{'k1'},222); 790 $k='k2'; 791 } 792 ok(! exists($h{'k2'})); 793 is($h{'k1'},111); 794} 795 796like( runperl(stderr => 1, 797 prog => 'use constant foo => q(a);' . 798 'index(q(a), foo);' . 799 'local *g=${::}{foo};print q(ok);'), qr/^ok$/, "[perl #52740]"); 800 801# related to perl #112966 802# Magic should not cause elements not to be deleted after scope unwinding 803# when they did not exist before local() 804() = \$#squinch; # $#foo in lvalue context makes array magical 805{ 806 local $squinch[0]; 807 local @squinch[1..2]; 808 package Flibbert; 809 m??; # makes stash magical 810 local $Flibbert::{foo}; 811 local @Flibbert::{<bar baz>}; 812} 813ok !exists $Flibbert::{foo}, 814 'local helem on magic hash does not leave elems on scope exit'; 815ok !exists $Flibbert::{bar}, 816 'local hslice on magic hash does not leave elems on scope exit'; 817ok !exists $squinch[0], 818 'local aelem on magic hash does not leave elems on scope exit'; 819ok !exists $squinch[1], 820 'local aslice on magic hash does not leave elems on scope exit'; 821 822# Keep these tests last, as they can SEGV 823{ 824 local *@; 825 pass("Localised *@"); 826 eval {1}; 827 pass("Can eval with *@ localised"); 828 829 local @{"nugguton"}; 830 local %{"netgonch"}; 831 delete $::{$_} for 'nugguton','netgonch'; 832} 833pass ('localised arrays and hashes do not crash if glob is deleted'); 834 835# [perl #112966] Rmagic can cause delete local to crash 836package Grompits { 837local $SIG{__WARN__}; 838 delete local $ISA[0]; 839 delete local @ISA[1..10]; 840 m??; # makes stash magical 841 delete local $Grompits::{foo}; 842 delete local @Grompits::{<foo bar>}; 843} 844pass 'rmagic does not cause delete local to crash on nonexistent elems'; 845 846TODO: { 847 my @a = (1..5); 848 { 849 local $#a = 2; 850 is($#a, 2, 'RT #7411: local($#a) should change count'); 851 is("@a", '1 2 3', 'RT #7411: local($#a) should shorten array'); 852 } 853 854 local $::TODO = 'RT #7411: local($#a)'; 855 856 is($#a, 4, 'RT #7411: after local($#a), count should be restored'); 857 is("@a", '1 2 3 4 5', 'RT #7411: after local($#a), array should be restored'); 858} 859 860$a = 10; 861TODO: { 862 local $::TODO = 'RT #7615: if (local $a)'; 863 if (local $a = 1){ 864 } 865 is($a, 10, 'RT #7615: local in if condition should be restored'); 866} 867