up patchlevel &c

[p5sagit/p5-mst-13.2.git] / hv.c

diff --git a/hv.c b/hv.c
index 5a42d2f..0c472bc 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -26,7 +26,9 @@ static HEK *save_hek _((const char *str, I32 len, U32 hash));
 #  define ARRAY_ALLOC_BYTES(size) ( (size)*sizeof(HE*) )
 #else
 #  define MALLOC_OVERHEAD 16
-#  define ARRAY_ALLOC_BYTES(size) ( (size)*sizeof(HE*)*2 - MALLOC_OVERHEAD )
+#  define ARRAY_ALLOC_BYTES(size) ( ((size) < 64)      \
+                               ? (size)*sizeof(HE*)    \
+                               : (size)*sizeof(HE*)*2 - MALLOC_OVERHEAD )
 #endif
 
 STATIC HE*
@@ -150,13 +152,13 @@ hv_fetch(HV *hv, const char *key, U32 klen, I32 lval)
     }
 #ifdef DYNAMIC_ENV_FETCH  /* %ENV lookup?  If so, try to fetch the value now */
     if (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) {
-      char *gotenv;
-
-      if ((gotenv = PerlEnv_getenv(key)) != Nullch) {
-        sv = newSVpvn(gotenv,strlen(gotenv));
-        SvTAINTED_on(sv);
-        return hv_store(hv,key,klen,sv,hash);
-      }
+       unsigned long len;
+       char *env = PerlEnv_ENVgetenv_len(key,&len);
+       if (env) {
+           sv = newSVpvn(env,len);
+           SvTAINTED_on(sv);
+           return hv_store(hv,key,klen,sv,hash);
+       }
     }
 #endif
     if (lval) {                /* gonna assign to this, so it better be there */
@@ -241,13 +243,13 @@ hv_fetch_ent(HV *hv, SV *keysv, I32 lval, register U32 hash)
     }
 #ifdef DYNAMIC_ENV_FETCH  /* %ENV lookup?  If so, try to fetch the value now */
     if (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) {
-      char *gotenv;
-
-      if ((gotenv = PerlEnv_getenv(key)) != Nullch) {
-        sv = newSVpvn(gotenv,strlen(gotenv));
-        SvTAINTED_on(sv);
-        return hv_store_ent(hv,keysv,sv,hash);
-      }
+       unsigned long len;
+       char *env = PerlEnv_ENVgetenv_len(key,&len);
+       if (env) {
+           sv = newSVpvn(env,len);
+           SvTAINTED_on(sv);
+           return hv_store_ent(hv,keysv,sv,hash);
+       }
     }
 #endif
     if (lval) {                /* gonna assign to this, so it better be there */
@@ -597,11 +599,17 @@ hv_exists(HV *hv, const char *key, U32 klen)
     }
 
     xhv = (XPVHV*)SvANY(hv);
+#ifndef DYNAMIC_ENV_FETCH
     if (!xhv->xhv_array)
        return 0; 
+#endif
 
     PERL_HASH(hash, key, klen);
 
+#ifdef DYNAMIC_ENV_FETCH
+    if (!xhv->xhv_array) entry = Null(HE*);
+    else
+#endif
     entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
     for (; entry; entry = HeNEXT(entry)) {
        if (HeHASH(entry) != hash)              /* strings can't be equal */
@@ -612,6 +620,18 @@ hv_exists(HV *hv, const char *key, U32 klen)
            continue;
        return TRUE;
     }
+#ifdef DYNAMIC_ENV_FETCH  /* is it out there? */
+    if (HvNAME(hv) && strEQ(HvNAME(hv), ENV_HV_NAME)) {
+       unsigned long len;
+       char *env = PerlEnv_ENVgetenv_len(key,&len);
+       if (env) {
+           sv = newSVpvn(env,len);
+           SvTAINTED_on(sv);
+           (void)hv_store(hv,key,klen,sv,hash);
+           return TRUE;
+       }
+    }
+#endif
     return FALSE;
 }
 
@@ -648,13 +668,19 @@ hv_exists_ent(HV *hv, SV *keysv, U32 hash)
     }
 
     xhv = (XPVHV*)SvANY(hv);
+#ifndef DYNAMIC_ENV_FETCH
     if (!xhv->xhv_array)
        return 0; 
+#endif
 
     key = SvPV(keysv, klen);
     if (!hash)
        PERL_HASH(hash, key, klen);
 
+#ifdef DYNAMIC_ENV_FETCH
+    if (!xhv->xhv_array) entry = Null(HE*);
+    else
+#endif
     entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
     for (; entry; entry = HeNEXT(entry)) {
        if (HeHASH(entry) != hash)              /* strings can't be equal */
@@ -665,6 +691,18 @@ hv_exists_ent(HV *hv, SV *keysv, U32 hash)
            continue;
        return TRUE;
     }
+#ifdef DYNAMIC_ENV_FETCH  /* is it out there? */
+    if (HvNAME(hv) && strEQ(HvNAME(hv), ENV_HV_NAME)) {
+       unsigned long len;
+       char *env = PerlEnv_ENVgetenv_len(key,&len);
+       if (env) {
+           sv = newSVpvn(env,len);
+           SvTAINTED_on(sv);
+           (void)hv_store_ent(hv,keysv,sv,hash);
+           return TRUE;
+       }
+    }
+#endif
     return FALSE;
 }
 
@@ -990,10 +1028,6 @@ hv_iterinit(HV *hv)
        croak("Bad hash");
     xhv = (XPVHV*)SvANY(hv);
     entry = xhv->xhv_eiter;
-#ifdef DYNAMIC_ENV_FETCH  /* set up %ENV for iteration */
-    if (HvNAME(hv) && strEQ(HvNAME(hv), ENV_HV_NAME))
-       prime_env_iter();
-#endif
     if (entry && HvLAZYDEL(hv)) {      /* was deleted earlier? */
        HvLAZYDEL_off(hv);
        hv_free_ent(hv, entry);
@@ -1046,6 +1080,10 @@ hv_iternext(HV *hv)
        xhv->xhv_eiter = Null(HE*);
        return Null(HE*);
     }
+#ifdef DYNAMIC_ENV_FETCH  /* set up %ENV for iteration */
+    if (!entry && HvNAME(hv) && strEQ(HvNAME(hv), ENV_HV_NAME))
+       prime_env_iter();
+#endif
 
     if (!xhv->xhv_array)
        Newz(506,xhv->xhv_array, ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char);