@@ -481,6 +481,8 @@ Perl_hv_common_key_len(pTHX_ HV *hv, const char *key, I32 klen_i32,
481
481
return hv_common (hv , NULL , key , klen , flags , action , val , hash );
482
482
}
483
483
484
+ #define hv_is_env (hv ) ((hv) == GvHV(PL_envgv))
485
+
484
486
void *
485
487
Perl_hv_common (pTHX_ HV * hv , SV * keysv , const char * key , STRLEN klen ,
486
488
int flags , int action , SV * val , U32 hash )
@@ -604,7 +606,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
604
606
return (void * ) entry ;
605
607
}
606
608
#ifdef ENV_IS_CASELESS
607
- else if (mg_find (( const SV * ) hv , PERL_MAGIC_env )) {
609
+ else if (hv_is_env ( hv )) {
608
610
U32 i ;
609
611
for (i = 0 ; i < klen ; ++ i )
610
612
if (isLOWER (key [i ])) {
@@ -669,7 +671,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
669
671
return SvTRUE_NN (svret ) ? (void * )hv : NULL ;
670
672
}
671
673
#ifdef ENV_IS_CASELESS
672
- else if (mg_find (( const SV * ) hv , PERL_MAGIC_env )) {
674
+ else if (hv_is_env ( hv )) {
673
675
/* XXX This code isn't UTF8 clean. */
674
676
char * const keysave = (char * const )key ;
675
677
/* Will need to free this, so set FREEKEY flag. */
@@ -714,7 +716,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
714
716
return NULL ;
715
717
}
716
718
#ifdef ENV_IS_CASELESS
717
- else if (mg_find (( const SV * ) hv , PERL_MAGIC_env )) {
719
+ else if (hv_is_env ( hv )) {
718
720
/* XXX This code isn't UTF8 clean. */
719
721
const char * keysave = key ;
720
722
/* Will need to free this, so set FREEKEY flag. */
@@ -737,8 +739,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
737
739
if (!HvARRAY (hv )) {
738
740
if ((action & (HV_FETCH_LVALUE | HV_FETCH_ISSTORE ))
739
741
#ifdef DYNAMIC_ENV_FETCH /* if it's an %ENV lookup, we may get it on the fly */
740
- || (SvRMAGICAL ((const SV * )hv )
741
- && mg_find ((const SV * )hv , PERL_MAGIC_env ))
742
+ || (SvRMAGICAL ((const SV * )hv ) && hv_is_env (hv ))
742
743
#endif
743
744
) {
744
745
char * array ;
@@ -946,7 +947,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
946
947
#ifdef DYNAMIC_ENV_FETCH /* %ENV lookup? If so, try to fetch the value now */
947
948
if (!(action & HV_FETCH_ISSTORE )
948
949
&& SvRMAGICAL ((const SV * )hv )
949
- && mg_find (( const SV * ) hv , PERL_MAGIC_env )) {
950
+ && hv_is_env ( hv )) {
950
951
unsigned long len ;
951
952
const char * const env = PerlEnv_ENVgetenv_len (key ,& len );
952
953
if (env ) {
@@ -1196,7 +1197,7 @@ Perl_hv_pushkv(pTHX_ HV *hv, U32 flags)
1196
1197
HE * entry ;
1197
1198
bool tied = SvRMAGICAL (hv ) && (mg_find (MUTABLE_SV (hv ), PERL_MAGIC_tied )
1198
1199
#ifdef DYNAMIC_ENV_FETCH /* might not know number of keys yet */
1199
- || mg_find ( MUTABLE_SV ( hv ), PERL_MAGIC_env )
1200
+ || hv_is_env ( hv )
1200
1201
#endif
1201
1202
);
1202
1203
PERL_ARGS_ASSERT_HV_PUSHKV ;
@@ -1348,7 +1349,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
1348
1349
return NULL ; /* element cannot be deleted */
1349
1350
}
1350
1351
#ifdef ENV_IS_CASELESS
1351
- else if (mg_find (( const SV * ) hv , PERL_MAGIC_env )) {
1352
+ else if (hv_is_env ( hv )) {
1352
1353
/* XXX This code isn't UTF8 clean. */
1353
1354
keysv = newSVpvn_flags (key , klen , SVs_TEMP );
1354
1355
if (k_flags & HVhek_FREEKEY ) {
@@ -3063,8 +3064,7 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
3063
3064
}
3064
3065
}
3065
3066
#if defined(DYNAMIC_ENV_FETCH ) && defined(VMS ) /* set up %ENV for iteration */
3066
- if (!entry && SvRMAGICAL ((const SV * )hv )
3067
- && mg_find ((const SV * )hv , PERL_MAGIC_env )) {
3067
+ if (!entry && SvRMAGICAL ((const SV * )hv ) && hv_is_env (hv )) {
3068
3068
prime_env_iter ();
3069
3069
}
3070
3070
#endif
0 commit comments