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.

diff --git a/cv.h b/cv.h
index fe96aa3..d762a06 100644 (file)
--- 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 120c9b4..843eb88 100644 (file)
--- 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 3c90f6e..1fb1a5d 100644 (file)
--- 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 4764863..9eaf76c 100644 (file)
--- 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 e5f9604..3ae15cb 100644 (file)
--- 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 f555fc1..1e756f2 100644 (file)
--- 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 81ca233..2c17022 100644 (file)
--- 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');
+}