From 930867a8e4ffdf642ef15c92e6f3a6d118965559 Mon Sep 17 00:00:00 2001 From: Brian Fraser Date: Sun, 4 Aug 2013 14:23:27 -0300 Subject: 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. --- embed.fnc | 2 +- embed.h | 2 +- gv.c | 74 ++++++++++++++++++++++++++++++++++++++++++--------------------- proto.h | 14 ++++++------ 4 files changed, 59 insertions(+), 33 deletions(-) diff --git a/embed.fnc b/embed.fnc index a09fce9adb..cb19a1755f 100644 --- 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 23cd8c5173..1c3481aeca 100644 --- 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 29bf39856a..cec6534be6 100644 --- 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 4cb3e47e1a..bc09541224 100644 --- 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); -- cgit v1.2.1