Re: filename problems

[perl5.git] / hv.c

diff --git a/hv.c b/hv.c
index 76180f2..d553920 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -199,7 +199,7 @@ Perl_hv_fetch(pTHX_ HV *hv, const char *key, I32 klen, I32 lval)
            return 0;
     }
 
-    if (is_utf8 && !(PL_hints & HINT_UTF8_DISTINCT)) {
+    if (is_utf8) {
        STRLEN tmplen = klen;
        /* Just casting the &klen to (STRLEN) won't work well
         * if STRLEN and I32 are of different widths. --jhi */
@@ -333,7 +333,7 @@ Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, register U32 hash)
     keysave = key = SvPV(keysv, klen);
     is_utf8 = (SvUTF8(keysv)!=0);
 
-    if (is_utf8 && !(PL_hints & HINT_UTF8_DISTINCT))
+    if (is_utf8)
        key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
 
     if (!hash)
@@ -447,7 +447,7 @@ Perl_hv_store(pTHX_ HV *hv, const char *key, I32 klen, SV *val, register U32 has
 #endif
        }
     }
-    if (is_utf8 && !(PL_hints & HINT_UTF8_DISTINCT)) {
+    if (is_utf8) {
        STRLEN tmplen = klen;
        /* See the note in hv_fetch(). --jhi */
        key = (char*)bytes_from_utf8((U8*)key, &tmplen, &is_utf8);
@@ -565,7 +565,7 @@ Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, register U32 hash)
     keysave = key = SvPV(keysv, klen);
     is_utf8 = (SvUTF8(keysv) != 0);
 
-    if (is_utf8 && !(PL_hints & HINT_UTF8_DISTINCT))
+    if (is_utf8)
        key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
 
     if (!hash)
@@ -675,7 +675,7 @@ Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen, I32 flags)
     if (!xhv->xhv_array /* !HvARRAY(hv) */)
        return Nullsv;
 
-    if (is_utf8 && !(PL_hints & HINT_UTF8_DISTINCT)) {
+    if (is_utf8) {
        STRLEN tmplen = klen;
        /* See the note in hv_fetch(). --jhi */
        key = (char*)bytes_from_utf8((U8*)key, &tmplen, &is_utf8);
@@ -779,7 +779,7 @@ Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash)
     keysave = key = SvPV(keysv, klen);
     is_utf8 = (SvUTF8(keysv) != 0);
 
-    if (is_utf8 && !(PL_hints & HINT_UTF8_DISTINCT))
+    if (is_utf8)
        key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
 
     if (!hash)
@@ -869,7 +869,7 @@ Perl_hv_exists(pTHX_ HV *hv, const char *key, I32 klen)
        return 0;
 #endif
 
-    if (is_utf8 && !(PL_hints & HINT_UTF8_DISTINCT)) {
+    if (is_utf8) {
        STRLEN tmplen = klen;
        /* See the note in hv_fetch(). --jhi */
        key = (char*)bytes_from_utf8((U8*)key, &tmplen, &is_utf8);
@@ -966,7 +966,7 @@ Perl_hv_exists_ent(pTHX_ HV *hv, SV *keysv, U32 hash)
 
     keysave = key = SvPV(keysv, klen);
     is_utf8 = (SvUTF8(keysv) != 0);
-    if (is_utf8 && !(PL_hints & HINT_UTF8_DISTINCT))
+    if (is_utf8)
        key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
     if (!hash)
        PERL_HASH(hash, key, klen);
@@ -1180,36 +1180,72 @@ Perl_newHV(pTHX)
 HV *
 Perl_newHVhv(pTHX_ HV *ohv)
 {
-    register HV *hv;
-    STRLEN hv_max = ohv ? HvMAX(ohv) : 0;
-    STRLEN hv_fill = ohv ? HvFILL(ohv) : 0;
-
-    hv = newHV();
-    while (hv_max && hv_max + 1 >= hv_fill * 2)
-       hv_max = hv_max / 2;    /* Is always 2^n-1 */
-    HvMAX(hv) = hv_max;
-    if (!hv_fill)
+    HV *hv = newHV();
+    STRLEN hv_max, hv_fill;
+
+    if (!ohv || (hv_fill = HvFILL(ohv)) == 0)
        return hv;
+    hv_max = HvMAX(ohv);
+
+    if (!SvMAGICAL((SV *)ohv)) {
+       /* It's an ordinary hash, so copy it fast. AMS 20010804 */
+       int i, shared = !!HvSHAREKEYS(ohv);
+       HE **ents, **oents = (HE **)HvARRAY(ohv);
+       char *a;
+       New(0, a, PERL_HV_ARRAY_ALLOC_BYTES(hv_max+1), char);
+       ents = (HE**)a;
+
+       /* In each bucket... */
+       for (i = 0; i <= hv_max; i++) {
+           HE *prev = NULL, *ent = NULL, *oent = oents[i];
+
+           if (!oent) {
+               ents[i] = NULL;
+               continue;
+           }
+
+           /* Copy the linked list of entries. */
+           for (oent = oents[i]; oent; oent = HeNEXT(oent)) {
+               U32 hash   = HeHASH(oent);
+               char *key  = HeKEY(oent);
+               STRLEN len = HeKLEN_UTF8(oent);
+
+               ent = new_HE();
+               HeVAL(ent)     = newSVsv(HeVAL(oent));
+               HeKEY_hek(ent) = shared ? share_hek(key, len, hash)
+                                       :  save_hek(key, len, hash);
+               if (prev)
+                   HeNEXT(prev) = ent;
+               else
+                   ents[i] = ent;
+               prev = ent;
+               HeNEXT(ent) = NULL;
+           }
+       }
 
-#if 0
-    if (! SvTIED_mg((SV*)ohv, PERL_MAGIC_tied)) {
-       /* Quick way ???*/
+       HvMAX(hv)   = hv_max;
+       HvFILL(hv)  = hv_fill;
+       HvKEYS(hv)  = HvKEYS(ohv);
+       HvARRAY(hv) = ents;
     }
-    else
-#endif
-    {
+    else {
+       /* Iterate over ohv, copying keys and values one at a time. */
        HE *entry;
-       I32 hv_riter = HvRITER(ohv);    /* current root of iterator */
-       HE *hv_eiter = HvEITER(ohv);    /* current entry of iterator */
-       
-       /* Slow way */
+       I32 riter = HvRITER(ohv);
+       HE *eiter = HvEITER(ohv);
+
+       /* Can we use fewer buckets? (hv_max is always 2^n-1) */
+       while (hv_max && hv_max + 1 >= hv_fill * 2)
+           hv_max = hv_max / 2;
+       HvMAX(hv) = hv_max;
+
        hv_iterinit(ohv);
        while ((entry = hv_iternext(ohv))) {
            hv_store(hv, HeKEY(entry), HeKLEN_UTF8(entry),
                     newSVsv(HeVAL(entry)), HeHASH(entry));
        }
-       HvRITER(ohv) = hv_riter;
-       HvEITER(ohv) = hv_eiter;
+       HvRITER(ohv) = riter;
+       HvEITER(ohv) = eiter;
     }
 
     return hv;
@@ -1584,14 +1620,11 @@ Perl_unsharepvn(pTHX_ const char *str, I32 len, U32 hash)
     const char *save = str;
 
     if (len < 0) {
-      len = -len;
+      STRLEN tmplen = -len;
       is_utf8 = TRUE;
-      if (!(PL_hints & HINT_UTF8_DISTINCT)) {
-         STRLEN tmplen = len;
-         /* See the note in hv_fetch(). --jhi */
-         str = (char*)bytes_from_utf8((U8*)str, &tmplen, &is_utf8);
-         len = tmplen;
-      }
+      /* See the note in hv_fetch(). --jhi */
+      str = (char*)bytes_from_utf8((U8*)str, &tmplen, &is_utf8);
+      len = tmplen;
     }
 
     /* what follows is the moral equivalent of:
@@ -1647,14 +1680,11 @@ Perl_share_hek(pTHX_ const char *str, I32 len, register U32 hash)
     const char *save = str;
 
     if (len < 0) {
-      len = -len;
+      STRLEN tmplen = -len;
       is_utf8 = TRUE;
-      if (!(PL_hints & HINT_UTF8_DISTINCT)) {
-         STRLEN tmplen = len;
-         /* See the note in hv_fetch(). --jhi */
-         str = (char*)bytes_from_utf8((U8*)str, &tmplen, &is_utf8);
-         len = tmplen;
-      }
+      /* See the note in hv_fetch(). --jhi */
+      str = (char*)bytes_from_utf8((U8*)str, &tmplen, &is_utf8);
+      len = tmplen;
     }
 
     /* what follows is the moral equivalent of: