/* hv.c
*
- * Copyright (c) 1991-2000, Larry Wall
+ * Copyright (c) 1991-2001, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
{
char *k;
register HEK *hek;
+ bool is_utf8 = FALSE;
+
+ if (len < 0) {
+ len = -len;
+ is_utf8 = TRUE;
+ }
New(54, k, HEK_BASESIZE + len + 1, char);
hek = (HEK*)k;
Copy(str, HEK_KEY(hek), len, char);
- *(HEK_KEY(hek) + len) = '\0';
HEK_LEN(hek) = len;
HEK_HASH(hek) = hash;
+ HEK_UTF8(hek) = (char)is_utf8;
return hek;
}
void
Perl_unshare_hek(pTHX_ HEK *hek)
{
- unsharepvn(HEK_KEY(hek),HEK_LEN(hek),HEK_HASH(hek));
+ unsharepvn(HEK_KEY(hek),HEK_UTF8(hek)?-HEK_LEN(hek):HEK_LEN(hek),
+ HEK_HASH(hek));
}
#if defined(USE_ITHREADS)
if (HeKLEN(e) == HEf_SVKEY)
HeKEY_sv(ret) = SvREFCNT_inc(sv_dup(HeKEY_sv(e)));
else if (shared)
- HeKEY_hek(ret) = share_hek(HeKEY(e), HeKLEN(e), HeHASH(e));
+ HeKEY_hek(ret) = share_hek(HeKEY(e), HeKLEN_UTF8(e), HeHASH(e));
else
- HeKEY_hek(ret) = save_hek(HeKEY(e), HeKLEN(e), HeHASH(e));
+ HeKEY_hek(ret) = save_hek(HeKEY(e), HeKLEN_UTF8(e), HeHASH(e));
HeVAL(ret) = SvREFCNT_inc(sv_dup(HeVAL(e)));
return ret;
}
*/
SV**
-Perl_hv_fetch(pTHX_ HV *hv, const char *key, U32 klen, I32 lval)
+Perl_hv_fetch(pTHX_ HV *hv, const char *key, I32 klen, I32 lval)
{
register XPVHV* xhv;
register U32 hash;
register HE *entry;
SV *sv;
+ bool is_utf8 = FALSE;
+ const char *keysave = key;
if (!hv)
return 0;
+ if (klen < 0) {
+ klen = -klen;
+ is_utf8 = TRUE;
+ }
+
if (SvRMAGICAL(hv)) {
- if (mg_find((SV*)hv,'P')) {
- dTHR;
+ if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) {
sv = sv_newmortal();
mg_copy((SV*)hv, sv, key, klen);
PL_hv_fetch_sv = sv;
return &PL_hv_fetch_sv;
}
#ifdef ENV_IS_CASELESS
- else if (mg_find((SV*)hv,'E')) {
+ else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
U32 i;
for (i = 0; i < klen; ++i)
if (isLOWER(key[i])) {
return 0;
}
+ if (is_utf8 && !(PL_hints & HINT_UTF8_DISTINCT)) {
+ STRLEN tmplen = klen;
+ /* Just casting the &klen to (STRLEN) won't work well
+ * if STRLEN and I32 are of different widths. --jhi */
+ key = (char*)bytes_from_utf8((U8*)key, &tmplen, &is_utf8);
+ klen = tmplen;
+ }
+
PERL_HASH(hash, key, klen);
entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
continue;
if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */
continue;
+ if (HeKUTF8(entry) != (char)is_utf8)
+ continue;
+ if (key != keysave)
+ Safefree(key);
return &HeVAL(entry);
}
#ifdef DYNAMIC_ENV_FETCH /* %ENV lookup? If so, try to fetch the value now */
if (env) {
sv = newSVpvn(env,len);
SvTAINTED_on(sv);
+ if (key != keysave)
+ Safefree(key);
return hv_store(hv,key,klen,sv,hash);
}
}
#endif
if (lval) { /* gonna assign to this, so it better be there */
sv = NEWSV(61,0);
- return hv_store(hv,key,klen,sv,hash);
+ if (key != keysave) { /* must be is_utf8 == 0 */
+ SV **ret = hv_store(hv,key,klen,sv,hash);
+ Safefree(key);
+ return ret;
+ }
+ else
+ return hv_store(hv,key,is_utf8?-klen:klen,sv,hash);
}
+ if (key != keysave)
+ Safefree(key);
return 0;
}
STRLEN klen;
register HE *entry;
SV *sv;
+ bool is_utf8;
+ char *keysave;
if (!hv)
return 0;
- if (SvUTF8((SV*)hv) && !SvUTF8(keysv))
- sv_utf8_upgrade(keysv);
-
if (SvRMAGICAL(hv)) {
- if (mg_find((SV*)hv,'P')) {
- dTHR;
+ if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) {
sv = sv_newmortal();
keysv = sv_2mortal(newSVsv(keysv));
mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
return &PL_hv_fetch_ent_mh;
}
#ifdef ENV_IS_CASELESS
- else if (mg_find((SV*)hv,'E')) {
+ else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
U32 i;
key = SvPV(keysv, klen);
for (i = 0; i < klen; ++i)
return 0;
}
- key = SvPV(keysv, klen);
+ keysave = key = SvPV(keysv, klen);
+ is_utf8 = (SvUTF8(keysv)!=0);
+
+ if (is_utf8 && !(PL_hints & HINT_UTF8_DISTINCT))
+ key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
if (!hash)
PERL_HASH(hash, key, klen);
continue;
if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */
continue;
+ if (HeKUTF8(entry) != (char)is_utf8)
+ continue;
+ if (key != keysave)
+ Safefree(key);
return entry;
}
#ifdef DYNAMIC_ENV_FETCH /* %ENV lookup? If so, try to fetch the value now */
}
}
#endif
+ if (key != keysave)
+ Safefree(key);
if (lval) { /* gonna assign to this, so it better be there */
sv = NEWSV(61,0);
return hv_store_ent(hv,keysv,sv,hash);
if (isUPPER(mg->mg_type)) {
*needs_copy = TRUE;
switch (mg->mg_type) {
- case 'P':
- case 'S':
+ case PERL_MAGIC_tied:
+ case PERL_MAGIC_sig:
*needs_store = FALSE;
}
}
*/
SV**
-Perl_hv_store(pTHX_ HV *hv, const char *key, U32 klen, SV *val, register U32 hash)
+Perl_hv_store(pTHX_ HV *hv, const char *key, I32 klen, SV *val, register U32 hash)
{
register XPVHV* xhv;
register I32 i;
register HE *entry;
register HE **oentry;
+ bool is_utf8 = FALSE;
+ const char *keysave = key;
if (!hv)
return 0;
+ if (klen < 0) {
+ klen = -klen;
+ is_utf8 = TRUE;
+ }
+
xhv = (XPVHV*)SvANY(hv);
if (SvMAGICAL(hv)) {
bool needs_copy;
if (!xhv->xhv_array && !needs_store)
return 0;
#ifdef ENV_IS_CASELESS
- else if (mg_find((SV*)hv,'E')) {
- SV *sv = sv_2mortal(newSVpvn(key,klen));
- key = strupr(SvPVX(sv));
+ else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
+ key = savepvn(key,klen);
+ key = strupr(key);
hash = 0;
}
#endif
}
}
+ if (is_utf8 && !(PL_hints & HINT_UTF8_DISTINCT)) {
+ STRLEN tmplen = klen;
+ /* See the note in hv_fetch(). --jhi */
+ key = (char*)bytes_from_utf8((U8*)key, &tmplen, &is_utf8);
+ klen = tmplen;
+ }
+
if (!hash)
PERL_HASH(hash, key, klen);
continue;
if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */
continue;
+ if (HeKUTF8(entry) != (char)is_utf8)
+ continue;
SvREFCNT_dec(HeVAL(entry));
HeVAL(entry) = val;
+ if (key != keysave)
+ Safefree(key);
return &HeVAL(entry);
}
entry = new_HE();
if (HvSHAREKEYS(hv))
- HeKEY_hek(entry) = share_hek(key, klen, hash);
+ HeKEY_hek(entry) = share_hek(key, is_utf8?-klen:klen, hash);
else /* gotta do the real thing */
- HeKEY_hek(entry) = save_hek(key, klen, hash);
+ HeKEY_hek(entry) = save_hek(key, is_utf8?-klen:klen, hash);
+ if (key != keysave)
+ Safefree(key);
HeVAL(entry) = val;
HeNEXT(entry) = *oentry;
*oentry = entry;
compute it. The return value is the new hash entry so created. It will be
NULL if the operation failed or if the value did not need to be actually
stored within the hash (as in the case of tied hashes). Otherwise the
-contents of the return value can be accessed using the C<He???> macros
+contents of the return value can be accessed using the C<He?> macros
described here. Note that the caller is responsible for suitably
incrementing the reference count of C<val> before the call, and
decrementing it if the function returned NULL.
register I32 i;
register HE *entry;
register HE **oentry;
+ bool is_utf8;
+ char *keysave;
if (!hv)
return 0;
xhv = (XPVHV*)SvANY(hv);
-
- if (SvUTF8((SV*)hv) && !SvUTF8(keysv))
- sv_utf8_upgrade(keysv);
- else if (SvUTF8(keysv) && !SvUTF8((SV*)hv)) { /* Upgrade hash */
- SvUTF8_on((SV*)hv);
- /* XXX Need to save iterator to prevent weird things during "each" */
- (void)hv_iterinit(hv);
- while (entry = hv_iternext(hv)) {
- if (HeKLEN(entry) != HEf_SVKEY) /* Upgrade to SV key */
- HeSVKEY_set(entry, newSVpvn(HeKEY(entry), HeKLEN(entry)));
- sv_utf8_upgrade(HeKEY_sv(entry));
- }
- }
-
if (SvMAGICAL(hv)) {
- dTHR;
bool needs_copy;
bool needs_store;
hv_magic_check (hv, &needs_copy, &needs_store);
if (!xhv->xhv_array && !needs_store)
return Nullhe;
#ifdef ENV_IS_CASELESS
- else if (mg_find((SV*)hv,'E')) {
+ else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
key = SvPV(keysv, klen);
keysv = sv_2mortal(newSVpvn(key,klen));
(void)strupr(SvPVX(keysv));
}
}
- key = SvPV(keysv, klen);
+ keysave = key = SvPV(keysv, klen);
+ is_utf8 = (SvUTF8(keysv) != 0);
+
+ if (is_utf8 && !(PL_hints & HINT_UTF8_DISTINCT))
+ key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
if (!hash)
PERL_HASH(hash, key, klen);
continue;
if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */
continue;
+ if (HeKUTF8(entry) != (char)is_utf8)
+ continue;
SvREFCNT_dec(HeVAL(entry));
HeVAL(entry) = val;
+ if (key != keysave)
+ Safefree(key);
return entry;
}
entry = new_HE();
if (HvSHAREKEYS(hv))
- HeKEY_hek(entry) = share_hek(key, klen, hash);
+ HeKEY_hek(entry) = share_hek(key, is_utf8?-klen:klen, hash);
else /* gotta do the real thing */
- HeKEY_hek(entry) = save_hek(key, klen, hash);
+ HeKEY_hek(entry) = save_hek(key, is_utf8?-klen:klen, hash);
+ if (key != keysave)
+ Safefree(key);
HeVAL(entry) = val;
HeNEXT(entry) = *oentry;
*oentry = entry;
*/
SV *
-Perl_hv_delete(pTHX_ HV *hv, const char *key, U32 klen, I32 flags)
+Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen, I32 flags)
{
register XPVHV* xhv;
register I32 i;
register HE **oentry;
SV **svp;
SV *sv;
+ bool is_utf8 = FALSE;
+ const char *keysave = key;
if (!hv)
return Nullsv;
+ if (klen < 0) {
+ klen = -klen;
+ is_utf8 = TRUE;
+ }
if (SvRMAGICAL(hv)) {
bool needs_copy;
bool needs_store;
sv = *svp;
mg_clear(sv);
if (!needs_store) {
- if (mg_find(sv, 'p')) {
- sv_unmagic(sv, 'p'); /* No longer an element */
+ if (mg_find(sv, PERL_MAGIC_tiedelem)) {
+ /* No longer an element */
+ sv_unmagic(sv, PERL_MAGIC_tiedelem);
return sv;
}
return Nullsv; /* element cannot be deleted */
}
#ifdef ENV_IS_CASELESS
- else if (mg_find((SV*)hv,'E')) {
+ else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
sv = sv_2mortal(newSVpvn(key,klen));
key = strupr(SvPVX(sv));
}
if (!xhv->xhv_array)
return Nullsv;
+ if (is_utf8 && !(PL_hints & HINT_UTF8_DISTINCT)) {
+ STRLEN tmplen = klen;
+ /* See the note in hv_fetch(). --jhi */
+ key = (char*)bytes_from_utf8((U8*)key, &tmplen, &is_utf8);
+ klen = tmplen;
+ }
+
PERL_HASH(hash, key, klen);
oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
continue;
if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */
continue;
+ if (HeKUTF8(entry) != (char)is_utf8)
+ continue;
+ if (key != keysave)
+ Safefree(key);
*oentry = HeNEXT(entry);
if (i && !*oentry)
xhv->xhv_fill--;
--xhv->xhv_keys;
return sv;
}
+ if (key != keysave)
+ Safefree(key);
return Nullsv;
}
register HE *entry;
register HE **oentry;
SV *sv;
+ bool is_utf8;
+ char *keysave;
if (!hv)
return Nullsv;
sv = HeVAL(entry);
mg_clear(sv);
if (!needs_store) {
- if (mg_find(sv, 'p')) {
- sv_unmagic(sv, 'p'); /* No longer an element */
+ if (mg_find(sv, PERL_MAGIC_tiedelem)) {
+ /* No longer an element */
+ sv_unmagic(sv, PERL_MAGIC_tiedelem);
return sv;
}
return Nullsv; /* element cannot be deleted */
}
#ifdef ENV_IS_CASELESS
- else if (mg_find((SV*)hv,'E')) {
+ else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
key = SvPV(keysv, klen);
keysv = sv_2mortal(newSVpvn(key,klen));
(void)strupr(SvPVX(keysv));
if (!xhv->xhv_array)
return Nullsv;
- key = SvPV(keysv, klen);
+ keysave = key = SvPV(keysv, klen);
+ is_utf8 = (SvUTF8(keysv) != 0);
+
+ if (is_utf8 && !(PL_hints & HINT_UTF8_DISTINCT))
+ key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
if (!hash)
PERL_HASH(hash, key, klen);
continue;
if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */
continue;
+ if (HeKUTF8(entry) != (char)is_utf8)
+ continue;
+ if (key != keysave)
+ Safefree(key);
*oentry = HeNEXT(entry);
if (i && !*oentry)
xhv->xhv_fill--;
--xhv->xhv_keys;
return sv;
}
+ if (key != keysave)
+ Safefree(key);
return Nullsv;
}
*/
bool
-Perl_hv_exists(pTHX_ HV *hv, const char *key, U32 klen)
+Perl_hv_exists(pTHX_ HV *hv, const char *key, I32 klen)
{
register XPVHV* xhv;
register U32 hash;
register HE *entry;
SV *sv;
+ bool is_utf8 = FALSE;
+ const char *keysave = key;
if (!hv)
return 0;
+ if (klen < 0) {
+ klen = -klen;
+ is_utf8 = TRUE;
+ }
+
if (SvRMAGICAL(hv)) {
- if (mg_find((SV*)hv,'P')) {
- dTHR;
+ if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) {
sv = sv_newmortal();
mg_copy((SV*)hv, sv, key, klen);
- magic_existspack(sv, mg_find(sv, 'p'));
+ magic_existspack(sv, mg_find(sv, PERL_MAGIC_tiedelem));
return SvTRUE(sv);
}
#ifdef ENV_IS_CASELESS
- else if (mg_find((SV*)hv,'E')) {
+ else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
sv = sv_2mortal(newSVpvn(key,klen));
key = strupr(SvPVX(sv));
}
return 0;
#endif
+ if (is_utf8 && !(PL_hints & HINT_UTF8_DISTINCT)) {
+ STRLEN tmplen = klen;
+ /* See the note in hv_fetch(). --jhi */
+ key = (char*)bytes_from_utf8((U8*)key, &tmplen, &is_utf8);
+ klen = tmplen;
+ }
+
PERL_HASH(hash, key, klen);
#ifdef DYNAMIC_ENV_FETCH
continue;
if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */
continue;
+ if (HeKUTF8(entry) != (char)is_utf8)
+ continue;
+ if (key != keysave)
+ Safefree(key);
return TRUE;
}
#ifdef DYNAMIC_ENV_FETCH /* is it out there? */
}
}
#endif
+ if (key != keysave)
+ Safefree(key);
return FALSE;
}
STRLEN klen;
register HE *entry;
SV *sv;
+ bool is_utf8;
+ char *keysave;
if (!hv)
return 0;
if (SvRMAGICAL(hv)) {
- if (mg_find((SV*)hv,'P')) {
- dTHR; /* just for SvTRUE */
+ if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) {
+ SV* svret = sv_newmortal();
sv = sv_newmortal();
keysv = sv_2mortal(newSVsv(keysv));
mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
- magic_existspack(sv, mg_find(sv, 'p'));
- return SvTRUE(sv);
+ magic_existspack(svret, mg_find(sv, PERL_MAGIC_tiedelem));
+ return SvTRUE(svret);
}
#ifdef ENV_IS_CASELESS
- else if (mg_find((SV*)hv,'E')) {
+ else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
key = SvPV(keysv, klen);
keysv = sv_2mortal(newSVpvn(key,klen));
(void)strupr(SvPVX(keysv));
return 0;
#endif
- key = SvPV(keysv, klen);
+ keysave = key = SvPV(keysv, klen);
+ is_utf8 = (SvUTF8(keysv) != 0);
+ if (is_utf8 && !(PL_hints & HINT_UTF8_DISTINCT))
+ key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
if (!hash)
PERL_HASH(hash, key, klen);
continue;
if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */
continue;
+ if (HeKUTF8(entry) != (char)is_utf8)
+ continue;
+ if (key != keysave)
+ Safefree(key);
return TRUE;
}
#ifdef DYNAMIC_ENV_FETCH /* is it out there? */
}
}
#endif
+ if (key != keysave)
+ Safefree(key);
return FALSE;
}
return;
}
#else
-#define MALLOC_OVERHEAD 16
New(2, a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
if (!a) {
PL_nomemok = FALSE;
return hv;
#if 0
- if (! SvTIED_mg((SV*)ohv, 'P')) {
+ if (! SvTIED_mg((SV*)ohv, PERL_MAGIC_tied)) {
/* Quick way ???*/
}
else
/* Slow way */
hv_iterinit(ohv);
while ((entry = hv_iternext(ohv))) {
- hv_store(hv, HeKEY(entry), HeKLEN(entry),
- SvREFCNT_inc(HeVAL(entry)), HeHASH(entry));
+ hv_store(hv, HeKEY(entry), HeKLEN_UTF8(entry),
+ newSVsv(HeVAL(entry)), HeHASH(entry));
}
HvRITER(ohv) = hv_riter;
HvEITER(ohv) = hv_eiter;
xhv = (XPVHV*)SvANY(hv);
oldentry = entry = xhv->xhv_eiter;
- if ((mg = SvTIED_mg((SV*)hv, 'P'))) {
+ if ((mg = SvTIED_mg((SV*)hv, PERL_MAGIC_tied))) {
SV *key = sv_newmortal();
if (entry) {
sv_setsv(key, HeSVKEY_force(entry));
{
if (HeKLEN(entry) == HEf_SVKEY)
return sv_mortalcopy(HeKEY_sv(entry));
- else {
+ else
return sv_2mortal(newSVpvn_share((HeKLEN(entry) ? HeKEY(entry) : ""),
- HeKLEN(entry), HeHASH(entry)));
- }
+ HeKLEN_UTF8(entry), HeHASH(entry)));
}
/*
Perl_hv_iterval(pTHX_ HV *hv, register HE *entry)
{
if (SvRMAGICAL(hv)) {
- if (mg_find((SV*)hv,'P')) {
+ if (mg_find((SV*)hv, PERL_MAGIC_tied)) {
SV* sv = sv_newmortal();
if (HeKLEN(entry) == HEf_SVKEY)
mg_copy((SV*)hv, sv, (char*)HeKEY_sv(entry), HEf_SVKEY);
register HE **oentry;
register I32 i = 1;
I32 found = 0;
+ bool is_utf8 = FALSE;
+ const char *save = str;
+
+ if (len < 0) {
+ len = -len;
+ is_utf8 = TRUE;
+ if (!(PL_hints & HINT_UTF8_DISTINCT)) {
+ STRLEN tmplen = len;
+ /* See the note in hv_fetch(). --jhi */
+ str = (char*)bytes_from_utf8((U8*)str, &tmplen, &is_utf8);
+ len = tmplen;
+ }
+ }
/* what follows is the moral equivalent of:
if ((Svp = hv_fetch(PL_strtab, tmpsv, FALSE, hash))) {
continue;
if (HeKEY(entry) != str && memNE(HeKEY(entry),str,len)) /* is this it? */
continue;
+ if (HeKUTF8(entry) != (char)is_utf8)
+ continue;
found = 1;
if (--HeVAL(entry) == Nullsv) {
*oentry = HeNEXT(entry);
break;
}
UNLOCK_STRTAB_MUTEX;
-
- {
- dTHR;
- if (!found && ckWARN_d(WARN_INTERNAL))
- Perl_warner(aTHX_ WARN_INTERNAL, "Attempt to free non-existent shared string '%s'",str);
- }
+ if (str != save)
+ Safefree(str);
+ if (!found && ckWARN_d(WARN_INTERNAL))
+ Perl_warner(aTHX_ WARN_INTERNAL, "Attempt to free non-existent shared string '%s'",str);
}
/* get a (constant) string ptr from the global string table
register HE **oentry;
register I32 i = 1;
I32 found = 0;
+ bool is_utf8 = FALSE;
+ const char *save = str;
+
+ if (len < 0) {
+ len = -len;
+ is_utf8 = TRUE;
+ if (!(PL_hints & HINT_UTF8_DISTINCT)) {
+ STRLEN tmplen = len;
+ /* See the note in hv_fetch(). --jhi */
+ str = (char*)bytes_from_utf8((U8*)str, &tmplen, &is_utf8);
+ len = tmplen;
+ }
+ }
/* what follows is the moral equivalent of:
continue;
if (HeKEY(entry) != str && memNE(HeKEY(entry),str,len)) /* is this it? */
continue;
+ if (HeKUTF8(entry) != (char)is_utf8)
+ continue;
found = 1;
break;
}
if (!found) {
entry = new_HE();
- HeKEY_hek(entry) = save_hek(str, len, hash);
+ HeKEY_hek(entry) = save_hek(str, is_utf8?-len:len, hash);
HeVAL(entry) = Nullsv;
HeNEXT(entry) = *oentry;
*oentry = entry;
++HeVAL(entry); /* use value slot as REFCNT */
UNLOCK_STRTAB_MUTEX;
+ if (str != save)
+ Safefree(str);
return HeKEY_hek(entry);
}
-
-
-
https://perl5.git.perl.org / perl5.git / blobdiff