gv.c: Rename magicalize_gv into gv_magicalize, make it more specific.

Namely, gv_magicalize no longer stores the GV into the stash, which
is gv_fetchpvn_flags' job.

diff --git a/embed.fnc b/embed.fnc
index a09fce9..cb19a17 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1784,7 +1784,7 @@ s  |bool|parse_gv_stash_name|NN HV **stash|NN GV **gv \
 s  |bool|find_default_stash|NN HV **stash|NN const char *name \
                      |STRLEN len|const U32 is_utf8|const I32 add \
                      |svtype sv_type
-s  |GV*|magicalize_gv|NN GV *gv|NN HV *stash|NN const char *name \
+s  |bool|gv_magicalize|NN GV *gv|NN HV *stash|NN const char *name \
                      |STRLEN len|bool addmg \
                      |svtype sv_type
 s  |void|maybe_multimagic_gv|NN GV *gv|NN const char *name|const svtype sv_type

diff --git a/embed.h b/embed.h
index 23cd8c5..1c3481a 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -1380,8 +1380,8 @@
 #  if defined(PERL_IN_GV_C)
 #define find_default_stash(a,b,c,d,e,f)        S_find_default_stash(aTHX_ a,b,c,d,e,f)
 #define gv_init_svtype(a,b)    S_gv_init_svtype(aTHX_ a,b)
+#define gv_magicalize(a,b,c,d,e,f)     S_gv_magicalize(aTHX_ a,b,c,d,e,f)
 #define gv_magicalize_isa(a)   S_gv_magicalize_isa(aTHX_ a)
-#define magicalize_gv(a,b,c,d,e,f)     S_magicalize_gv(aTHX_ a,b,c,d,e,f)
 #define maybe_multimagic_gv(a,b,c)     S_maybe_multimagic_gv(aTHX_ a,b,c)
 #define parse_gv_stash_name(a,b,c,d,e,f,g,h)   S_parse_gv_stash_name(aTHX_ a,b,c,d,e,f,g,h)
 #define require_tie_mod(a,b,c,d,e)     S_require_tie_mod(aTHX_ a,b,c,d,e)

diff --git a/gv.c b/gv.c
index 29bf398..cec6534 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -1636,14 +1636,24 @@ S_find_default_stash(pTHX_ HV **stash, const char *name, STRLEN len,
     return TRUE;
 }
 
-/* magicalize_gv() gets called by gv_fetchpvn_flags when creating a new GV */
-PERL_STATIC_INLINE GV*
-S_magicalize_gv(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len,
+/* gv_magicalize() is called by gv_fetchpvn_flags when creating
+ * a new GV.
+ * Note that it does not insert the GV into the stash prior to
+ * magicalization, which some variables require need in order
+ * to work (like $[, %+, %-, %!), so callers must take care of
+ * that beforehand.
+ * 
+ * The return value has a specific meaning for gv_fetchpvn_flags:
+ * If it returns true, and the gv is empty, it indicates that its
+ * refcount should be decreased.
+ */
+PERL_STATIC_INLINE bool
+S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len,
                bool addmg, const svtype sv_type)
 {
     SSize_t paren;
 
-    PERL_ARGS_ASSERT_MAGICALIZE_GV;
+    PERL_ARGS_ASSERT_GV_MAGICALIZE;
     
     if (stash != PL_defstash) { /* not the main stash */
        /* We only have to check for three names here: EXPORT, ISA
@@ -1667,7 +1677,7 @@ S_magicalize_gv(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len,
            default:
                goto try_core;
            }
-           goto add_magical_gv;
+           return addmg;
        }
       try_core:
        if (len > 1 /* shortest is uc */ && HvNAMELEN_get(stash) == 4) {
@@ -1815,7 +1825,8 @@ S_magicalize_gv(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len,
                /* This snippet is taken from is_gv_magical */
                const char *end = name + len;
                while (--end > name) {
-                   if (!isDIGIT(*end)) goto add_magical_gv;
+                   if (!isDIGIT(*end))
+                        return addmg;
                }
                 paren = strtoul(name, NULL, 10);
                 goto storeparen;
@@ -1887,9 +1898,8 @@ S_magicalize_gv(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len,
             /* magicalization must be done before require_tie_mod is called */
            if (sv_type == SVt_PVHV || sv_type == SVt_PVGV)
            {
-               if (addmg) (void)hv_store(stash,name,len,(SV *)gv,0);
-               addmg = 0;
                require_tie_mod(gv, "!", newSVpvs("Errno"), "TIEHASH", 1);
+                addmg = FALSE;
            }
 
            break;
@@ -1908,9 +1918,8 @@ S_magicalize_gv(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len,
 
             if (sv_type == SVt_PVHV || sv_type == SVt_PVGV)
            {
-               if (addmg) (void)hv_store(stash,name,len,(SV *)gv,0);
-               addmg = 0;
                 require_tie_mod(gv, name, newSVpvs("Tie::Hash::NamedCapture"), "TIEHASH", 0);
+                addmg = FALSE;
            }
 
             break;
@@ -1931,9 +1940,8 @@ S_magicalize_gv(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len,
        case '[':               /* $[ */
            if ((sv_type == SVt_PV || sv_type == SVt_PVGV)
             && FEATURE_ARYBASE_IS_ENABLED) {
-               if (addmg) (void)hv_store(stash,name,len,(SV *)gv,0);
                require_tie_mod(gv,name,newSVpvs("arybase"),"FETCH",0);
-               addmg = 0;
+                addmg = FALSE;
            }
            else goto magicalize;
             break;
@@ -1996,16 +2004,8 @@ S_magicalize_gv(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len,
        break;
        }
     }
-  add_magical_gv:
-    if (addmg) {
-       if (GvAV(gv) || GvHV(gv) || GvIO(gv) || GvCV(gv) || (
-            GvSV(gv) && (SvOK(GvSV(gv)) || SvMAGICAL(GvSV(gv)))
-          ))
-           (void)hv_store(stash,name,len,(SV *)gv,0);
-       else SvREFCNT_dec_NN(gv), gv = NULL;
-    }
-    
-    return gv;
+
+    return addmg;
 }
 
 /* This function is called when the stash already holds the GV of the magic
@@ -2069,7 +2069,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
     const I32 no_expand = flags & GV_NOEXPAND;
     const I32 add = flags & ~GV_NOADD_MASK;
     const U32 is_utf8 = flags & SVf_UTF8;
-    bool addmg = !!(flags & GV_ADDMG);
+    bool addmg = cBOOL(flags & GV_ADDMG);
     const char *const name_end = nambeg + full_len;
     U32 faking_it;
 
@@ -2165,8 +2165,34 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
     if ( isIDFIRST_lazy_if(name, is_utf8) && !ckWARN(WARN_ONCE) )
         GvMULTI_on(gv) ;
 
+    /* First, store the gv in the symtab if we're adding magic,
+     * but only for non-empty GVs
+     */
+#define GvEMPTY(gv)      !(GvAV(gv) || GvHV(gv) || GvIO(gv) \
+                        || GvCV(gv) || (GvSV(gv) && SvOK(GvSV(gv))))
+    
+    if ( addmg && !GvEMPTY(gv) ) {
+        (void)hv_store(stash,name,len,(SV *)gv,0);
+    }
+
     /* set up magic where warranted */
-    gv = magicalize_gv(gv, stash, name, len, addmg, sv_type);
+    if ( gv_magicalize(gv, stash, name, len, addmg, sv_type) ) {
+        /* See 23496c6 */
+        if (GvEMPTY(gv)) {
+            if ( GvSV(gv) && SvMAGICAL(GvSV(gv)) ) {
+                /* The GV was and still is "empty", except that now
+                 * it has the magic flags turned on, so we want it
+                 * stored in the symtab.
+                 */
+                (void)hv_store(stash,name,len,(SV *)gv,0);
+            }
+            else {
+                /* Most likely the temporary GV created above */
+                SvREFCNT_dec_NN(gv);
+                gv = NULL;
+            }
+        }
+    }
     
     if (gv) gv_init_svtype(gv, faking_it ? SVt_PVCV : sv_type);
     return gv;

diff --git a/proto.h b/proto.h
index 4cb3e47..bc09541 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -5729,18 +5729,18 @@ STATIC void     S_gv_init_svtype(pTHX_ GV *gv, const svtype sv_type)
 #define PERL_ARGS_ASSERT_GV_INIT_SVTYPE        \
        assert(gv)
 
-STATIC void    S_gv_magicalize_isa(pTHX_ GV *gv)
-                       __attribute__nonnull__(pTHX_1);
-#define PERL_ARGS_ASSERT_GV_MAGICALIZE_ISA     \
-       assert(gv)
-
-STATIC GV*     S_magicalize_gv(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, bool addmg, svtype sv_type)
+STATIC bool    S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, bool addmg, svtype sv_type)
                        __attribute__nonnull__(pTHX_1)
                        __attribute__nonnull__(pTHX_2)
                        __attribute__nonnull__(pTHX_3);
-#define PERL_ARGS_ASSERT_MAGICALIZE_GV \
+#define PERL_ARGS_ASSERT_GV_MAGICALIZE \
        assert(gv); assert(stash); assert(name)
 
+STATIC void    S_gv_magicalize_isa(pTHX_ GV *gv)
+                       __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_GV_MAGICALIZE_ISA     \
+       assert(gv)
+
 STATIC void    S_maybe_multimagic_gv(pTHX_ GV *gv, const char *name, const svtype sv_type)
                        __attribute__nonnull__(pTHX_1)
                        __attribute__nonnull__(pTHX_2);