Fix [perl #66970] Incorrect coderef in MODIFY_CODE_ATTRIBUTES

Attribute handlers being applied to a temporary CV has actually been
reported as a bug, #66970.  The attached patch fixes the bug, by
changing the order in which things happen: attributes are now applied
after the temporary CV has been merged into the existing CV or has
otherwise been added to the appropriate GV.

The change breaks part of Attribute::Handlers.  Part of A:H searches the
package to find the name of the sub to which a :ATTR attribute is being
applied, and the correct time at which to launch that search depends
crucially on the order in which the CV construction events occur. So
this patch also includes a change to A:H, to make it detect which way
things happen.  The resulting A:H works either way, which is essential
for its dual-life nature.

1 files changed, 30 insertions, 58 deletions

diff --git a/op.c b/op.c
index db5dea89c1..c6f38fa2f3 100644
--- a/op.c
+++ b/op.c
@@ -5692,69 +5692,34 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 	PL_compcv = NULL;
 	goto done;
     }
-    if (attrs) {
-	HV *stash;
-	SV *rcv;
-
-	/* Need to do a C<use attributes $stash_of_cv,\&cv,@attrs>
-	 * before we clobber PL_compcv.
-	 */
-	if (cv && (!block
+    if (cv) {				/* must reuse cv if autoloaded */
+	/* transfer PL_compcv to cv */
+	if (block
 #ifdef PERL_MAD
-		    || block->op_type == OP_NULL
+                  && block->op_type != OP_NULL
 #endif
-		    )) {
-	    rcv = MUTABLE_SV(cv);
-	    /* Might have had built-in attributes applied -- propagate them. */
-	    CvFLAGS(cv) |= (CvFLAGS(PL_compcv) & CVf_BUILTIN_ATTRS);
-	    if (CvGV(cv) && GvSTASH(CvGV(cv)))
-		stash = GvSTASH(CvGV(cv));
-	    else if (CvSTASH(cv))
-		stash = CvSTASH(cv);
-	    else
-		stash = PL_curstash;
+	) {
+	    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;
+	    CvPADLIST(cv) = CvPADLIST(PL_compcv);
+	    CvPADLIST(PL_compcv) = 0;
+	    /* inner references to PL_compcv must be fixed up ... */
+	    pad_fixup_inner_anons(CvPADLIST(cv), PL_compcv, cv);
+	    if (PERLDB_INTER)/* Advice debugger on the new sub. */
+	      ++PL_sub_generation;
 	}
 	else {
-	    /* possibly about to re-define existing subr -- ignore old cv */
-	    rcv = MUTABLE_SV(PL_compcv);
-	    if (name && GvSTASH(gv))
-		stash = GvSTASH(gv);
-	    else
-		stash = PL_curstash;
-	}
-	apply_attrs(stash, rcv, attrs, FALSE);
-    }
-    if (cv) {				/* must reuse cv if autoloaded */
-	if (
-#ifdef PERL_MAD
-	    (
-#endif
-	     !block
-#ifdef PERL_MAD
-	     || block->op_type == OP_NULL) && !PL_madskills
-#endif
-	     ) {
-	    /* got here with just attrs -- work done, so bug out */
-	    SAVEFREESV(PL_compcv);
-	    goto done;
+	    /* Might have had built-in attributes applied -- propagate them. */
+	    CvFLAGS(cv) |= (CvFLAGS(PL_compcv) & CVf_BUILTIN_ATTRS);
 	}
-	/* 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;
-	CvPADLIST(cv) = CvPADLIST(PL_compcv);
-	CvPADLIST(PL_compcv) = 0;
-	/* inner references to PL_compcv must be fixed up ... */
-	pad_fixup_inner_anons(CvPADLIST(cv), PL_compcv, cv);
 	/* ... before we throw it away */
 	SvREFCNT_dec(PL_compcv);
 	PL_compcv = cv;
-	if (PERLDB_INTER)/* Advice debugger on the new sub. */
-	  ++PL_sub_generation;
     }
     else {
 	cv = PL_compcv;
@@ -5770,9 +5735,16 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
             mro_method_changed_in(GvSTASH(gv)); /* sub Foo::bar { (shift)+1 } */
 	}
     }
-    CvGV(cv) = gv;
-    CvFILE_set_from_cop(cv, PL_curcop);
-    CvSTASH(cv) = PL_curstash;
+    if (!CvGV(cv)) {
+	CvGV(cv) = gv;
+	CvFILE_set_from_cop(cv, PL_curcop);
+	CvSTASH(cv) = PL_curstash;
+    }
+    if (attrs) {
+	/* Need to do a C<use attributes $stash_of_cv,\&cv,@attrs>. */
+	HV *stash = name && GvSTASH(CvGV(cv)) ? GvSTASH(CvGV(cv)) : PL_curstash;
+	apply_attrs(stash, MUTABLE_SV(cv), attrs, FALSE);
+    }
 
     if (ps)
 	sv_setpvn(MUTABLE_SV(cv), ps, ps_len);