Add tests for all the other types that %^H serialisation is supposed
[p5sagit/p5-mst-13.2.git] / hv.c
diff --git a/hv.c b/hv.c
index af8fe67..f0f9c39 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -2578,18 +2578,13 @@ Perl_refcounted_he_chain_2hv(pTHX_ const struct refcounted_he *chain)
 
     while (chain) {
 #ifdef USE_ITHREADS
-       SV *const sv = *(av_fetch(chain->refcounted_he_pad,
-                                 chain->refcounted_he_hek, FALSE));
-       U32 hash = SvSHARED_HASH(sv);
+       U32 hash = chain->refcounted_he_hash;
 #else
        U32 hash = HEK_HASH(chain->refcounted_he_hek);
 #endif
        HE **oentry = &((HvARRAY(hv))[hash & max]);
        HE *entry = *oentry;
-
-#ifdef USE_ITHREADS
-       assert(SvIsCOW_shared_hash(sv));
-#endif
+       SV *value;
 
        for (; entry; entry = HeNEXT(entry)) {
            if (HeHASH(entry) == hash) {
@@ -2601,17 +2596,51 @@ Perl_refcounted_he_chain_2hv(pTHX_ const struct refcounted_he *chain)
 
 #ifdef USE_ITHREADS
        HeKEY_hek(entry)
-           = share_hek_hek(SvSHARED_HEK_FROM_PV(SvPVX_const(sv)));
-       HeVAL(entry) = *(av_fetch(chain->refcounted_he_pad,
-                                 chain->refcounted_he_val, FALSE));
+           = share_hek_flags(/* A big expression to find the key offset */
+                             (((chain->refcounted_he_data[0]
+                                & HVrhek_typemask) == HVrhek_PV)
+                              ? chain->refcounted_he_val.refcounted_he_u_len
+                              + 1 : 0) + 1 + chain->refcounted_he_data,
+                             chain->refcounted_he_keylen,
+                             chain->refcounted_he_hash,
+                             (chain->refcounted_he_data[0]
+                              & (HVhek_UTF8|HVhek_WASUTF8)));
 #else
        HeKEY_hek(entry) = share_hek_hek(chain->refcounted_he_hek);
-       HeVAL(entry) = chain->refcounted_he_val;
 #endif
 
-       if (HeVAL(entry) == &PL_sv_placeholder)
+       switch(chain->refcounted_he_data[0] & HVrhek_typemask) {
+       case HVrhek_undef:
+           value = newSV(0);
+           break;
+       case HVrhek_delete:
+           value = &PL_sv_placeholder;
            placeholders++;
-       SvREFCNT_inc_void_NN(HeVAL(entry));
+           break;
+       case HVrhek_IV:
+           value = (chain->refcounted_he_data[0] & HVrhek_UV)
+               ? newSVuv(chain->refcounted_he_val.refcounted_he_u_iv)
+               : newSViv(chain->refcounted_he_val.refcounted_he_u_uv);
+           break;
+       case HVrhek_PV:
+           /* Create a string SV that directly points to the bytes in our
+              structure.  */
+           value = newSV(0);
+           sv_upgrade(value, SVt_PV);
+           SvPV_set(value, (char *) chain->refcounted_he_data + 1);
+           SvCUR_set(value, chain->refcounted_he_val.refcounted_he_u_len);
+           /* This stops anything trying to free it  */
+           SvLEN_set(value, 0);
+           SvPOK_on(value);
+           SvREADONLY_on(value);
+           if (chain->refcounted_he_data[0] & HVrhek_UTF8)
+               SvUTF8_on(value);
+           break;
+       default:
+           Perl_croak(aTHX_ "panic: refcounted_he_chain_2hv bad flags %x",
+                      chain->refcounted_he_data[0]);
+       }
+       HeVAL(entry) = value;
 
        /* Link it into the chain.  */
        HeNEXT(entry) = *oentry;
@@ -2656,30 +2685,85 @@ struct refcounted_he *
 Perl_refcounted_he_new(pTHX_ struct refcounted_he *const parent,
                       SV *const key, SV *const value) {
     struct refcounted_he *he;
+    STRLEN key_len;
+    const char *key_p = SvPV_const(key, key_len);
+    STRLEN value_len = 0;
+    const char *value_p;
+    char value_type;
+    char flags;
+    STRLEN key_offset;
     U32 hash;
-    STRLEN len;
-    const char *p = SvPV_const(key, len);
+    bool is_utf8 = SvUTF8(key);
+
+    if (SvPOK(value)) {
+       value_type = HVrhek_PV;
+    } else if (SvIOK(value)) {
+       value_type = HVrhek_IV;
+    } else if (value == &PL_sv_placeholder) {
+       value_type = HVrhek_delete;
+    } else if (!SvOK(value)) {
+       value_type = HVrhek_undef;
+    } else {
+       value_type = HVrhek_PV;
+    }
+
+    if (value_type == HVrhek_PV) {
+       value_p = SvPV_const(value, value_len);
+       key_offset = value_len + 2;
+    } else {
+       value_len = 0;
+       key_offset = 1;
+    }
+    flags = value_type;
 
-    PERL_HASH(hash, p, len);
+    he = PerlMemShared_malloc(sizeof(struct refcounted_he) - 1
+#ifdef USE_ITHREADS
+                             + key_len
+#endif
+                             + key_offset);
 
-    Newx(he, 1, struct refcounted_he);
 
     he->refcounted_he_next = parent;
+
+    if (value_type == HVrhek_PV) {
+       Copy(value_p, he->refcounted_he_data + 1, value_len + 1, char);
+       he->refcounted_he_val.refcounted_he_u_len = value_len;
+       if (SvUTF8(value)) {
+           flags |= HVrhek_UTF8;
+       }
+    } else if (value_type == HVrhek_IV) {
+       if (SvUOK(value)) {
+           he->refcounted_he_val.refcounted_he_u_uv = SvUVX(value);
+           flags |= HVrhek_UV;
+       } else {
+           he->refcounted_he_val.refcounted_he_u_iv = SvIVX(value);
+       }
+    }
+
+    if (is_utf8) {
+       /* Hash keys are always stored normalised to (yes) ISO-8859-1.
+          As we're going to be building hash keys from this value in future,
+          normalise it now.  */
+       key_p = (char*)bytes_from_utf8((const U8*)key_p, &key_len, &is_utf8);
+       flags |= is_utf8 ? HVhek_UTF8 : HVhek_WASUTF8;
+    }
+    PERL_HASH(hash, key_p, key_len);
+
 #ifdef USE_ITHREADS
-    he->refcounted_he_hek = pad_alloc(OP_CUSTOM, SVs_PADTMP);
-    SvREFCNT_dec(PAD_SVl(he->refcounted_he_hek));
-    PAD_SETSV(he->refcounted_he_hek,
-             newSVpvn_share(p, SvUTF8(key) ? -(I32)len : len, hash));
-    he->refcounted_he_val = pad_alloc(OP_CUSTOM, SVs_PADTMP);
-    SvREFCNT_dec(PAD_SVl(he->refcounted_he_val));
-    PAD_SETSV(he->refcounted_he_val, value);
-    he->refcounted_he_pad = PL_comppad;
-    /* FIXME. This is wrong, but without it t/op/caller.t fails.  */
-    SvREFCNT_inc_simple_void_NN(he->refcounted_he_pad);
+    he->refcounted_he_hash = hash;
+    he->refcounted_he_keylen = key_len;
+    Copy(key_p, he->refcounted_he_data + key_offset, key_len, char);
 #else
-    he->refcounted_he_val = value;
-    he->refcounted_he_hek = share_hek(p, SvUTF8(key) ? -(I32)len : len, hash);
+    he->refcounted_he_hek = share_hek_flags(key_p, key_len, hash, flags);
 #endif
+
+    if (flags & HVhek_WASUTF8) {
+       /* If it was downgraded from UTF-8, then the pointer returned from
+          bytes_from_utf8 is an allocated pointer that we must free.  */
+       Safefree(key_p);
+    }
+
+    he->refcounted_he_data[0] = flags;
     he->refcounted_he_refcnt = 1;
 
     return he;
@@ -2709,87 +2793,15 @@ Perl_refcounted_he_free(pTHX_ struct refcounted_he *he) {
            return;
        }
 
-#ifdef USE_ITHREADS
-       /* FIXME as above */
-       SvREFCNT_dec(he->refcounted_he_pad);
-#else
+#ifndef USE_ITHREADS
        unshare_hek_or_pvn (he->refcounted_he_hek, 0, 0, 0);
-       SvREFCNT_dec(he->refcounted_he_val);
 #endif
        copy = he;
        he = he->refcounted_he_next;
-       Safefree(copy);
+       PerlMemShared_free(copy);
     }
 }
 
-
-/*
-=for apidoc refcounted_he_dup
-
-Duplicates the C<struct refcounted_he *> for a new thread.
-
-=cut
-*/
-
-#if 0
-struct refcounted_he *
-Perl_refcounted_he_dup(pTHX_ const struct refcounted_he *const he,
-                       CLONE_PARAMS* param)
-{
-    struct refcounted_he *copy;
-
-    if (!he)
-       return NULL;
-
-    /* look for it in the table first */
-    copy = (struct refcounted_he *)ptr_table_fetch(PL_ptr_table, he);
-    if (copy)
-       return copy;
-
-    /* create anew and remember what it is */
-    Newx(copy, 1, struct refcounted_he);
-    ptr_table_store(PL_ptr_table, he, copy);
-
-    copy->refcounted_he_next
-       = Perl_refcounted_he_dup(aTHX_ he->refcounted_he_next, param);
-    copy->refcounted_he_val
-       = SvREFCNT_inc(sv_dup(he->refcounted_he_val, param));
-    copy->refcounted_he_hek = hek_dup(he->refcounted_he_hek, param);
-    copy->refcounted_he_refcnt = he->refcounted_he_refcnt;
-    return copy;
-}
-
-/*
-=for apidoc refcounted_he_copy
-
-Copies a chain of C<struct refcounted_he *>. Used by C<pp_entereval>.
-
-=cut
-*/
-
-struct refcounted_he *
-Perl_refcounted_he_copy(pTHX_ const struct refcounted_he * he)
-{
-    struct refcounted_he *copy;
-    HEK *hek;
-    /* This is much easier to express recursively than iteratively.  */
-    if (!he)
-       return NULL;
-
-    Newx(copy, 1, struct refcounted_he);
-    copy->refcounted_he_next
-       = Perl_refcounted_he_copy(aTHX_ he->refcounted_he_next);
-    copy->refcounted_he_val = newSVsv(he->refcounted_he_val);
-    hek = he->refcounted_he_hek;
-    copy->refcounted_he_hek
-       = share_hek(HEK_KEY(hek),
-                   HEK_UTF8(hek) ? -(I32)HEK_LEN(hek) : HEK_LEN(hek),
-                   HEK_HASH(hek));
-    copy->refcounted_he_refcnt = 1;
-    return copy;
-}
-#endif
-
 /*
 =for apidoc hv_assert