[win32] add archname to *sitearch in config.{b,g,v}c

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

diff --git a/hv.c b/hv.c
index f3ab6cc..5a0f9d2 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -16,8 +16,8 @@
 
 static void hsplit _((HV *hv));
 static void hfreeentries _((HV *hv));
-
-static HE* more_he(void);
+static void hv_magic_check _((HV *hv, bool *needs_copy, bool *needs_store));
+static HE* more_he _((void));
 
 static HE*
 new_he(void)
@@ -97,6 +97,19 @@ hv_fetch(HV *hv, char *key, U32 klen, I32 lval)
            Sv = sv;
            return &Sv;
        }
+#ifdef ENV_IS_CASELESS
+       else if (mg_find((SV*)hv,'E')) {
+           U32 i;
+           for (i = 0; i < klen; ++i)
+               if (isLOWER(key[i])) {
+                   char *nkey = strupr(SvPVX(sv_2mortal(newSVpv(key,klen))));
+                   SV **ret = hv_fetch(hv, nkey, klen, 0);
+                   if (!ret && lval)
+                       ret = hv_store(hv, key, klen, NEWSV(61,0), 0);
+                   return ret;
+               }
+       }
+#endif
     }
 
     xhv = (XPVHV*)SvANY(hv);
@@ -155,20 +168,37 @@ hv_fetch_ent(HV *hv, SV *keysv, I32 lval, register U32 hash)
     if (!hv)
        return 0;
 
-    if (SvRMAGICAL(hv) && mg_find((SV*)hv,'P')) {
-       static HE mh;
+    if (SvRMAGICAL(hv)) {
+       if (mg_find((SV*)hv,'P')) {
+           static HE mh;
 
-       sv = sv_newmortal();
-       keysv = sv_2mortal(newSVsv(keysv));
-       mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
-       if (!HeKEY_hek(&mh)) {
-           char *k;
-           New(54, k, HEK_BASESIZE + sizeof(SV*), char);
-           HeKEY_hek(&mh) = (HEK*)k;
+           sv = sv_newmortal();
+           keysv = sv_2mortal(newSVsv(keysv));
+           mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
+           if (!HeKEY_hek(&mh)) {
+               char *k;
+               New(54, k, HEK_BASESIZE + sizeof(SV*), char);
+               HeKEY_hek(&mh) = (HEK*)k;
+           }
+           HeSVKEY_set(&mh, keysv);
+           HeVAL(&mh) = sv;
+           return &mh;
        }
-       HeSVKEY_set(&mh, keysv);
-       HeVAL(&mh) = sv;
-       return &mh;
+#ifdef ENV_IS_CASELESS
+       else if (mg_find((SV*)hv,'E')) {
+           U32 i;
+           key = SvPV(keysv, klen);
+           for (i = 0; i < klen; ++i)
+               if (isLOWER(key[i])) {
+                   SV *nkeysv = sv_2mortal(newSVpv(key,klen));
+                   (void)strupr(SvPVX(nkeysv));
+                   entry = hv_fetch_ent(hv, nkeysv, 0, 0);
+                   if (!entry && lval)
+                       entry = hv_store_ent(hv, keysv, NEWSV(61,0), hash);
+                   return entry;
+               }
+       }
+#endif
     }
 
     xhv = (XPVHV*)SvANY(hv);
@@ -216,6 +246,25 @@ hv_fetch_ent(HV *hv, SV *keysv, I32 lval, register U32 hash)
     return 0;
 }
 
+static void
+hv_magic_check (HV *hv, bool *needs_copy, bool *needs_store)
+{
+    MAGIC *mg = SvMAGIC(hv);
+    *needs_copy = FALSE;
+    *needs_store = TRUE;
+    while (mg) {
+       if (isUPPER(mg->mg_type)) {
+           *needs_copy = TRUE;
+           switch (mg->mg_type) {
+           case 'P':
+           case 'S':
+               *needs_store = FALSE;
+           }
+       }
+       mg = mg->mg_moremagic;
+    }
+}
+
 SV**
 hv_store(HV *hv, char *key, U32 klen, SV *val, register U32 hash)
 {
@@ -229,15 +278,21 @@ hv_store(HV *hv, char *key, U32 klen, SV *val, register U32 hash)
 
     xhv = (XPVHV*)SvANY(hv);
     if (SvMAGICAL(hv)) {
-       mg_copy((SV*)hv, val, key, klen);
-       if (!xhv->xhv_array
-           && (SvMAGIC(hv)->mg_moremagic
-               || (SvMAGIC(hv)->mg_type != 'E'
-#ifdef OVERLOAD
-                   && SvMAGIC(hv)->mg_type != 'A'
-#endif /* OVERLOAD */
-                   )))
-           return 0;
+       bool needs_copy;
+       bool needs_store;
+       hv_magic_check (hv, &needs_copy, &needs_store);
+       if (needs_copy) {
+           mg_copy((SV*)hv, val, key, klen);
+           if (!xhv->xhv_array && !needs_store)
+               return 0;
+#ifdef ENV_IS_CASELESS
+           else if (mg_find((SV*)hv,'E')) {
+               SV *sv = sv_2mortal(newSVpv(key,klen));
+               key = strupr(SvPVX(sv));
+               hash = 0;
+           }
+#endif
+       }
     }
     if (!hash)
        PERL_HASH(hash, key, klen);
@@ -295,24 +350,31 @@ hv_store_ent(HV *hv, SV *keysv, SV *val, register U32 hash)
     xhv = (XPVHV*)SvANY(hv);
     if (SvMAGICAL(hv)) {
        dTHR;
-       bool save_taint = tainted;
-       if (tainting)
-           tainted = SvTAINTED(keysv);
-       keysv = sv_2mortal(newSVsv(keysv));
-       mg_copy((SV*)hv, val, (char*)keysv, HEf_SVKEY);
-       TAINT_IF(save_taint);
-       if (!xhv->xhv_array
-           && (SvMAGIC(hv)->mg_moremagic
-               || (SvMAGIC(hv)->mg_type != 'E'
-#ifdef OVERLOAD
-                   && SvMAGIC(hv)->mg_type != 'A'
-#endif /* OVERLOAD */
-                   )))
-         return Nullhe;
+       bool needs_copy;
+       bool needs_store;
+       hv_magic_check (hv, &needs_copy, &needs_store);
+       if (needs_copy) {
+           bool save_taint = tainted;
+           if (tainting)
+               tainted = SvTAINTED(keysv);
+           keysv = sv_2mortal(newSVsv(keysv));
+           mg_copy((SV*)hv, val, (char*)keysv, HEf_SVKEY);
+           TAINT_IF(save_taint);
+           if (!xhv->xhv_array && !needs_store)
+               return Nullhe;
+#ifdef ENV_IS_CASELESS
+           else if (mg_find((SV*)hv,'E')) {
+               key = SvPV(keysv, klen);
+               keysv = sv_2mortal(newSVpv(key,klen));
+               (void)strupr(SvPVX(keysv));
+               hash = 0;
+           }
+#endif
+       }
     }
 
     key = SvPV(keysv, klen);
-    
+
     if (!hash)
        PERL_HASH(hash, key, klen);
 
@@ -366,15 +428,27 @@ hv_delete(HV *hv, char *key, U32 klen, I32 flags)
     if (!hv)
        return Nullsv;
     if (SvRMAGICAL(hv)) {
-       sv = *hv_fetch(hv, key, klen, TRUE);
-       mg_clear(sv);
-       if (mg_find(sv, 's')) {
-           return Nullsv;              /* %SIG elements cannot be deleted */
-       }
-       if (mg_find(sv, 'p')) {
-           sv_unmagic(sv, 'p');        /* No longer an element */
-           return sv;
-       }
+       bool needs_copy;
+       bool needs_store;
+       hv_magic_check (hv, &needs_copy, &needs_store);
+
+       if (needs_copy) {
+           sv = *hv_fetch(hv, key, klen, TRUE);
+           mg_clear(sv);
+           if (!needs_store) {
+               if (mg_find(sv, 'p')) {
+                   sv_unmagic(sv, 'p');        /* No longer an element */
+                   return sv;
+               }
+               return Nullsv;          /* element cannot be deleted */
+           }
+#ifdef ENV_IS_CASELESS
+           else if (mg_find((SV*)hv,'E')) {
+               sv = sv_2mortal(newSVpv(key,klen));
+               key = strupr(SvPVX(sv));
+           }
+#endif
+        }
     }
     xhv = (XPVHV*)SvANY(hv);
     if (!xhv->xhv_array)
@@ -423,12 +497,29 @@ hv_delete_ent(HV *hv, SV *keysv, I32 flags, U32 hash)
     if (!hv)
        return Nullsv;
     if (SvRMAGICAL(hv)) {
-       entry = hv_fetch_ent(hv, keysv, TRUE, hash);
-       sv = HeVAL(entry);
-       mg_clear(sv);
-       if (mg_find(sv, 'p')) {
-           sv_unmagic(sv, 'p');        /* No longer an element */
-           return sv;
+       bool needs_copy;
+       bool needs_store;
+       hv_magic_check (hv, &needs_copy, &needs_store);
+
+       if (needs_copy) {
+           entry = hv_fetch_ent(hv, keysv, TRUE, hash);
+           sv = HeVAL(entry);
+           mg_clear(sv);
+           if (!needs_store) {
+               if (mg_find(sv, 'p')) {
+                   sv_unmagic(sv, 'p');        /* No longer an element */
+                   return sv;
+               }               
+               return Nullsv;          /* element cannot be deleted */
+           }
+#ifdef ENV_IS_CASELESS
+           else if (mg_find((SV*)hv,'E')) {
+               key = SvPV(keysv, klen);
+               keysv = sv_2mortal(newSVpv(key,klen));
+               (void)strupr(SvPVX(keysv));
+               hash = 0; 
+           }
+#endif
        }
     }
     xhv = (XPVHV*)SvANY(hv);
@@ -486,6 +577,12 @@ hv_exists(HV *hv, char *key, U32 klen)
            magic_existspack(sv, mg_find(sv, 'p'));
            return SvTRUE(sv);
        }
+#ifdef ENV_IS_CASELESS
+       else if (mg_find((SV*)hv,'E')) {
+           sv = sv_2mortal(newSVpv(key,klen));
+           key = strupr(SvPVX(sv));
+       }
+#endif
     }
 
     xhv = (XPVHV*)SvANY(hv);
@@ -529,6 +626,14 @@ hv_exists_ent(HV *hv, SV *keysv, U32 hash)
            magic_existspack(sv, mg_find(sv, 'p'));
            return SvTRUE(sv);
        }
+#ifdef ENV_IS_CASELESS
+       else if (mg_find((SV*)hv,'E')) {
+           key = SvPV(keysv, klen);
+           keysv = sv_2mortal(newSVpv(key,klen));
+           (void)strupr(SvPVX(keysv));
+           hash = 0; 
+       }
+#endif
     }
 
     xhv = (XPVHV*)SvANY(hv);
@@ -1068,3 +1173,4 @@ share_hek(char *str, I32 len, register U32 hash)
 }
 
 
+