LOCK_SV_MUTEX;
if (!*root)
S_more_he(aTHX);
- he = *root;
+ he = (HE*) *root;
assert(he);
*root = HeNEXT(he);
UNLOCK_SV_MUTEX;
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);
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);
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)
{
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:
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);
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;
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));
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;
flags = value_type;
#ifdef USE_ITHREADS
- he = PerlMemShared_malloc(sizeof(struct refcounted_he) - 1
- + key_len
- + key_offset);
+ he = (struct refcounted_he*)
+ PerlMemShared_malloc(sizeof(struct refcounted_he) - 1
+ + key_len
+ + key_offset);
#else
- he = PerlMemShared_malloc(sizeof(struct refcounted_he) - 1
- + key_offset);
+ he = (struct refcounted_he*)
+ PerlMemShared_malloc(sizeof(struct refcounted_he) - 1
+ + key_offset);
#endif