# 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)
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 &&
*stash = CopSTASH(PL_curcop);
}
}
- /* *{""}, or a special variable like $@ */
- else
- *stash = PL_defstash;
if (!*stash) {
if (add && !PL_in_clean_all) {
#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)