Move the require './test.pl' to the end of t/comp/hints.t
[p5sagit/p5-mst-13.2.git] / t / op / local.t
CommitLineData
a687059c 1#!./perl
2
d441d3db 3BEGIN {
4 chdir 't' if -d 't';
28e491ba 5 @INC = qw(. ../lib);
d441d3db 6 require './test.pl';
7}
7332a6c4 8plan tests => 296;
a687059c 9
13414bd5 10my $list_assignment_supported = 1;
11
12#mg.c says list assignment not supported on VMS, EPOC, and SYMBIAN.
13$list_assignment_supported = 0 if ($^O eq 'VMS');
14
15
a687059c 16sub foo {
17 local($a, $b) = @_;
18 local($c, $d);
d441d3db 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;
a687059c 25}
26
d441d3db 27$a = "a 5";
28$b = "b 6";
29$c = "c 7";
30$d = "d 8";
a687059c 31
d441d3db 32my @res;
33@res = &foo("a 1","b 2");
34is($res[0], "c 3");
35is($res[1], "d 4");
a687059c 36
d441d3db 37is($a, "a 5");
38is($b, "b 6");
39is($c, "c 7");
40is($d, "d 8");
41is($x, "a 9");
42is($y, "c 10");
a687059c 43
44# same thing, only with arrays and associative arrays
45
46sub foo2 {
47 local($a, @b) = @_;
48 local(@c, %d);
d441d3db 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{''};
a687059c 55}
56
d441d3db 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");
a687059c 65
d441d3db 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");
a687059c 72
706a304b 73
74eval 'local($$e)';
d441d3db 75like($@, qr/Can't localize through a reference/);
706a304b 76
82d03984 77eval '$e = []; local(@$e)';
d441d3db 78like($@, qr/Can't localize through a reference/);
706a304b 79
82d03984 80eval '$e = {}; local(%$e)';
d441d3db 81like($@, qr/Can't localize through a reference/);
85aff577 82
161b7d16 83# Array and hash elements
84
85@a = ('a', 'b', 'c');
86{
87 local($a[1]) = 'foo';
88 local($a[2]) = $a[2];
d441d3db 89 is($a[1], 'foo');
90 is($a[2], 'c');
161b7d16 91 undef @a;
92}
d441d3db 93is($a[1], 'b');
94is($a[2], 'c');
95ok(!defined $a[0]);
161b7d16 96
97@a = ('a', 'b', 'c');
98{
4ad10a0b 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{
161b7d16 151 local($a[1]) = "X";
152 shift @a;
153}
d441d3db 154is($a[0].$a[1], "Xb");
d60c5a05 155{
156 my $d = "@a";
157 local @a = @a;
158 is("@a", $d);
159}
161b7d16 160
7332a6c4 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
161b7d16 264%h = ('a' => 1, 'b' => 2, 'c' => 3);
265{
266 local($h{'a'}) = 'foo';
267 local($h{'b'}) = $h{'b'};
d441d3db 268 is($h{'a'}, 'foo');
269 is($h{'b'}, 2);
161b7d16 270 local($h{'c'});
271 delete $h{'c'};
272}
d441d3db 273is($h{'a'}, 1);
274is($h{'b'}, 2);
d60c5a05 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}
d441d3db 280is($h{'c'}, 3);
2bb40b7f 281
282# check for scope leakage
283$a = 'outer';
284if (1) { local $a = 'inner' }
d441d3db 285is($a, 'outer');
2bb40b7f 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};
d441d3db 295is($m, 5);
4e4c362e 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 }
4ad10a0b 303 sub EXISTS { print "# EXISTS [@_]\n"; exists $_[0]->[$_[1]]; }
304 sub DELETE { print "# DELETE [@_]\n"; delete $_[0]->[$_[1]]; }
4e4c362e 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';
be6c24e0 315 local($a[2]) = $a[2];
d441d3db 316 is($a[1], 'foo');
317 is($a[2], 'c');
4e4c362e 318 @a = ();
319}
d441d3db 320is($a[1], 'b');
321is($a[2], 'c');
322ok(!defined $a[0]);
d60c5a05 323{
324 my $d = "@a";
325 local @a = @a;
326 is("@a", $d);
327}
4e4c362e 328
4ad10a0b 329# local() should preserve the existenceness of tied array elements
330@a = ('a', 'b', 'c');
331{
332 local($a[4]) = 'x';
333 ok(!defined $a[3]);
334 is($a[4], 'x');
335}
336is(scalar(@a), 3);
337ok(!exists $a[3]);
338ok(!exists $a[4]);
339
340@a = ('a', 'b', 'c');
341{
342 local($a[5]) = 'z';
343 $a[4] = 'y';
344 ok(!defined $a[3]);
345 is($a[4], 'y');
346 is($a[5], 'z');
347}
348is(scalar(@a), 5);
349ok(!defined $a[3]);
350is($a[4], 'y');
351ok(!exists $a[5]);
352
353@a = ('a', 'b', 'c');
354{
355 local(@a[4,6]) = ('x', 'z');
356 ok(!defined $a[3]);
357 is($a[4], 'x');
358 ok(!defined $a[5]);
359 is($a[6], 'z');
360}
361is(scalar(@a), 3);
362ok(!exists $a[3]);
363ok(!exists $a[4]);
364ok(!exists $a[5]);
365ok(!exists $a[6]);
366
367@a = ('a', 'b', 'c');
368{
369 local(@a[4,6]) = ('x', 'z');
370 $a[5] = 'y';
371 ok(!defined $a[3]);
372 is($a[4], 'x');
373 is($a[5], 'y');
374 is($a[6], 'z');
375}
376is(scalar(@a), 6);
377ok(!defined $a[3]);
378ok(!defined $a[4]);
379is($a[5], 'y');
380ok(!exists $a[6]);
381
7332a6c4 382@a = ('a', 'b', 'c');
383$a[4] = 'd';
384{
385 delete local $a[1];
386 is(scalar(@a), 5);
387 is($a[0], 'a');
388 ok(!exists($a[1]));
389 is($a[2], 'c');
390 ok(!exists($a[3]));
391 is($a[4], 'd');
392
393 ok(!exists($a[888]));
394 delete local $a[888];
395 is(scalar(@a), 5);
396 ok(!exists($a[888]));
397
398 ok(!exists($a[999]));
399 my ($d, $zzz) = delete local @a[4, 999];
400 is(scalar(@a), 3);
401 ok(!exists($a[4]));
402 ok(!exists($a[999]));
403 is($d, 'd');
404 is($zzz, undef);
405
406 my $c = delete local $a[2];
407 is(scalar(@a), 1);
408 ok(!exists($a[2]));
409 is($c, 'c');
410
411 $a[888] = 'yyy';
412 $a[999] = 'zzz';
413}
414is(scalar(@a), 5);
415is($a[0], 'a');
416is($a[1], 'b');
417is($a[2], 'c');
418ok(!defined($a[3]));
419is($a[4], 'd');
420ok(!exists($a[5]));
421ok(!exists($a[888]));
422ok(!exists($a[999]));
423
4ad10a0b 424# see if localization works on tied hashes
4e4c362e 425{
426 package TH;
427 sub TIEHASH { bless {}, $_[0] }
428 sub STORE { print "# STORE [@_]\n"; $_[0]->{$_[1]} = $_[2] }
429 sub FETCH { my $v = $_[0]->{$_[1]}; print "# FETCH [@_=$v]\n"; $v }
c39e6ab0 430 sub EXISTS { print "# EXISTS [@_]\n"; exists $_[0]->{$_[1]}; }
4e4c362e 431 sub DELETE { print "# DELETE [@_]\n"; delete $_[0]->{$_[1]}; }
432 sub CLEAR { print "# CLEAR [@_]\n"; %{$_[0]} = (); }
d60c5a05 433 sub FIRSTKEY { print "# FIRSTKEY [@_]\n"; keys %{$_[0]}; each %{$_[0]} }
434 sub NEXTKEY { print "# NEXTKEY [@_]\n"; each %{$_[0]} }
4e4c362e 435}
436
4e4c362e 437tie %h, 'TH';
438%h = ('a' => 1, 'b' => 2, 'c' => 3);
439
440{
441 local($h{'a'}) = 'foo';
be6c24e0 442 local($h{'b'}) = $h{'b'};
159ad915 443 local($h{'y'});
444 local($h{'z'}) = 33;
d441d3db 445 is($h{'a'}, 'foo');
446 is($h{'b'}, 2);
4e4c362e 447 local($h{'c'});
448 delete $h{'c'};
449}
d441d3db 450is($h{'a'}, 1);
451is($h{'b'}, 2);
452is($h{'c'}, 3);
453# local() should preserve the existenceness of tied hash elements
454ok(! exists $h{'y'});
455ok(! exists $h{'z'});
d60c5a05 456TODO: {
457 todo_skip("Localize entire tied hash");
458 my $d = join("\n", map { "$_=>$h{$_}" } sort keys %h);
459 local %h = %h;
460 is(join("\n", map { "$_=>$h{$_}" } sort keys %h), $d);
461}
4e4c362e 462
7332a6c4 463%h = (a => 1, b => 2, c => 3, d => 4);
464{
465 delete local $h{b};
466 is(scalar(keys(%h)), 3);
467 is($h{a}, 1);
468 ok(!exists($h{b}));
469 is($h{c}, 3);
470 is($h{d}, 4);
471
472 ok(!exists($h{yyy}));
473 delete local $h{yyy};
474 is(scalar(keys(%h)), 3);
475 ok(!exists($h{yyy}));
476
477 ok(!exists($h{zzz}));
478 my ($d, $zzz) = delete local @h{qw/d zzz/};
479 is(scalar(keys(%h)), 2);
480 ok(!exists($h{d}));
481 ok(!exists($h{zzz}));
482 is($d, 4);
483 is($zzz, undef);
484
485 my $c = delete local $h{c};
486 is(scalar(keys(%h)), 1);
487 ok(!exists($h{c}));
488 is($c, 3);
489
490 $h{yyy} = 888;
491 $h{zzz} = 999;
492}
493is(scalar(keys(%h)), 4);
494is($h{a}, 1);
495is($h{b}, 2);
496is($h{c}, 3);
497ok($h{d}, 4);
498ok(!exists($h{yyy}));
499ok(!exists($h{zzz}));
500
4e4c362e 501@a = ('a', 'b', 'c');
502{
503 local($a[1]) = "X";
504 shift @a;
505}
d441d3db 506is($a[0].$a[1], "Xb");
4e4c362e 507
be6c24e0 508# now try the same for %SIG
509
510$SIG{TERM} = 'foo';
511$SIG{INT} = \&foo;
512$SIG{__WARN__} = $SIG{INT};
513{
514 local($SIG{TERM}) = $SIG{TERM};
515 local($SIG{INT}) = $SIG{INT};
516 local($SIG{__WARN__}) = $SIG{__WARN__};
d441d3db 517 is($SIG{TERM}, 'main::foo');
518 is($SIG{INT}, \&foo);
519 is($SIG{__WARN__}, \&foo);
be6c24e0 520 local($SIG{INT});
521 delete $SIG{__WARN__};
522}
d441d3db 523is($SIG{TERM}, 'main::foo');
524is($SIG{INT}, \&foo);
525is($SIG{__WARN__}, \&foo);
d60c5a05 526{
527 my $d = join("\n", map { "$_=>$SIG{$_}" } sort keys %SIG);
528 local %SIG = %SIG;
529 is(join("\n", map { "$_=>$SIG{$_}" } sort keys %SIG), $d);
530}
be6c24e0 531
532# and for %ENV
533
534$ENV{_X_} = 'a';
535$ENV{_Y_} = 'b';
536$ENV{_Z_} = 'c';
537{
159ad915 538 local($ENV{_A_});
539 local($ENV{_B_}) = 'foo';
be6c24e0 540 local($ENV{_X_}) = 'foo';
541 local($ENV{_Y_}) = $ENV{_Y_};
d441d3db 542 is($ENV{_X_}, 'foo');
543 is($ENV{_Y_}, 'b');
be6c24e0 544 local($ENV{_Z_});
545 delete $ENV{_Z_};
546}
d441d3db 547is($ENV{_X_}, 'a');
548is($ENV{_Y_}, 'b');
549is($ENV{_Z_}, 'c');
550# local() should preserve the existenceness of %ENV elements
551ok(! exists $ENV{_A_});
552ok(! exists $ENV{_B_});
13414bd5 553
554SKIP: {
555 skip("Can't make list assignment to \%ENV on this system")
556 unless $list_assignment_supported;
d60c5a05 557 my $d = join("\n", map { "$_=>$ENV{$_}" } sort keys %ENV);
558 local %ENV = %ENV;
559 is(join("\n", map { "$_=>$ENV{$_}" } sort keys %ENV), $d);
560}
be6c24e0 561
0214ae40 562# does implicit localization in foreach skip magic?
563
d441d3db 564$_ = "o 0,o 1,";
0214ae40 565my $iter = 0;
566while (/(o.+?),/gc) {
d441d3db 567 is($1, "o $iter");
0214ae40 568 foreach (1..1) { $iter++ }
d441d3db 569 if ($iter > 2) { fail("endless loop"); last; }
0214ae40 570}
571
572{
573 package UnderScore;
574 sub TIESCALAR { bless \my $self, shift }
575 sub FETCH { die "read \$_ forbidden" }
576 sub STORE { die "write \$_ forbidden" }
577 tie $_, __PACKAGE__;
0214ae40 578 my @tests = (
579 "Nesting" => sub { print '#'; for (1..3) { print }
580 print "\n" }, 1,
581 "Reading" => sub { print }, 0,
582 "Matching" => sub { $x = /badness/ }, 0,
583 "Concat" => sub { $_ .= "a" }, 0,
584 "Chop" => sub { chop }, 0,
585 "Filetest" => sub { -x }, 0,
586 "Assignment" => sub { $_ = "Bad" }, 0,
587 # XXX whether next one should fail is debatable
588 "Local \$_" => sub { local $_ = 'ok?'; print }, 0,
589 "for local" => sub { for("#ok?\n"){ print } }, 1,
590 );
591 while ( ($name, $code, $ok) = splice(@tests, 0, 3) ) {
0214ae40 592 eval { &$code };
d441d3db 593 main::ok(($ok xor $@), "Underscore '$name'");
0214ae40 594 }
595 untie $_;
596}
597
1f5346dc 598{
599 # BUG 20001205.22
600 my %x;
601 $x{a} = 1;
602 { local $x{b} = 1; }
d441d3db 603 ok(! exists $x{b});
1f5346dc 604 { local @x{c,d,e}; }
d441d3db 605 ok(! exists $x{c});
1f5346dc 606}
159ad915 607
33f3c7b8 608# local() and readonly magic variables
609
610eval { local $1 = 1 };
d441d3db 611like($@, qr/Modification of a read-only value attempted/);
33f3c7b8 612
613eval { for ($1) { local $_ = 1 } };
d441d3db 614like($@, qr/Modification of a read-only value attempted/);
33f3c7b8 615
0cbee0a4 616# make sure $1 is still read-only
33f3c7b8 617eval { for ($1) { local $_ = 1 } };
d441d3db 618like($@, qr/Modification of a read-only value attempted/);
ac117f44 619
620# The s/// adds 'g' magic to $_, but it should remain non-readonly
621eval { for("a") { for $x (1,2) { local $_="b"; s/(.*)/+$1/ } } };
d441d3db 622is($@, "");
4cb09e0a 623
503de470 624# RT #4342 Special local() behavior for $[
4cb09e0a 625{
626 local $[ = 1;
503de470 627 ok(1 == $[, 'lexcical scope of local $[');
4cb09e0a 628 f();
629}
630
631sub f { ok(0 == $[); }
632
985d6f61 633# sub localisation
634{
635 package Other;
636
637 sub f1 { "f1" }
638 sub f2 { "f2" }
639
640 no warnings "redefine";
641 {
642 local *f1 = sub { "g1" };
643 ::ok(f1() eq "g1", "localised sub via glob");
644 }
645 ::ok(f1() eq "f1", "localised sub restored");
646 {
647 local $Other::{"f1"} = sub { "h1" };
648 ::ok(f1() eq "h1", "localised sub via stash");
649 }
650 ::ok(f1() eq "f1", "localised sub restored");
651 {
652 local @Other::{qw/ f1 f2 /} = (sub { "j1" }, sub { "j2" });
985d6f61 653 ::ok(f1() eq "j1", "localised sub via stash slice");
654 ::ok(f2() eq "j2", "localised sub via stash slice");
985d6f61 655 }
656 ::ok(f1() eq "f1", "localised sub restored");
657 ::ok(f2() eq "f2", "localised sub restored");
658}
7d654f43 659
660# Localising unicode keys (bug #38815)
661{
662 my %h;
663 $h{"\243"} = "pound";
664 $h{"\302\240"} = "octects";
665 is(scalar keys %h, 2);
666 {
667 my $unicode = chr 256;
668 my $ambigous = "\240" . $unicode;
669 chop $ambigous;
670 local $h{$unicode} = 256;
671 local $h{$ambigous} = 160;
672
673 is(scalar keys %h, 4);
674 is($h{"\243"}, "pound");
675 is($h{$unicode}, 256);
676 is($h{$ambigous}, 160);
677 is($h{"\302\240"}, "octects");
678 }
679 is(scalar keys %h, 2);
680 is($h{"\243"}, "pound");
681 is($h{"\302\240"}, "octects");
682}
919acde0 683
684# And with slices
685{
686 my %h;
687 $h{"\243"} = "pound";
688 $h{"\302\240"} = "octects";
689 is(scalar keys %h, 2);
690 {
691 my $unicode = chr 256;
692 my $ambigous = "\240" . $unicode;
693 chop $ambigous;
694 local @h{$unicode, $ambigous} = (256, 160);
695
696 is(scalar keys %h, 4);
697 is($h{"\243"}, "pound");
698 is($h{$unicode}, 256);
699 is($h{$ambigous}, 160);
700 is($h{"\302\240"}, "octects");
701 }
702 is(scalar keys %h, 2);
703 is($h{"\243"}, "pound");
704 is($h{"\302\240"}, "octects");
705}
658aef79 706
707# [perl #39012] localizing @_ element then shifting frees element too # soon
708
709{
710 my $x;
711 my $y = bless [], 'X39012';
712 sub X39012::DESTROY { $x++ }
713 sub { local $_[0]; shift }->($y);
714 ok(!$x, '[perl #39012]');
715
716}
717
b2096149 718# when localising a hash element, the key should be copied, not referenced
719
720{
721 my %h=('k1' => 111);
722 my $k='k1';
723 {
724 local $h{$k}=222;
725
726 is($h{'k1'},222);
727 $k='k2';
728 }
729 ok(! exists($h{'k2'}));
730 is($h{'k1'},111);
731}
46c458a0 732{
733 my %h=('k1' => 111);
734 our $k = 'k1'; # try dynamic too
735 {
736 local $h{$k}=222;
737 is($h{'k1'},222);
738 $k='k2';
739 }
740 ok(! exists($h{'k2'}));
741 is($h{'k1'},111);
742}
72651472 743
07a28ea7 744like( runperl(stderr => 1,
745 prog => 'use constant foo => q(a);' .
746 'index(q(a), foo);' .
45f2a18c 747 'local *g=${::}{foo};print q(ok);'), "ok", "[perl #52740]");
07a28ea7 748
72651472 749# Keep this test last, as it can SEGV
750{
751 local *@;
752 pass("Localised *@");
753 eval {1};
754 pass("Can eval with *@ localised");
755}
756