From 536d1a883d741d74ca5ab30c7fa72980d2593986 Mon Sep 17 00:00:00 2001 From: Brian Fraser Date: Sun, 4 Aug 2013 14:55:56 -0300 Subject: [PATCH] gv.c: Split part of find_default_stash into gv_is_in_main. gv_is_in_main() checks if an unqualified identifier is in the main:: stash. --- embed.fnc | 2 ++ embed.h | 1 + gv.c | 67 +++++++++++++++++++++++++++++++++++++-------------------------- proto.h | 5 +++++ 4 files changed, 47 insertions(+), 28 deletions(-) diff --git a/embed.fnc b/embed.fnc index cb19a17..6ad48d3 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1788,6 +1788,8 @@ 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 +s |bool|gv_is_in_main|NN const char *name|STRLEN len \ + |const U32 is_utf8 s |HV* |require_tie_mod|NN GV *gv|NN const char *varpv|NN SV* namesv \ |NN const char *methpv|const U32 flags #endif diff --git a/embed.h b/embed.h index 1c3481a..1d213b2 100644 --- a/embed.h +++ b/embed.h @@ -1380,6 +1380,7 @@ # 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_is_in_main(a,b,c) S_gv_is_in_main(aTHX_ a,b,c) #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 maybe_multimagic_gv(a,b,c) S_maybe_multimagic_gv(aTHX_ a,b,c) diff --git a/gv.c b/gv.c index cec6534..fc4393e 100644 --- a/gv.c +++ b/gv.c @@ -1495,67 +1495,81 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name, return TRUE; } -/* This function is called if parse_gv_stash_name() failed to - * find a stash, or if GV_NOTQUAL or an empty name was passed - * to gv_fetchpvn_flags. - * - * It returns FALSE if the default stash can't be found nor created, - * which might happen during global destruction. - */ +/* Checks if an unqualified name is in the main stash */ PERL_STATIC_INLINE bool -S_find_default_stash(pTHX_ HV **stash, const char *name, STRLEN len, - const U32 is_utf8, const I32 add, - const svtype sv_type) +S_gv_is_in_main(pTHX_ const char *name, STRLEN len, const U32 is_utf8) { - PERL_ARGS_ASSERT_FIND_DEFAULT_STASH; + PERL_ARGS_ASSERT_GV_IS_IN_MAIN; - /* No stash in name, so see how we can default */ - /* If it's an alphanumeric variable */ - if (len && isIDFIRST_lazy_if(name, is_utf8)) { - bool global = FALSE; - + if ( len && isIDFIRST_lazy_if(name, is_utf8) ) { /* Some "normal" variables are always in main::, * like INC or STDOUT. */ switch (len) { case 1: if (*name == '_') - global = TRUE; + return TRUE; break; case 3: if ((name[0] == 'I' && name[1] == 'N' && name[2] == 'C') || (name[0] == 'E' && name[1] == 'N' && name[2] == 'V') || (name[0] == 'S' && name[1] == 'I' && name[2] == 'G')) - global = TRUE; + return TRUE; break; case 4: if (name[0] == 'A' && name[1] == 'R' && name[2] == 'G' && name[3] == 'V') - global = TRUE; + return TRUE; break; case 5: if (name[0] == 'S' && name[1] == 'T' && name[2] == 'D' && name[3] == 'I' && name[4] == 'N') - global = TRUE; + return TRUE; break; case 6: if ((name[0] == 'S' && name[1] == 'T' && name[2] == 'D') &&((name[3] == 'O' && name[4] == 'U' && name[5] == 'T') ||(name[3] == 'E' && name[4] == 'R' && name[5] == 'R'))) - global = TRUE; + return TRUE; break; case 7: if (name[0] == 'A' && name[1] == 'R' && name[2] == 'G' && name[3] == 'V' && name[4] == 'O' && name[5] == 'U' && name[6] == 'T') - global = TRUE; + return TRUE; break; } + } + /* *{""}, or a special variable like $@ */ + else + return TRUE; + + return FALSE; +} + + +/* This function is called if parse_gv_stash_name() failed to + * find a stash, or if GV_NOTQUAL or an empty name was passed + * to gv_fetchpvn_flags. + * + * It returns FALSE if the default stash can't be found nor created, + * which might happen during global destruction. + */ +PERL_STATIC_INLINE bool +S_find_default_stash(pTHX_ HV **stash, const char *name, STRLEN len, + const U32 is_utf8, const I32 add, + const svtype sv_type) +{ + PERL_ARGS_ASSERT_FIND_DEFAULT_STASH; + + /* No stash in name, so see how we can default */ - if (global) - *stash = PL_defstash; - else if (IN_PERL_COMPILETIME) { + if ( gv_is_in_main(name, len, is_utf8) ) { + *stash = PL_defstash; + } + else { + if (IN_PERL_COMPILETIME) { *stash = PL_curstash; if (add && (PL_hints & HINT_STRICT_VARS) && sv_type != SVt_PVCV && @@ -1597,9 +1611,6 @@ S_find_default_stash(pTHX_ HV **stash, const char *name, STRLEN len, *stash = CopSTASH(PL_curcop); } } - /* *{""}, or a special variable like $@ */ - else - *stash = PL_defstash; if (!*stash) { if (add && !PL_in_clean_all) { diff --git a/proto.h b/proto.h index bc09541..790c885 100644 --- a/proto.h +++ b/proto.h @@ -5729,6 +5729,11 @@ STATIC void S_gv_init_svtype(pTHX_ GV *gv, const svtype sv_type) #define PERL_ARGS_ASSERT_GV_INIT_SVTYPE \ assert(gv) +STATIC bool S_gv_is_in_main(pTHX_ const char *name, STRLEN len, const U32 is_utf8) + __attribute__nonnull__(pTHX_1); +#define PERL_ARGS_ASSERT_GV_IS_IN_MAIN \ + assert(name) + 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) -- 2.7.4