Tests to go with change #28628.

[perl5.git] / hv.c

diff --git a/hv.c b/hv.c
index 04439fa..1643515 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -436,6 +436,8 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
        return NULL;
 
     if (keysv) {
+       if (SvSMAGICAL(hv) && SvGMAGICAL(hv))
+           keysv = hv_magic_uvar_xkey(hv, keysv, action);
        if (flags & HVhek_FREEKEY)
            Safefree(key);
        key = SvPV_const(keysv, klen);
@@ -965,6 +967,8 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
        return NULL;
 
     if (keysv) {
+       if (SvSMAGICAL(hv) && SvGMAGICAL(hv))
+           keysv = hv_magic_uvar_xkey(hv, keysv, -1);
        if (k_flags & HVhek_FREEKEY)
            Safefree(key);
        key = SvPV_const(keysv, klen);
@@ -2511,6 +2515,24 @@ S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags)
     return HeKEY_hek(entry);
 }
 
+STATIC SV *
+S_hv_magic_uvar_xkey(pTHX_ HV* hv, SV* keysv, int action)
+{
+    MAGIC* mg;
+    if ((mg = mg_find((SV*)hv, PERL_MAGIC_uvar))) {
+       struct ufuncs * const uf = (struct ufuncs *)mg->mg_ptr;
+       if (uf->uf_set == NULL) {
+           SV* obj = mg->mg_obj;
+           mg->mg_obj = keysv;         /* pass key */
+           uf->uf_index = action;      /* pass action */
+           magic_getuvar((SV*)hv, mg);
+           keysv = mg->mg_obj;         /* may have changed */
+           mg->mg_obj = obj;
+       }
+    }
+    return keysv;
+}
+
 I32 *
 Perl_hv_placeholders_p(pTHX_ HV *hv)
 {
@@ -2555,6 +2577,7 @@ Perl_hv_placeholders_set(pTHX_ HV *hv, I32 ph)
 SV *
 S_refcounted_he_value(pTHX_ const struct refcounted_he *he)
 {
+    dVAR;
     SV *value;
     switch(he->refcounted_he_data[0] & HVrhek_typemask) {
     case HVrhek_undef:
@@ -2634,7 +2657,26 @@ Perl_refcounted_he_chain_2hv(pTHX_ const struct refcounted_he *chain)
 
        for (; entry; entry = HeNEXT(entry)) {
            if (HeHASH(entry) == hash) {
-               goto next_please;
+               /* We might have a duplicate key here.  If so, entry is older
+                  than the key we've already put in the hash, so if they are
+                  the same, skip adding entry.  */
+#ifdef USE_ITHREADS
+               const STRLEN klen = HeKLEN(entry);
+               const char *const key = HeKEY(entry);
+               if (klen == chain->refcounted_he_keylen
+                   && (!!HeKUTF8(entry)
+                       == !!(chain->refcounted_he_data[0] & HVhek_UTF8))
+                   && memEQ(key, REF_HE_KEY(chain), klen))
+                   goto next_please;
+#else
+               if (HeKEY_hek(entry) == chain->refcounted_he_hek)
+                   goto next_please;
+               if (HeKLEN(entry) == HEK_LEN(chain->refcounted_he_hek)
+                   && HeKUTF8(entry) == HEK_UTF8(chain->refcounted_he_hek)
+                   && memEQ(HeKEY(entry), HEK_KEY(chain->refcounted_he_hek),
+                            HeKLEN(entry)))
+                   goto next_please;
+#endif
            }
        }
        assert (!entry);
@@ -2687,15 +2729,20 @@ SV *
 Perl_refcounted_he_fetch(pTHX_ const struct refcounted_he *chain, SV *keysv,
                         const char *key, STRLEN klen, int flags, U32 hash)
 {
+    dVAR;
     /* Just to be awkward, if you're using this interface the UTF-8-or-not-ness
        of your key has to exactly match that which is stored.  */
     SV *value = &PL_sv_placeholder;
+    bool is_utf8;
 
     if (keysv) {
        if (flags & HVhek_FREEKEY)
            Safefree(key);
        key = SvPV_const(keysv, klen);
        flags = 0;
+       is_utf8 = (SvUTF8(keysv) != 0);
+    } else {
+       is_utf8 = ((flags & HVhek_UTF8) ? TRUE : FALSE);
     }
 
     if (!hash) {
@@ -2714,13 +2761,17 @@ Perl_refcounted_he_fetch(pTHX_ const struct refcounted_he *chain, SV *keysv,
            continue;
        if (memNE(REF_HE_KEY(chain),key,klen))
            continue;
+       if (!!is_utf8 != !!(chain->refcounted_he_data[0] & HVhek_UTF8))
+           continue;
 #else
        if (hash != HEK_HASH(chain->refcounted_he_hek))
            continue;
-       if (klen != HEK_LEN(chain->refcounted_he_hek))
+       if (klen != (STRLEN)HEK_LEN(chain->refcounted_he_hek))
            continue;
        if (memNE(HEK_KEY(chain->refcounted_he_hek),key,klen))
            continue;
+       if (!!is_utf8 != !!HEK_UTF8(chain->refcounted_he_hek))
+           continue;
 #endif
 
        value = sv_2mortal(refcounted_he_value(chain));
@@ -2756,7 +2807,7 @@ Perl_refcounted_he_new(pTHX_ struct refcounted_he *const parent,
     char flags;
     STRLEN key_offset;
     U32 hash;
-    bool is_utf8 = SvUTF8(key);
+    bool is_utf8 = SvUTF8(key) ? TRUE : FALSE;
 
     if (SvPOK(value)) {
        value_type = HVrhek_PV;