summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--embed.fnc2
-rw-r--r--embed.h2
-rw-r--r--gv.c74
-rw-r--r--proto.h14
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);
View Lorry Controller Status