add CVf_CVGV_RC flag

after the recent commit 803f274831f937654d48f8cf0468521cbf8f5dff,
the CvGV field is sometimes reference counted. Since it was intended that
the reference counting would happen only for anonymous CVs, the CVf_ANON
flag was co-opted to indicate whether RC was being used. This is not
entirely robust; for example, sub __ANON__ {} is a non-anon sub which
points to the same GV used by anon subs, which while itself doesn't
directly break things, shows that the potential for breakage is there.

So add a separate flag just to indicate the reference count status of the
CvGV field.

7 files changed, 28 insertions, 15 deletions

diff --git a/cv.h b/cv.h
index fe96aa3e3a..d762a062cf 100644
--- a/cv.h
+++ b/cv.h
@@ -70,14 +70,12 @@ Returns the stash of the CV.
 #define CVf_WEAKOUTSIDE	0x0010  /* CvOUTSIDE isn't ref counted */
 #define CVf_CLONE	0x0020	/* anon CV uses external lexicals */
 #define CVf_CLONED	0x0040	/* a clone of one of those */
-#define CVf_ANON	0x0080	/* implies: CV is not pointed to by a GV,
-				            CvGV is refcounted, and
-					    points to an __ANON__ GV;
-				   at compile time only, also implies sub {} */
+#define CVf_ANON	0x0080	/* CV is not pointed to by a GV */
 #define CVf_UNIQUE	0x0100	/* sub is only called once (eg PL_main_cv,
 				 * require, eval). */
 #define CVf_NODEBUG	0x0200	/* no DB::sub indirection for this CV
 				   (esp. useful for special XSUBs) */
+#define CVf_CVGV_RC	0x0400	/* CvGV is reference counted */
 
 /* This symbol for optimised communication between toke.c and op.c: */
 #define CVf_BUILTIN_ATTRS	(CVf_METHOD|CVf_LVALUE)
@@ -131,6 +129,10 @@ Returns the stash of the CV.
 #define CvISXSUB_on(cv)		(CvFLAGS(cv) |= CVf_ISXSUB)
 #define CvISXSUB_off(cv)	(CvFLAGS(cv) &= ~CVf_ISXSUB)
 
+#define CvCVGV_RC(cv)		(CvFLAGS(cv) & CVf_CVGV_RC)
+#define CvCVGV_RC_on(cv)	(CvFLAGS(cv) |= CVf_CVGV_RC)
+#define CvCVGV_RC_off(cv)	(CvFLAGS(cv) &= ~CVf_CVGV_RC)
+
 /* Flags for newXS_flags  */
 #define XS_DYNAMIC_FILENAME	0x01	/* The filename isn't static  */
 
diff --git a/dump.c b/dump.c
index 120c9b4897..843eb88ec5 100644
--- a/dump.c
+++ b/dump.c
@@ -1499,7 +1499,8 @@ const struct flag_to_name cv_flags_names[] = {
     {CVf_NODEBUG, "NODEBUG,"},
     {CVf_LVALUE, "LVALUE,"},
     {CVf_METHOD, "METHOD,"},
-    {CVf_WEAKOUTSIDE, "WEAKOUTSIDE,"}
+    {CVf_WEAKOUTSIDE, "WEAKOUTSIDE,"},
+    {CVf_CVGV_RC, "CVGV_RC,"}
 };
 
 const struct flag_to_name hv_flags_names[] = {
diff --git a/ext/Devel-Peek/t/Peek.t b/ext/Devel-Peek/t/Peek.t
index 3c90f6e77b..1fb1a5d5d8 100644
--- a/ext/Devel-Peek/t/Peek.t
+++ b/ext/Devel-Peek/t/Peek.t
@@ -261,7 +261,7 @@ do_test(13,
   RV = $ADDR
   SV = PVCV\\($ADDR\\) at $ADDR
     REFCNT = 2
-    FLAGS = \\($PADMY,POK,pPOK,ANON,WEAKOUTSIDE\\)
+    FLAGS = \\($PADMY,POK,pPOK,ANON,WEAKOUTSIDE,CVGV_RC\\)
     IV = 0					# $] < 5.009
     NV = 0					# $] < 5.009
     PROTOTYPE = ""
@@ -276,7 +276,7 @@ do_test(13,
     MUTEXP = $ADDR
     OWNER = $ADDR)?
     FLAGS = 0x404				# $] < 5.009
-    FLAGS = 0x90				# $] >= 5.009
+    FLAGS = 0x490				# $] >= 5.009
     OUTSIDE_SEQ = \\d+
     PADLIST = $ADDR
     PADNAME = $ADDR\\($ADDR\\) PAD = $ADDR\\($ADDR\\)
diff --git a/gv.c b/gv.c
index 47648639cc..9eaf76c240 100644
--- a/gv.c
+++ b/gv.c
@@ -206,10 +206,11 @@ Perl_cvgv_set(pTHX_ CV* cv, GV* gv)
 	return;
 
     if (oldgv) {
-	if (CvANON(cv))
+	if (CvCVGV_RC(cv)) {
 	    SvREFCNT_dec(oldgv);
+	    CvCVGV_RC_off(cv);
+	}
 	else {
-	    assert(strNE(GvNAME(oldgv),"__ANON__"));
 	    sv_del_backref(MUTABLE_SV(oldgv), MUTABLE_SV(cv));
 	}
     }
@@ -220,11 +221,10 @@ Perl_cvgv_set(pTHX_ CV* cv, GV* gv)
 	return;
 
     if (CvANON(cv)) {
-	assert(strnEQ(GvNAME(gv),"__ANON__", 8));
+	CvCVGV_RC_on(cv);
 	SvREFCNT_inc_simple_void_NN(gv);
     }
     else {
-	assert(strNE(GvNAME(gv),"__ANON__"));
 	Perl_sv_add_backref(aTHX_ MUTABLE_SV(gv), MUTABLE_SV(cv));
     }
 }
diff --git a/op.c b/op.c
index e5f9604521..3ae15cb874 100644
--- a/op.c
+++ b/op.c
@@ -5476,9 +5476,9 @@ Perl_cv_undef(pTHX_ CV *cv)
     if (CvISXSUB(cv) && CvXSUB(cv)) {
 	CvXSUB(cv) = NULL;
     }
-    /* delete all flags except WEAKOUTSIDE and ANON, which indicate the
+    /* delete all flags except WEAKOUTSIDE and CVGV_RC, which indicate the
      * ref status of CvOUTSIDE and CvGV */
-    CvFLAGS(cv) &= (CVf_WEAKOUTSIDE|CVf_ANON);
+    CvFLAGS(cv) &= (CVf_WEAKOUTSIDE|CVf_CVGV_RC);
 }
 
 void
diff --git a/sv.c b/sv.c
index f555fc15ac..1e756f2420 100644
--- a/sv.c
+++ b/sv.c
@@ -5687,6 +5687,7 @@ S_anonymise_cv_maybe(pTHX_ GV *gv, CV* cv)
     SvREFCNT_dec(gvname);
 
     CvANON_on(cv);
+    CvCVGV_RC_on(cv);
     CvGV(cv) = MUTABLE_GV(SvREFCNT_inc(anongv));
 }
 
@@ -11438,7 +11439,7 @@ S_sv_dup_common(pTHX_ const SV *const sstr, CLONE_PARAMS *const param)
 		/* don't dup if copying back - CvGV isn't refcounted, so the
 		 * duped GV may never be freed. A bit of a hack! DAPM */
 		CvGV(dstr) =
-		    CvANON(dstr)
+		    CvCVGV_RC(dstr)
 		    ? gv_dup_inc(CvGV(sstr), param)
 		    : (param->flags & CLONEf_JOIN_IN)
 			? NULL
diff --git a/t/op/stash.t b/t/op/stash.t
index 81ca233b42..2c17022b26 100644
--- a/t/op/stash.t
+++ b/t/op/stash.t
@@ -7,7 +7,7 @@ BEGIN {
 
 BEGIN { require "./test.pl"; }
 
-plan( tests => 37 );
+plan( tests => 38 );
 
 # Used to segfault (bug #15479)
 fresh_perl_like(
@@ -200,3 +200,12 @@ SKIP: {
 	is($gv->NAME, '__ANON__', "anon CV has anon GV");
     }
 }
+
+# make sure having a sub called __ANON__ doesn't confuse perl.
+
+{
+    my $c;
+    sub __ANON__ { $c = (caller(0))[3]; }
+    __ANON__();
+    is ($c, 'main::__ANON__', '__ANON__ sub called ok');
+}