From: David Mitchell <davem@iabyn.com>
Date: Tue, 4 May 2010 12:22:13 +0000 (+0100)
Subject: make local @tied, %tied, untied
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5afa72af5aa99c40932771ad390abf5ba229611b;p=p5sagit%2Fp5-mst-13.2.git

make local @tied, %tied, untied

Fix for RT #7938, #7939: when localising an array or hash, don't make the
new aggregate tied.

The old behaviour of { local @tied; ... } was equivalent to:

    {
	my $saved = \@tied;
	*tied = [];
	tied(@tied) = tied(@$saved)  # if tied() were an lvalue function
	...
	*tied = $saved;
    }

This patch simply removes the 'tied(@tied) = ...' step
---

diff --git a/mg.c b/mg.c
index 4be1b3c..ccb5b82 100644
--- a/mg.c
+++ b/mg.c
@@ -178,6 +178,7 @@ S_is_container_magic(const MAGIC *mg)
     case PERL_MAGIC_arylen_p:
     case PERL_MAGIC_rhash:
     case PERL_MAGIC_symtab:
+    case PERL_MAGIC_tied: /* treat as value, so 'local @tied' isn't tied */
 	return 0;
     default:
 	return 1;
diff --git a/t/op/local.t b/t/op/local.t
index db9912a..f664df4 100644
--- a/t/op/local.t
+++ b/t/op/local.t
@@ -5,7 +5,7 @@ BEGIN {
     @INC = qw(. ../lib);
     require './test.pl';
 }
-plan tests => 296;
+plan tests => 306;
 
 my $list_assignment_supported = 1;
 
@@ -325,6 +325,21 @@ ok(!defined $a[0]);
     local @a = @a;
     is("@a", $d);
 }
+# RT #7938: localising an array should make it temporarily untied
+{
+    @a = qw(a b c);
+    local @a = (6,7,8);
+    is("@a", "6 7 8", 'local @a assigned 6,7,8');
+    {
+	my $c = 0;
+	local *TA::STORE = sub { $c++ };
+	$a[0] = 9;
+	is($c, 0, 'STORE not called after array localised');
+    }
+    is("@a", "9 7 8", 'local @a should now be 9 7 8');
+}
+is("@a", "a b c", '@a should now contain original value');
+
 
 # local() should preserve the existenceness of tied array elements
 @a = ('a', 'b', 'c');
@@ -450,6 +465,7 @@ tie %h, 'TH';
 is($h{'a'}, 1);
 is($h{'b'}, 2);
 is($h{'c'}, 3);
+
 # local() should preserve the existenceness of tied hash elements
 ok(! exists $h{'y'});
 ok(! exists $h{'z'});
@@ -460,6 +476,24 @@ TODO: {
     is(join("\n", map { "$_=>$h{$_}" } sort keys %h), $d);
 }
 
+# RT #7939: localising a hash should make it temporarily untied
+{
+    %h = qw(a 1 b 2 c 3);
+    local %h = qw(x 6 y 7 z 8);
+    is(join('', sort keys   %h), "xyz", 'local %h has new keys');
+    is(join('', sort values %h), "678", 'local %h has new values');
+    {
+	my $c = 0;
+	local *TH::STORE = sub { $c++ };
+	$h{x} = 9;
+	is($c, 0, 'STORE not called after hash localised');
+    }
+    is($h{x}, 9, '$h{x} should now be 9');
+}
+is(join('', sort keys   %h), "abc", 'restored %h has original keys');
+is(join('', sort values %h), "123", 'restored %h has original values');
+
+
 %h = (a => 1, b => 2, c => 3, d => 4);
 {
     delete local $h{b};