Fix CvOUTSIDE assert/refcnt bugs with sub redefinition

my $sub = sub { 4 };
*foo = $sub;
*bar = *foo;
undef &$sub;
eval "sub bar { 3 }";
undef *foo;
undef *bar;

As of 5.8.4, this script produces:

Attempt to free unreferenced scalar: SV 0x8002c4.

As of 5.14.0:

panic: del_backref.

Or, undef debugging builds:

Assertion failed: (!CvWEAKOUTSIDE(cv)), function Perl_newATTRSUB_flags, file op.c, line 7045.

Commit 5c41a5f (backported to 5.8.4 in commit 7a565e5) caused the
first bug:

commit 5c41a5f
Author: Dave Mitchell <[email protected]>
Date:   Sun Jan 25 02:04:23 2004 +0000

    Remove small memory leak in newATTRSUB that manifested as a
    leaking scalar after the interpeter was cloned

    p4raw-id: //depot/perl@22209

diff --git a/op.c b/op.c
index b902fed..5fd21bf 100644
--- a/op.c
+++ b/op.c
@@ -4165,6 +4165,8 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 	/* transfer PL_compcv to cv */
 	cv_undef(cv);
 	CvFLAGS(cv) = CvFLAGS(PL_compcv);
+	if (!CvWEAKOUTSIDE(cv))
+	    SvREFCNT_dec(CvOUTSIDE(cv));
 	CvOUTSIDE(cv) = CvOUTSIDE(PL_compcv);
 	CvOUTSIDE_SEQ(cv) = CvOUTSIDE_SEQ(PL_compcv);
 	CvOUTSIDE(PL_compcv) = 0;

Checking the flags right after clobbering them can’t be a good idea.

Commit 437388a caused the panics and assertion failures.  See com-
mit f6894bc for detail.

Commit f6894bc fixed the panics and assertion failures involving CvGV.

One remaining assertion (!CvWEAKOUTSIDE) added by 437388a is still
incorrect.  It’s not true that CvWEAKOUTSIDE is never set on a re-
used stub.

In both cases (5c41a5f’s code and 437388a’s code), the weakness
of CvOUTSIDE is ignored and the outside sub (the eval) is freed
prematurely.

It could be that this type of redefinition should be disallowed (des-
pite its usefulness), but that is a separate issue.  This used to
work.  And pure-Perl code should not be triggering assertion failures
or freeing scalars twice.

Author: Father Chrysostomos

op.c

@@ -7039,11 +7039,10 @@ Perl_newATTRSUB_flags(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
 	    cv_flags_t existing_builtin_attrs = CvFLAGS(cv) & CVf_BUILTIN_ATTRS;
 	    AV *const temp_av = CvPADLIST(cv);
 	    CV *const temp_cv = CvOUTSIDE(cv);
-	    const cv_flags_t slabbed = CvSLABBED(cv);
+	    const cv_flags_t other_flags =
+		CvFLAGS(cv) & (CVf_SLABBED|CVf_WEAKOUTSIDE);
 	    OP * const cvstart = CvSTART(cv);
 
-	    assert(!CvWEAKOUTSIDE(cv));
-
 	    CvGV_set(cv,gv);
 	    assert(!CvCVGV_RC(cv));
 	    assert(CvGV(cv) == gv);
@@ -7057,8 +7056,8 @@ Perl_newATTRSUB_flags(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
 	    CvPADLIST(PL_compcv) = temp_av;
 	    CvSTART(cv) = CvSTART(PL_compcv);
 	    CvSTART(PL_compcv) = cvstart;
-	    if (slabbed) CvSLABBED_on(PL_compcv);
-	    else CvSLABBED_off(PL_compcv);
+	    CvFLAGS(PL_compcv) &= ~(CVf_SLABBED|CVf_WEAKOUTSIDE);
+	    CvFLAGS(PL_compcv) |= other_flags;
 
 	    if (CvFILE(cv) && CvDYNFILE(cv)) {
 		Safefree(CvFILE(cv));

t/op/sub.t

@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan( tests => 15 );
+plan( tests => 16 );
 
 sub empty_sub {}
 
@@ -72,3 +72,16 @@ fresh_perl_is
 eval 'sub bar { print +(caller 0)[3], "\n" }';
 bar();
 end
+
+fresh_perl_is
+  <<'end', "main::foo\nok\n", {}, 'no double free redefining anon stub';
+my $sub = sub { 4 };
+*foo = $sub;
+*bar = *foo;
+undef &$sub;
+eval 'sub bar { print +(caller 0)[3], "\n" }';
+&$sub;
+undef *foo;
+undef *bar;
+print "ok\n";
+end