X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=hv.c;h=95df7c8fb4e2638a1d56dcfda30abcf2cb8ae3f3;hb=869efde7048cf4e4bafcc463f8d4209a63e0d41a;hp=98120fd037c8c16946a02abfacfec7d193648e08;hpb=b9f83d2f7c4cb24d96302c6fcaa5e60628fad1f8;p=p5sagit%2Fp5-mst-13.2.git diff --git a/hv.c b/hv.c index 98120fd..95df7c8 100644 --- a/hv.c +++ b/hv.c @@ -40,12 +40,9 @@ STATIC void S_more_he(pTHX) { dVAR; - HE* he; - HE* heend; - - he = (HE*) Perl_get_arena(aTHX_ PERL_ARENA_SIZE, HE_SVSLOT); + HE* he = (HE*) Perl_get_arena(aTHX_ PERL_ARENA_SIZE, HE_SVSLOT); + HE * const heend = &he[PERL_ARENA_SIZE / sizeof(HE) - 1]; - heend = &he[PERL_ARENA_SIZE / sizeof(HE) - 1]; PL_body_roots[HE_SVSLOT] = he; while (he < heend) { HeNEXT(he) = (HE*)(he + 1); @@ -216,11 +213,6 @@ S_hv_notallowed(pTHX_ int flags, const char *key, I32 klen, /* (klen == HEf_SVKEY) is special for MAGICAL hv entries, meaning key slot * contains an SV* */ -#define HV_FETCH_ISSTORE 0x01 -#define HV_FETCH_ISEXISTS 0x02 -#define HV_FETCH_LVALUE 0x04 -#define HV_FETCH_JUST_SV 0x08 - /* =for apidoc hv_store @@ -244,39 +236,6 @@ hv_store_ent. See L for more information on how to use this function on tied hashes. -=cut -*/ - -SV** -Perl_hv_store(pTHX_ HV *hv, const char *key, I32 klen_i32, SV *val, U32 hash) -{ - HE *hek; - STRLEN klen; - int flags; - - if (klen_i32 < 0) { - klen = -klen_i32; - flags = HVhek_UTF8; - } else { - klen = klen_i32; - flags = 0; - } - hek = hv_fetch_common (hv, NULL, key, klen, flags, - (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, hash); - return hek ? &HeVAL(hek) : NULL; -} - -/* XXX This looks like an ideal candidate to inline */ -SV** -Perl_hv_store_flags(pTHX_ HV *hv, const char *key, I32 klen, SV *val, - register U32 hash, int flags) -{ - HE * const hek = hv_fetch_common (hv, NULL, key, klen, flags, - (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, hash); - return hek ? &HeVAL(hek) : NULL; -} - -/* =for apidoc hv_store_ent Stores C in a hash. The hash key is specified as C. The C @@ -302,43 +261,11 @@ hv_store in preference to hv_store_ent. See L for more information on how to use this function on tied hashes. -=cut -*/ - -/* XXX This looks like an ideal candidate to inline */ -HE * -Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, U32 hash) -{ - return hv_fetch_common(hv, keysv, NULL, 0, 0, HV_FETCH_ISSTORE, val, hash); -} - -/* =for apidoc hv_exists Returns a boolean indicating whether the specified hash key exists. The C is the length of the key. -=cut -*/ - -bool -Perl_hv_exists(pTHX_ HV *hv, const char *key, I32 klen_i32) -{ - STRLEN klen; - int flags; - - if (klen_i32 < 0) { - klen = -klen_i32; - flags = HVhek_UTF8; - } else { - klen = klen_i32; - flags = 0; - } - return hv_fetch_common(hv, NULL, key, klen, flags, HV_FETCH_ISEXISTS, 0, 0) - ? TRUE : FALSE; -} - -/* =for apidoc hv_fetch Returns the SV which corresponds to the specified key in the hash. The @@ -349,30 +276,6 @@ dereferencing it to an C. See L for more information on how to use this function on tied hashes. -=cut -*/ - -SV** -Perl_hv_fetch(pTHX_ HV *hv, const char *key, I32 klen_i32, I32 lval) -{ - HE *hek; - STRLEN klen; - int flags; - - if (klen_i32 < 0) { - klen = -klen_i32; - flags = HVhek_UTF8; - } else { - klen = klen_i32; - flags = 0; - } - hek = hv_fetch_common (hv, NULL, key, klen, flags, - lval ? (HV_FETCH_JUST_SV | HV_FETCH_LVALUE) : HV_FETCH_JUST_SV, - NULL, 0); - return hek ? &HeVAL(hek) : NULL; -} - -/* =for apidoc hv_exists_ent Returns a boolean indicating whether the specified hash key exists. C @@ -382,14 +285,6 @@ computed. =cut */ -/* XXX This looks like an ideal candidate to inline */ -bool -Perl_hv_exists_ent(pTHX_ HV *hv, SV *keysv, U32 hash) -{ - return hv_fetch_common(hv, keysv, NULL, 0, 0, HV_FETCH_ISEXISTS, 0, hash) - ? TRUE : FALSE; -} - /* returns an HE * structure with the all fields set */ /* note that hent_val will be a mortal sv for MAGICAL hashes */ /* @@ -409,16 +304,27 @@ information on how to use this function on tied hashes. =cut */ -HE * -Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, register U32 hash) +/* Common code for hv_delete()/hv_exists()/hv_fetch()/hv_store() */ +void * +Perl_hv_common_key_len(pTHX_ HV *hv, const char *key, I32 klen_i32, + const int action, SV *val, const U32 hash) { - return hv_fetch_common(hv, keysv, NULL, 0, 0, - (lval ? HV_FETCH_LVALUE : 0), NULL, hash); + STRLEN klen; + int flags; + + if (klen_i32 < 0) { + klen = -klen_i32; + flags = HVhek_UTF8; + } else { + klen = klen_i32; + flags = 0; + } + return hv_common(hv, NULL, key, klen, flags, action, val, hash); } -STATIC HE * -S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, - int flags, int action, SV *val, register U32 hash) +void * +Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, + int flags, int action, SV *val, register U32 hash) { dVAR; XPVHV* xhv; @@ -427,13 +333,41 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, SV *sv; bool is_utf8; int masked_flags; + const int return_svp = action & HV_FETCH_JUST_SV; if (!hv) return NULL; + if (SvTYPE(hv) == SVTYPEMASK) + return NULL; + + assert(SvTYPE(hv) == SVt_PVHV); + + if (SvSMAGICAL(hv) && SvGMAGICAL(hv) && !(action & HV_DISABLE_UVAR_XKEY)) { + 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; + if (!keysv) { + keysv = sv_2mortal(newSVpvn(key, klen)); + if (flags & HVhek_UTF8) + SvUTF8_on(keysv); + } + + 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; + + /* If the key may have changed, then we need to invalidate + any passed-in computed hash value. */ + hash = 0; + } + } + } 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); @@ -443,12 +377,18 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, is_utf8 = ((flags & HVhek_UTF8) ? TRUE : FALSE); } + if (action & HV_DELETE) { + return (void *) hv_delete_common(hv, keysv, key, klen, + flags | (is_utf8 ? HVhek_UTF8 : 0), + action, hash); + } + xhv = (XPVHV*)SvANY(hv); if (SvMAGICAL(hv)) { if (SvRMAGICAL(hv) && !(action & (HV_FETCH_ISSTORE|HV_FETCH_ISEXISTS))) { if ( mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) { - /* XXX should be able to skimp on the HE/HEK here when + /* FIXME should be able to skimp on the HE/HEK here when HV_FETCH_JUST_SV is true. */ if (!keysv) { keysv = newSVpvn(key, klen); @@ -483,7 +423,10 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, if (flags & HVhek_FREEKEY) Safefree(key); - return entry; + if (return_svp) { + return entry ? (void *) &HeVAL(entry) : NULL; + } + return (void *) entry; } #ifdef ENV_IS_CASELESS else if (mg_find((SV*)hv, PERL_MAGIC_env)) { @@ -495,23 +438,27 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, const char * const nkey = strupr(savepvn(key,klen)); /* Note that this fetch is for nkey (the uppercased key) whereas the store is for key (the original) */ - entry = hv_fetch_common(hv, NULL, nkey, klen, - HVhek_FREEKEY, /* free nkey */ - 0 /* non-LVAL fetch */, - NULL /* no value */, - 0 /* compute hash */); - if (!entry && (action & HV_FETCH_LVALUE)) { + void *result = hv_common(hv, NULL, nkey, klen, + HVhek_FREEKEY, /* free nkey */ + 0 /* non-LVAL fetch */ + | HV_DISABLE_UVAR_XKEY + | return_svp, + NULL /* no value */, + 0 /* compute hash */); + if (!result && (action & HV_FETCH_LVALUE)) { /* This call will free key if necessary. Do it this way to encourage compiler to tail call optimise. */ - entry = hv_fetch_common(hv, keysv, key, klen, - flags, HV_FETCH_ISSTORE, - newSV(0), hash); + result = hv_common(hv, keysv, key, klen, flags, + HV_FETCH_ISSTORE + | HV_DISABLE_UVAR_XKEY + | return_svp, + newSV(0), hash); } else { if (flags & HVhek_FREEKEY) Safefree(key); } - return entry; + return result; } } #endif @@ -540,7 +487,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, /* This cast somewhat evil, but I'm merely using NULL/ not NULL to return the boolean exists. And I know hv is not NULL. */ - return SvTRUE(svret) ? (HE *)hv : NULL; + return SvTRUE(svret) ? (void *)hv : NULL; } #ifdef ENV_IS_CASELESS else if (mg_find((SV*)hv, PERL_MAGIC_env)) { @@ -629,7 +576,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, if (flags & HVhek_FREEKEY) Safefree(key); - return 0; + return NULL; } } @@ -745,6 +692,9 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, } if (flags & HVhek_FREEKEY) Safefree(key); + if (return_svp) { + return entry ? (void *) &HeVAL(entry) : NULL; + } return entry; } #ifdef DYNAMIC_ENV_FETCH /* %ENV lookup? If so, try to fetch the value now */ @@ -755,8 +705,9 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, if (env) { sv = newSVpvn(env,len); SvTAINTED_on(sv); - return hv_fetch_common(hv,keysv,key,klen,flags,HV_FETCH_ISSTORE,sv, - hash); + return hv_common(hv, keysv, key, klen, flags, + HV_FETCH_ISSTORE|HV_DISABLE_UVAR_XKEY|return_svp, + sv, hash); } } #endif @@ -770,7 +721,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, /* Not doing some form of store, so return failure. */ if (flags & HVhek_FREEKEY) Safefree(key); - return 0; + return NULL; } if (action & HV_FETCH_LVALUE) { val = newSV(0); @@ -779,8 +730,15 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, which in turn might do some tied magic. So we need to make that magic check happen. */ /* gonna assign to this, so it better be there */ - return hv_fetch_common(hv, keysv, key, klen, flags, - HV_FETCH_ISSTORE, val, hash); + /* If a fetch-as-store fails on the fetch, then the action is to + recurse once into "hv_store". If we didn't do this, then that + recursive call would call the key conversion routine again. + However, as we replace the original key with the converted + key, this would result in a double conversion, which would show + up as a bug if the conversion routine is not idempotent. */ + return hv_common(hv, keysv, key, klen, flags, + HV_FETCH_ISSTORE|HV_DISABLE_UVAR_XKEY|return_svp, + val, hash); /* XXX Surely that could leak if the fetch-was-store fails? Just like the hv_fetch. */ } @@ -851,7 +809,10 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, } } - return entry; + if (return_svp) { + return entry ? (void *) &HeVAL(entry) : NULL; + } + return (void *) entry; } STATIC void @@ -909,26 +870,6 @@ hash and returned to the caller. The C is the length of the key. The C value will normally be zero; if set to G_DISCARD then NULL will be returned. -=cut -*/ - -SV * -Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen_i32, I32 flags) -{ - STRLEN klen; - int k_flags; - - if (klen_i32 < 0) { - klen = -klen_i32; - k_flags = HVhek_UTF8; - } else { - klen = klen_i32; - k_flags = 0; - } - return hv_delete_common(hv, NULL, key, klen, k_flags, flags, 0); -} - -/* =for apidoc hv_delete_ent Deletes a key/value pair in the hash. The value SV is removed from the @@ -939,13 +880,6 @@ precomputed hash value, or 0 to ask for it to be computed. =cut */ -/* XXX This looks like an ideal candidate to inline */ -SV * -Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash) -{ - return hv_delete_common(hv, keysv, NULL, 0, 0, flags, hash); -} - STATIC SV * S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, int k_flags, I32 d_flags, U32 hash) @@ -955,24 +889,9 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, register HE *entry; register HE **oentry; HE *const *first_entry; - bool is_utf8; + bool is_utf8 = (k_flags & HVhek_UTF8) ? TRUE : FALSE; int masked_flags; - if (!hv) - 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); - k_flags = 0; - is_utf8 = (SvUTF8(keysv) != 0); - } else { - is_utf8 = ((k_flags & HVhek_UTF8) ? TRUE : FALSE); - } - if (SvRMAGICAL(hv)) { bool needs_copy; bool needs_store; @@ -980,9 +899,10 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, if (needs_copy) { SV *sv; - entry = hv_fetch_common(hv, keysv, key, klen, - k_flags & ~HVhek_FREEKEY, HV_FETCH_LVALUE, - NULL, hash); + entry = (HE *) hv_common(hv, keysv, key, klen, + k_flags & ~HVhek_FREEKEY, + HV_FETCH_LVALUE|HV_DISABLE_UVAR_XKEY, + NULL, hash); sv = entry ? HeVAL(entry) : NULL; if (sv) { if (SvMAGICAL(sv)) { @@ -1129,7 +1049,7 @@ STATIC void S_hsplit(pTHX_ HV *hv) { dVAR; - register XPVHV* xhv = (XPVHV*)SvANY(hv); + register XPVHV* const xhv = (XPVHV*)SvANY(hv); const I32 oldsize = (I32) xhv->xhv_max+1; /* HvMAX(hv)+1 (sick) */ register I32 newsize = oldsize * 2; register I32 i; @@ -1477,9 +1397,9 @@ Perl_newHVhv(pTHX_ HV *ohv) hv_iterinit(ohv); while ((entry = hv_iternext_flags(ohv, 0))) { - hv_store_flags(hv, HeKEY(entry), HeKLEN(entry), - newSVsv(HeVAL(entry)), HeHASH(entry), - HeKFLAGS(entry)); + (void)hv_store_flags(hv, HeKEY(entry), HeKLEN(entry), + newSVsv(HeVAL(entry)), HeHASH(entry), + HeKFLAGS(entry)); } HvRITER_set(ohv, riter); HvEITER_set(ohv, eiter); @@ -1511,8 +1431,8 @@ Perl_hv_copy_hints_hv(pTHX_ HV *const ohv) SV *const sv = newSVsv(HeVAL(entry)); sv_magic(sv, NULL, PERL_MAGIC_hintselem, (char *)newSVhek (HeKEY_hek(entry)), HEf_SVKEY); - hv_store_flags(hv, HeKEY(entry), HeKLEN(entry), - sv, HeHASH(entry), HeKFLAGS(entry)); + (void)hv_store_flags(hv, HeKEY(entry), HeKLEN(entry), + sv, HeHASH(entry), HeKFLAGS(entry)); } HvRITER_set(ohv, riter); HvEITER_set(ohv, eiter); @@ -1531,7 +1451,7 @@ Perl_hv_free_ent(pTHX_ HV *hv, register HE *entry) return; val = HeVAL(entry); if (val && isGV(val) && GvCVu(val) && HvNAME_get(hv)) - PL_sub_generation++; /* may be deletion of method from stash */ + mro_method_changed_in(hv); /* deletion of method from stash */ SvREFCNT_dec(val); if (HeKLEN(entry) == HEf_SVKEY) { SvREFCNT_dec(HeKEY_sv(entry)); @@ -1613,6 +1533,8 @@ Perl_hv_clear(pTHX_ HV *hv) HvREHASH_off(hv); reset: if (SvOOK(hv)) { + if(HvNAME_get(hv)) + mro_isa_changed_in(hv); HvEITER_set(hv, NULL); } } @@ -1726,6 +1648,7 @@ S_hfreeentries(pTHX_ HV *hv) if (SvOOK(hv)) { HE *entry; + struct mro_meta *meta; struct xpvhv_aux *iter = HvAUX(hv); /* If there are weak references to this HV, we need to avoid freeing them up here. In particular we need to keep the AV @@ -1757,6 +1680,14 @@ S_hfreeentries(pTHX_ HV *hv) iter->xhv_riter = -1; /* HvRITER(hv) = -1 */ iter->xhv_eiter = NULL; /* HvEITER(hv) = NULL */ + if((meta = iter->xhv_mro_meta)) { + if(meta->mro_linear_dfs) SvREFCNT_dec(meta->mro_linear_dfs); + if(meta->mro_linear_c3) SvREFCNT_dec(meta->mro_linear_c3); + if(meta->mro_nextmethod) SvREFCNT_dec(meta->mro_nextmethod); + Safefree(meta); + iter->xhv_mro_meta = NULL; + } + /* There are now no allocated pointers in the aux structure. */ SvFLAGS(hv) &= ~SVf_OOK; /* Goodbye, aux structure. */ @@ -1840,10 +1771,14 @@ Perl_hv_undef(pTHX_ HV *hv) return; DEBUG_A(Perl_hv_assert(aTHX_ hv)); xhv = (XPVHV*)SvANY(hv); + + if ((name = HvNAME_get(hv)) && !PL_dirty) + mro_isa_changed_in(hv); + hfreeentries(hv); - if ((name = HvNAME_get(hv))) { - if(PL_stashcache) - hv_delete(PL_stashcache, name, HvNAMELEN_get(hv), G_DISCARD); + if (name) { + if (PL_stashcache) + (void)hv_delete(PL_stashcache, name, HvNAMELEN_get(hv), G_DISCARD); hv_name_set(hv, NULL, 0, 0); } SvFLAGS(hv) &= ~SVf_OOK; @@ -1878,6 +1813,7 @@ S_hv_auxinit(HV *hv) { iter->xhv_eiter = NULL; /* HvEITER(hv) = NULL */ iter->xhv_name = 0; iter->xhv_backreferences = 0; + iter->xhv_mro_meta = NULL; return iter; } @@ -2003,7 +1939,7 @@ Perl_hv_name_set(pTHX_ HV *hv, const char *name, U32 len, U32 flags) iter = hv_auxinit(hv); } PERL_HASH(hash, name, len); - iter->xhv_name = name ? share_hek(name, len, hash) : 0; + iter->xhv_name = name ? share_hek(name, len, hash) : NULL; } AV ** @@ -2289,6 +2225,7 @@ Perl_unsharepvn(pTHX_ const char *str, I32 len, U32 hash) void Perl_unshare_hek(pTHX_ HEK *hek) { + assert(hek); unshare_hek_or_pvn(hek, NULL, 0, 0); } @@ -2508,24 +2445,6 @@ 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) { @@ -2580,11 +2499,13 @@ S_refcounted_he_value(pTHX_ const struct refcounted_he *he) value = &PL_sv_placeholder; break; case HVrhek_IV: - value = (he->refcounted_he_data[0] & HVrhek_UV) - ? newSVuv(he->refcounted_he_val.refcounted_he_u_iv) - : newSViv(he->refcounted_he_val.refcounted_he_u_uv); + value = newSViv(he->refcounted_he_val.refcounted_he_u_iv); + break; + case HVrhek_UV: + value = newSVuv(he->refcounted_he_val.refcounted_he_u_uv); break; case HVrhek_PV: + case HVrhek_PV_UTF8: /* Create a string SV that directly points to the bytes in our structure. */ value = newSV_type(SVt_PV); @@ -2594,7 +2515,7 @@ S_refcounted_he_value(pTHX_ const struct refcounted_he *he) SvLEN_set(value, 0); SvPOK_on(value); SvREADONLY_on(value); - if (he->refcounted_he_data[0] & HVrhek_UTF8) + if ((he->refcounted_he_data[0] & HVrhek_typemask) == HVrhek_PV_UTF8) SvUTF8_on(value); break; default: @@ -2604,18 +2525,10 @@ S_refcounted_he_value(pTHX_ const struct refcounted_he *he) return value; } -#ifdef USE_ITHREADS -/* A big expression to find the key offset */ -#define REF_HE_KEY(chain) \ - ((((chain->refcounted_he_data[0] & HVrhek_typemask) == HVrhek_PV) \ - ? chain->refcounted_he_val.refcounted_he_u_len + 1 : 0) \ - + 1 + chain->refcounted_he_data) -#endif - /* =for apidoc refcounted_he_chain_2hv -Generates an returns a C by walking up the tree starting at the passed +Generates and returns a C by walking up the tree starting at the passed in C. =cut @@ -2820,7 +2733,6 @@ Perl_refcounted_he_new(pTHX_ struct refcounted_he *const parent, value_len = 0; key_offset = 1; } - flags = value_type; #ifdef USE_ITHREADS he = (struct refcounted_he*) @@ -2839,17 +2751,19 @@ Perl_refcounted_he_new(pTHX_ struct refcounted_he *const 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; - } + /* Do it this way so that the SvUTF8() test is after the SvPV, in case + the value is overloaded, and doesn't yet have the UTF-8flag set. */ + if (SvUTF8(value)) + value_type = HVrhek_PV_UTF8; } else if (value_type == HVrhek_IV) { if (SvUOK(value)) { he->refcounted_he_val.refcounted_he_u_uv = SvUVX(value); - flags |= HVrhek_UV; + value_type = HVrhek_UV; } else { he->refcounted_he_val.refcounted_he_u_iv = SvIVX(value); } } + flags = value_type; if (is_utf8) { /* Hash keys are always stored normalised to (yes) ISO-8859-1.