Fix memory leak with recursive sub redefinition

See the thread starting at
<20131115042923.7514.qmail@lists-nntp.develooper.com>.

Commits 7004ee4937 and a61818571 changed subroutine redefinition to
null the GvCV slot before freeing the CV, so that destructors won’t
see GvCV without a reference count.  That turns a double free into a
memory leak.

Kent Fredric explains it nice and clearly:

> sub foo{}   # A
> bless \&foo;
> DESTROY { *foo = sub {}  # C }
> eval "sub foo{} "; # B
>
> Previous behaviour was:
>
> B replaces A, triggers DESTROY, which triggers C replacing A, and this
> invoked a double free, because C , triggering the removal of A,
> happened while A still existed ( ?? )
>
> So the change fixes this, so that A is removed from the symbol table
> before DESTROY triggers , so that C is creating a "new" symbol,
> effectively, and the problem is that C is then clobbered by the B
> replacing the slot, after the DESTROY.

So C leaks.

This commit fixes it by changing the SvREFCNT_dec into SAVEFREESV,
essentially delaying the DESTROY until after the subroutine redefini-
tion is complete.

This does mean that C is what ends up in the glob afterwards; but as
long as perl’s own bookkeeping is thrown off, we can leave it to the
user (the Perl programmer) to handle the consequences of naughty
destructors.

1 files changed, 6 insertions, 4 deletions

diff --git a/op.c b/op.c
index 09af08a2f0..3355a65e20 100644
--- a/op.c
+++ b/op.c
@@ -7249,8 +7249,7 @@ S_already_defined(pTHX_ CV *const cv, OP * const block, OP * const o,
 #endif
     {
 	/* (PL_madskills unset in used file.) */
-	if (gv) GvCV_set(gv,NULL);
-	SvREFCNT_dec(cv);
+	SAVEFREESV(cv);
     }
     return TRUE;
 }
@@ -8115,6 +8114,7 @@ Perl_newXS_len_flags(pTHX_ const char *name, STRLEN len,
 			   U32 flags)
 {
     CV *cv;
+    bool interleave = FALSE;
 
     PERL_ARGS_ASSERT_NEWXS_LEN_FLAGS;
 
@@ -8144,8 +8144,9 @@ Perl_newXS_len_flags(pTHX_ const char *name, STRLEN len,
                                         ),
                                         cv, const_svp);
                 }
-                GvCV_set(gv,NULL);
-                SvREFCNT_dec_NN(cv);
+                interleave = TRUE;
+                ENTER;
+                SAVEFREESV(cv);
                 cv = NULL;
             }
         }
@@ -8180,6 +8181,7 @@ Perl_newXS_len_flags(pTHX_ const char *name, STRLEN len,
 	CvDYNFILE_on(cv);
     }
     sv_setpv(MUTABLE_SV(cv), proto);
+    if (interleave) LEAVE;
     return cv;
 }