This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Hide pad vars from magic methods on scope exit
authorFather Chrysostomos <sprout@cpan.org>
Sat, 5 Nov 2011 21:38:21 +0000 (14:38 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Sat, 5 Nov 2011 21:42:54 +0000 (14:42 -0700)
If, during scope exit, a pad var is being cleared for reuse, it needs
to be hidden from magic methods that might reference it through weak
references.  Otherwise they can end up modifying the var that will be
seen next time that scope is entered, by blessing it, etc.

scope.c
t/op/tie.t

diff --git a/scope.c b/scope.c
index d4615d1..f14be1e 100644 (file)
--- a/scope.c
+++ b/scope.c
@@ -901,7 +901,10 @@ Perl_leave_scope(pTHX_ I32 base)
 
                if (SvTHINKFIRST(sv))
                    sv_force_normal_flags(sv, SV_IMMEDIATE_UNREF);
+               if (SvTYPE(sv) == SVt_PVHV)
+                   Perl_hv_kill_backrefs(aTHX_ MUTABLE_HV(sv));
                if (SvMAGICAL(sv))
+                   sv_unmagic(sv, PERL_MAGIC_backref),
                    mg_free(sv);
 
                switch (SvTYPE(sv)) {
@@ -911,7 +914,6 @@ Perl_leave_scope(pTHX_ I32 base)
                    av_clear(MUTABLE_AV(sv));
                    break;
                case SVt_PVHV:
-                   Perl_hv_kill_backrefs(aTHX_ MUTABLE_HV(sv));
                    hv_clear(MUTABLE_HV(sv));
                    break;
                case SVt_PVCV:
index 3d4eb20..9f71dc4 100644 (file)
@@ -1110,3 +1110,57 @@ $x = *bar;
 print &{\&$x}, "\n";
 EXPECT
 73
+########
+
+# Lexicals should not be visible to magic methods on scope exit
+BEGIN { unless (defined &DynaLoader::boot_DynaLoader) {
+    print "HASH\nHASH\nARRAY\nARRAY\n"; exit;
+}}
+use Scalar::Util 'weaken';
+{ package xoufghd;
+  sub TIEHASH { Scalar::Util::weaken($_[1]); bless \$_[1], xoufghd:: }
+  *TIEARRAY = *TIEHASH;
+  DESTROY {
+     bless ${$_[0]} || return, 0;
+} }
+for my $sub (
+    # hashes: ties before backrefs
+    sub {
+        my %hash;
+        $ref = ref \%hash;
+        tie %hash, xoufghd::, \%hash;
+        1;
+    },
+    # hashes: backrefs before ties
+    sub {
+        my %hash;
+        $ref = ref \%hash;
+        weaken(my $x = \%hash);
+        tie %hash, xoufghd::, \%hash;
+        1;
+    },
+    # arrayes: ties before backrefs
+    sub {
+        my @array;
+        $ref = ref \@array;
+        tie @array, xoufghd::, \@array;
+        1;
+    },
+    # arrayes: backrefs before ties
+    sub {
+        my @array;
+        $ref = ref \@array;
+        weaken(my $x = \@array);
+        tie @array, xoufghd::, \@array;
+        1;
+    },
+) {
+    &$sub;
+    &$sub;
+    print $ref, "\n";
+}
+EXPECT
+HASH
+HASH
+ARRAY
+ARRAY