diff --git a/embed.fnc b/embed.fnc
index 2eea441b7530..620740aa99ae 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -4564,6 +4564,9 @@ opx |void |sv_kill_backrefs \
|NN SV * const sv \
|NULLOK NOCHECK AV * const av
#endif
+#if defined(PERL_IN_HV_C) || defined(PERL_IN_PP_HOT_C)
+S |bool |hv_is_env |NN HV *hv
+#endif
#if defined(PERL_IN_HV_C) || defined(PERL_IN_SV_C)
op |SV * |hfree_next_entry \
|NN HV *hv \
diff --git a/embed.h b/embed.h
index f1930a9e096f..ca24f3db94c7 100644
--- a/embed.h
+++ b/embed.h
@@ -1425,6 +1425,9 @@
# define new_he() S_new_he(aTHX)
# endif
# endif /* defined(PERL_IN_HV_C) */
+# if defined(PERL_IN_HV_C) || defined(PERL_IN_PP_HOT_C)
+# define hv_is_env(a) S_hv_is_env(aTHX_ a)
+# endif
# if defined(PERL_IN_LOCALE_C)
# define get_locale_string_utf8ness_i(a,b,c,d) S_get_locale_string_utf8ness_i(aTHX_ a,b,c,d)
# define ints_to_tm(a,b,c,d,e,f,g,h,i) S_ints_to_tm(aTHX_ a,b,c,d,e,f,g,h,i)
diff --git a/hv.c b/hv.c
index c3d65cc72e16..46e89ecf835d 100644
--- a/hv.c
+++ b/hv.c
@@ -604,7 +604,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
return (void *) entry;
}
#ifdef ENV_IS_CASELESS
- else if (mg_find((const SV *)hv, PERL_MAGIC_env)) {
+ else if (hv_is_env(hv)) {
U32 i;
for (i = 0; i < klen; ++i)
if (isLOWER(key[i])) {
@@ -669,7 +669,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
return SvTRUE_NN(svret) ? (void *)hv : NULL;
}
#ifdef ENV_IS_CASELESS
- else if (mg_find((const SV *)hv, PERL_MAGIC_env)) {
+ else if (hv_is_env(hv)) {
/* XXX This code isn't UTF8 clean. */
char * const keysave = (char * const)key;
/* Will need to free this, so set FREEKEY flag. */
@@ -714,7 +714,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
return NULL;
}
#ifdef ENV_IS_CASELESS
- else if (mg_find((const SV *)hv, PERL_MAGIC_env)) {
+ else if (hv_is_env(hv)) {
/* XXX This code isn't UTF8 clean. */
const char *keysave = key;
/* Will need to free this, so set FREEKEY flag. */
@@ -737,8 +737,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
if (!HvARRAY(hv)) {
if ((action & (HV_FETCH_LVALUE | HV_FETCH_ISSTORE))
#ifdef DYNAMIC_ENV_FETCH /* if it's an %ENV lookup, we may get it on the fly */
- || (SvRMAGICAL((const SV *)hv)
- && mg_find((const SV *)hv, PERL_MAGIC_env))
+ || (hv_is_env(hv))
#endif
) {
char *array;
@@ -944,9 +943,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
not_found:
#ifdef DYNAMIC_ENV_FETCH /* %ENV lookup? If so, try to fetch the value now */
- if (!(action & HV_FETCH_ISSTORE)
- && SvRMAGICAL((const SV *)hv)
- && mg_find((const SV *)hv, PERL_MAGIC_env)) {
+ if (!(action & HV_FETCH_ISSTORE) && hv_is_env(hv)) {
unsigned long len;
const char * const env = PerlEnv_ENVgetenv_len(key,&len);
if (env) {
@@ -1196,7 +1193,7 @@ Perl_hv_pushkv(pTHX_ HV *hv, U32 flags)
HE *entry;
bool tied = SvRMAGICAL(hv) && (mg_find(MUTABLE_SV(hv), PERL_MAGIC_tied)
#ifdef DYNAMIC_ENV_FETCH /* might not know number of keys yet */
- || mg_find(MUTABLE_SV(hv), PERL_MAGIC_env)
+ || hv_is_env(hv)
#endif
);
PERL_ARGS_ASSERT_HV_PUSHKV;
@@ -1348,7 +1345,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
return NULL; /* element cannot be deleted */
}
#ifdef ENV_IS_CASELESS
- else if (mg_find((const SV *)hv, PERL_MAGIC_env)) {
+ else if (hv_is_env(hv)) {
/* XXX This code isn't UTF8 clean. */
keysv = newSVpvn_flags(key, klen, SVs_TEMP);
if (k_flags & HVhek_FREEKEY) {
@@ -3063,8 +3060,7 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
}
}
#if defined(DYNAMIC_ENV_FETCH) && defined(VMS) /* set up %ENV for iteration */
- if (!entry && SvRMAGICAL((const SV *)hv)
- && mg_find((const SV *)hv, PERL_MAGIC_env)) {
+ if (!entry && hv_is_env(hv)) {
prime_env_iter();
}
#endif
diff --git a/inline.h b/inline.h
index a6191dac38e8..d206e79fa342 100644
--- a/inline.h
+++ b/inline.h
@@ -283,6 +283,18 @@ S_strip_spaces(pTHX_ const char * orig, STRLEN * const len)
}
#endif
+/* ------------------------------- hv.h ------------------------------- */
+
+#if defined(PERL_IN_HV_C) || defined(PERL_IN_PP_HOT_C)
+PERL_STATIC_INLINE bool
+S_hv_is_env(pTHX_ HV *hv)
+{
+ PERL_ARGS_ASSERT_HV_IS_ENV;
+
+ return SvRMAGICAL((SV *)hv) && (bool)mg_find((SV *)hv, PERL_MAGIC_env);
+}
+#endif
+
/* ------------------------------- iperlsys.h ------------------------------- */
#if ! defined(PERL_IMPLICIT_SYS) && defined(USE_ITHREADS)
diff --git a/pp_hot.c b/pp_hot.c
index 240af1f709c6..c5ced56d6204 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -2266,8 +2266,7 @@ S_padhv_rv2hv_common(pTHX_ HV *hv, U8 gimme, bool is_keys, bool has_targ)
keys then check its length, and whether we do either with or without
an %ENV lookup first. prime_env_iter() returns quickly if nothing
needs doing. */
- if (SvRMAGICAL((const SV *)hv)
- && mg_find((const SV *)hv, PERL_MAGIC_env)) {
+ if (hv_is_env(hv))
prime_env_iter();
}
#endif
diff --git a/proto.h b/proto.h
index 120cc032cf32..0984830394a1 100644
--- a/proto.h
+++ b/proto.h
@@ -6988,6 +6988,13 @@ Perl_sv_kill_backrefs(pTHX_ SV * const sv, AV * const av)
# define PERL_ARGS_ASSERT_SV_KILL_BACKREFS \
assert(sv)
+#endif
+#if defined(PERL_IN_HV_C) || defined(PERL_IN_PP_HOT_C)
+STATIC bool
+S_hv_is_env(pTHX_ HV *hv);
+# define PERL_ARGS_ASSERT_HV_IS_ENV \
+ assert(hv); assert(SvTYPE(hv) == SVt_PVHV)
+
#endif
#if defined(PERL_IN_HV_C) || defined(PERL_IN_SV_C)
PERL_CALLCONV SV *