Split out the use of SVp_SCREAM for GVs with GPs into a new symbolic
authorNicholas Clark <nick@ccl4.org>
Sat, 16 Dec 2006 16:54:06 +0000 (16:54 +0000)
committerNicholas Clark <nick@ccl4.org>
Sat, 16 Dec 2006 16:54:06 +0000 (16:54 +0000)
flag SVpgv_GP, and use this in isGV_with_GP_on/off.

p4raw-id: //depot/perl@29565

dump.c
ext/Devel/Peek/t/Peek.t
gv.c
mg.c
sv.c
sv.h

diff --git a/dump.c b/dump.c
index fad5060..4622fb9 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -1385,7 +1385,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
     if (flags & SVp_IOK)       sv_catpv(d, "pIOK,");
     if (flags & SVp_NOK)       sv_catpv(d, "pNOK,");
     if (flags & SVp_POK)       sv_catpv(d, "pPOK,");
-    if (flags & SVp_SCREAM && type != SVt_PVHV)
+    if (flags & SVp_SCREAM && type != SVt_PVHV && !isGV_with_GP(sv))
                                sv_catpv(d, "SCREAM,");
 
     switch (type) {
index 57e84d7..ed622fd 100644 (file)
@@ -305,7 +305,7 @@ do_test(17,
        *a,
 'SV = PVGV\\($ADDR\\) at $ADDR
   REFCNT = 5
-  FLAGS = \\(SCREAM,MULTI(?:,IN_PAD)?\\)
+  FLAGS = \\(MULTI(?:,IN_PAD)?\\)
   NAME = "a"
   NAMELEN = 1
   GvSTASH = $ADDR\\t"main"
diff --git a/gv.c b/gv.c
index 29d2f60..fc22aeb 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -224,7 +224,8 @@ Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi)
        } else
            Safefree(SvPVX_mutable(gv));
     }
-    SvSCREAM_on(gv);
+    SvIOK_off(gv);
+    isGV_with_GP_on(gv);
 
     GvGP(gv) = Perl_newGP(aTHX_ gv);
     GvSTASH(gv) = stash;
@@ -234,7 +235,6 @@ Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi)
     if (multi || doproto)              /* doproto means it _was_ mentioned */
        GvMULTI_on(gv);
     if (doproto) {                     /* Replicate part of newSUB here. */
-       SvIOK_off(gv);
        ENTER;
        if (has_constant) {
            /* newCONSTSUB takes ownership of the reference from us.  */
diff --git a/mg.c b/mg.c
index 39117e2..b0af1c8 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -1897,8 +1897,7 @@ Perl_magic_setglob(pTHX_ SV *sv, MAGIC *mg)
 
     if (!SvOK(sv))
        return 0;
-    if (SvFLAGS(sv) & SVp_SCREAM
-       && (SvTYPE(sv) == SVt_PVGV || SvTYPE(sv) == SVt_PVGV)) {
+    if (isGV_with_GP(sv)) {
        /* We're actually already a typeglob, so don't need the stuff below.
         */
        return 0;
diff --git a/sv.c b/sv.c
index e94629d..7e327d4 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -3177,7 +3177,9 @@ S_glob_assign_glob(pTHX_ SV *dstr, SV *sstr, const int dtype)
            }
            sv_upgrade(dstr, SVt_PVGV);
            (void)SvOK_off(dstr);
-           SvSCREAM_on(dstr);
+           /* FIXME - why are we doing this, then turning it off and on again
+              below?  */
+           isGV_with_GP_on(dstr);
        }
        GvSTASH(dstr) = GvSTASH(sstr);
        if (GvSTASH(dstr))
@@ -3193,9 +3195,9 @@ S_glob_assign_glob(pTHX_ SV *dstr, SV *sstr, const int dtype)
 #endif
 
     gp_free((GV*)dstr);
-    SvSCREAM_off(dstr);
+    isGV_with_GP_off(dstr);
     (void)SvOK_off(dstr);
-    SvSCREAM_on(dstr);
+    isGV_with_GP_on(dstr);
     GvINTRO_off(dstr);         /* one-shot flag */
     GvGP(dstr) = gp_ref(GvGP(sstr));
     if (SvTAINTED(sstr))
@@ -7946,7 +7948,7 @@ S_sv_unglob(pTHX_ SV *sv)
     if (GvNAME_HEK(sv)) {
        unshare_hek(GvNAME_HEK(sv));
     }
-    SvSCREAM_off(sv);
+    isGV_with_GP_off(sv);
 
     /* need to keep SvANY(sv) in the right arena */
     xpvmg = new_XPVMG();
diff --git a/sv.h b/sv.h
index 3f061c6..a8e7a2e 100644 (file)
--- a/sv.h
+++ b/sv.h
@@ -292,7 +292,8 @@ perform the upgrade if necessary.  See C<svtype>.
 #define SVp_NOK                0x00002000  /* has valid non-public numeric value */
 #define SVp_POK                0x00004000  /* has valid non-public pointer value */
 #define SVp_SCREAM     0x00008000  /* has been studied? */
-#define SVphv_CLONEABLE        0x00008000  /* PVHV (stashes) clone its objects */
+#define SVphv_CLONEABLE        SVp_SCREAM  /* PVHV (stashes) clone its objects */
+#define SVpgv_GP       SVp_SCREAM  /* GV has a valid GP */
 
 #define SVs_PADSTALE   0x00010000  /* lexical has gone out of scope */
 #define SVpad_STATE    0x00010000  /* pad name is a "state" var */
@@ -335,7 +336,7 @@ perform the upgrade if necessary.  See C<svtype>.
 #define SVf_THINKFIRST (SVf_READONLY|SVf_ROK|SVf_FAKE)
 
 #define SVf_OK         (SVf_IOK|SVf_NOK|SVf_POK|SVf_ROK| \
-                        SVp_IOK|SVp_NOK|SVp_POK|SVp_SCREAM)
+                        SVp_IOK|SVp_NOK|SVp_POK|SVpgv_GP)
 
 #define PRIVSHIFT 4    /* (SVp_?OK >> PRIVSHIFT) == SVf_?OK */
 
@@ -1974,8 +1975,23 @@ Returns a pointer to the character buffer.
 /* If I give every macro argument a different name, then there won't be bugs
    where nested macros get confused. Been there, done that.  */
 #define isGV_with_GP(pwadak) \
-       (((SvFLAGS(pwadak) & (SVp_POK|SVp_SCREAM)) == SVp_SCREAM)       \
+       (((SvFLAGS(pwadak) & (SVp_POK|SVpgv_GP)) == SVpgv_GP)   \
        && (SvTYPE(pwadak) == SVt_PVGV || SvTYPE(pwadak) == SVt_PVLV))
+#define isGV_with_GP_on(sv)    STMT_START {                           \
+       GV *const uggh = (GV*) sv;                                     \
+       assert (SvTYPE(uggh) == SVt_PVGV || SvTYPE(uggh) == SVt_PVLV); \
+       assert (!SvPOKp(uggh));                                        \
+       assert (!SvIOKp(uggh));                                        \
+       (SvFLAGS(uggh) |= SVpgv_GP);                                   \
+    } STMT_END
+#define isGV_with_GP_off(sv)   STMT_START {                           \
+       GV *const uggh = (GV *) sv;                                    \
+       assert (SvTYPE(uggh) == SVt_PVGV || SvTYPE(uggh) == SVt_PVLV); \
+       assert (!SvPOKp(uggh));                                        \
+       assert (!SvIOKp(uggh));                                        \
+       (SvFLAGS(sv) &= ~SVpgv_GP);                                    \
+    } STMT_END
+
 
 #define SvGROW(sv,len) (SvLEN(sv) < (len) ? sv_grow(sv,len) : SvPVX(sv))
 #define SvGROW_mutable(sv,len) \