Fix double free with stashes blessed into each other

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).

1 files changed, 5 insertions, 1 deletions

diff --git a/sv.c b/sv.c
index e87d80a32b..cf4d742e9f 100644
--- 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 */
     }