X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fop%2Flocal.t;h=28613e7a13598d9be2e325bfa5c59387f88b53d7;hb=076d9a11d18d650bf0992032a42c6e83fb1c2ea6;hp=b478e01993f050b36aab0f2758ae5747aff0cd1f;hpb=0214ae4041a6e53bb2f19e015bac063436f2df70;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/t/op/local.t b/t/op/local.t
index b478e01..28613e7 100755
--- a/t/op/local.t
+++ b/t/op/local.t
@@ -1,9 +1,6 @@
 #!./perl
 
-print "1..69\n";
-
-# XXX known to leak scalars
-$ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3;
+print "1..79\n";
 
 sub foo {
     local($a, $b) = @_;
@@ -48,10 +45,10 @@ print $a,@b,@c,%d,$x,$y;
 eval 'local($$e)';
 print +($@ =~ /Can't localize through a reference/) ? "" : "not ", "ok 21\n";
 
-eval 'local(@$e)';
+eval '$e = []; local(@$e)';
 print +($@ =~ /Can't localize through a reference/) ? "" : "not ", "ok 22\n";
 
-eval 'local(%$e)';
+eval '$e = {}; local(%$e)';
 print +($@ =~ /Can't localize through a reference/) ? "" : "not ", "ok 23\n";
 
 # Array and hash elements
@@ -133,6 +130,7 @@ print +(!defined $a[0]) ? "" : "not ", "ok 41\n";
     sub TIEHASH { bless {}, $_[0] }
     sub STORE { print "# STORE [@_]\n"; $_[0]->{$_[1]} = $_[2] }
     sub FETCH { my $v = $_[0]->{$_[1]}; print "# FETCH [@_=$v]\n"; $v }
+    sub EXISTS { print "# EXISTS [@_]\n"; exists $_[0]->{$_[1]}; }
     sub DELETE { print "# DELETE [@_]\n"; delete $_[0]->{$_[1]}; }
     sub CLEAR { print "# CLEAR [@_]\n"; %{$_[0]} = (); }
 }
@@ -144,6 +142,8 @@ tie %h, 'TH';
 {
     local($h{'a'}) = 'foo';
     local($h{'b'}) = $h{'b'};
+    local($h{'y'});
+    local($h{'z'}) = 33;
     print +($h{'a'} eq 'foo') ? "" : "not ", "ok 42\n";
     print +($h{'b'} == 2) ? "" : "not ", "ok 43\n";
     local($h{'c'});
@@ -185,6 +185,8 @@ $ENV{_X_} = 'a';
 $ENV{_Y_} = 'b';
 $ENV{_Z_} = 'c';
 {
+    local($ENV{_A_});
+    local($ENV{_B_}) = 'foo';
     local($ENV{_X_}) = 'foo';
     local($ENV{_Y_}) = $ENV{_Y_};
     print +($ENV{_X_} eq 'foo') ? "" : "not ", "ok 54\n";
@@ -235,3 +237,42 @@ while (/(o.+?),/gc) {
     untie $_;
 }
 
+{
+    # BUG 20001205.22
+    my %x;
+    $x{a} = 1;
+    { local $x{b} = 1; }
+    print "not " if exists $x{b};
+    print "ok 70\n";
+    { local @x{c,d,e}; }
+    print "not " if exists $x{c};
+    print "ok 71\n"; 
+}
+
+# these tests should be physically located after tests 46 and 58,
+# but are here instead to avoid renumbering everything. 
+
+# local() should preserve the existenceness of tied hashes and %ENV
+print "not " if exists $h{'y'}; print "ok 72\n";
+print "not " if exists $h{'z'}; print "ok 73\n";
+print "not " if exists $ENV{_A_}; print "ok 74\n";
+print "not " if exists $ENV{_B_}; print "ok 75\n";
+
+# local() and readonly magic variables
+
+eval { local $1 = 1 };
+print "not " if $@ !~ /Modification of a read-only value attempted/;
+print "ok 76\n";
+
+eval { for ($1) { local $_ = 1 } };
+print "not " if $@ !~ /Modification of a read-only value attempted/;
+print "ok 77\n";
+
+eval { for ($1) { local $_ = 1 } };
+print "not " if $@;
+print "ok 78\n";
+
+# The s/// adds 'g' magic to $_, but it should remain non-readonly
+eval { for("a") { for $x (1,2) { local $_="b"; s/(.*)/+$1/ } } };
+print "not " if $@;
+print "ok 79\n";