Fix double free with stashes blessed into each other
authorFather Chrysostomos <sprout@cpan.org>
Wed, 21 Nov 2012 16:48:41 +0000 (08:48 -0800)
committerFather Chrysostomos <sprout@cpan.org>
Wed, 21 Nov 2012 16:48:41 +0000 (08:48 -0800)
When I added that extra pass in 5.16 that curses any remaining blessed
objects during global destruction, I caused this bug:

$ ./miniperl -e 'warn bless \%foo::, bar::; warn bless \%bar::, foo::'
bar=HASH(0x827260) at -e line 1.
foo=HASH(0x8272b0) at -e line 1.
Attempt to free unreferenced scalar: SV 0x8272b0, Perl interpreter: 0x800000 during global destruction.

By creating a circularity between stashes, with no RVs remaining, we
cause one of the two stashes, say foo, to be cursed during global
destruction.  That causes it to lower the remaining reference count
on bar, which, when freed, lowers its reference count on foo, which
then tries to lower its reference count on bar, which has already
been freed.

The solution here is to turn off the object flag before decrementing
the stash’s reference count.  So a recursive call won’t try to curse
the already accursed object.

Turning off the flag makes SvSTASH into a DESTROY cache.  That won’t
work if the SvREFCNT_dec call tries to access that cache.  So we have
to null the field before calling SvREFCNT_dec (which we should be
doing anyway).

sv.c
t/op/ref.t

diff --git a/sv.c b/sv.c
index e87d80a..cf4d742 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -6399,8 +6399,12 @@ S_curse(pTHX_ SV * const sv, const bool check_refcnt) {
     }
 
     if (SvOBJECT(sv)) {
-       SvREFCNT_dec(SvSTASH(sv)); /* possibly of changed persuasion */
+       HV * const stash = SvSTASH(sv);
+       /* Curse before freeing the stash, as freeing the stash could cause
+          a recursive call into S_curse. */
        SvOBJECT_off(sv);       /* Curse the object. */
+       SvSTASH_set(sv,0);      /* SvREFCNT_dec may try to read this */
+       SvREFCNT_dec(stash); /* possibly of changed persuasion */
        if (SvTYPE(sv) != SVt_PVIO)
            --PL_sv_objcount;/* XXX Might want something more general */
     }
index a568d88..8390f19 100644 (file)
@@ -8,7 +8,7 @@ BEGIN {
 
 use strict qw(refs subs);
 
-plan(229);
+plan(230);
 
 # Test glob operations.
 
@@ -408,6 +408,13 @@ is(
  'DESTROY called on closure variable'
 );
 
+# But cursing objects must not result in double frees
+# This caused "Attempt to free unreferenced scalar" in 5.16.
+fresh_perl_is(
+  'bless \%foo::, bar::; bless \%bar::, foo::; print "ok\n"', "ok\n",
+   { stderr => 1 },
+  'no double free when stashes are blessed into each other');
+
 
 # test if refgen behaves with autoviv magic
 {