#define PERL_IN_HV_C
#include "perl.h"
+
STATIC HE*
S_new_he(pTHX)
{
{
char *k;
register HEK *hek;
-
+
New(54, k, HEK_BASESIZE + len + 1, char);
hek = (HEK*)k;
Copy(str, HEK_KEY(hek), len, char);
Returns the SV which corresponds to the specified key in the hash. The
C<klen> is the length of the key. If C<lval> is set then the fetch will be
part of a store. Check that the return value is non-null before
-dereferencing it to a C<SV*>.
+dereferencing it to a C<SV*>.
See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for more
information on how to use this function on tied hashes.
xhv = (XPVHV*)SvANY(hv);
if (!xhv->xhv_array) {
- if (lval
+ if (lval
#ifdef DYNAMIC_ENV_FETCH /* if it's an %ENV lookup, we may get it on the fly */
|| (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME))
#endif
continue;
if (HeKLEN(entry) != klen)
continue;
- if (memNE(HeKEY(entry),key,klen)) /* is this it? */
+ if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */
continue;
return &HeVAL(entry);
}
will be part of a store. Make sure the return value is non-null before
accessing it. The return value when C<tb> is a tied hash is a pointer to a
static location, so be sure to make a copy of the structure if you need to
-store it somewhere.
+store it somewhere.
See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for more
information on how to use this function on tied hashes.
xhv = (XPVHV*)SvANY(hv);
if (!xhv->xhv_array) {
- if (lval
+ if (lval
#ifdef DYNAMIC_ENV_FETCH /* if it's an %ENV lookup, we may get it on the fly */
|| (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME))
#endif
}
key = SvPV(keysv, klen);
-
+
if (!hash)
PERL_HASH(hash, key, klen);
continue;
if (HeKLEN(entry) != klen)
continue;
- if (memNE(HeKEY(entry),key,klen)) /* is this it? */
+ if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */
continue;
return entry;
}
stored within the hash (as in the case of tied hashes). Otherwise it can
be dereferenced to get the original C<SV*>. 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.
+the call, and decrementing it if the function returned NULL.
See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for more
information on how to use this function on tied hashes.
continue;
if (HeKLEN(entry) != klen)
continue;
- if (memNE(HeKEY(entry),key,klen)) /* is this it? */
+ if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */
continue;
SvREFCNT_dec(HeVAL(entry));
HeVAL(entry) = val;
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.
+decrementing it if the function returned NULL.
See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for more
information on how to use this function on tied hashes.
continue;
if (HeKLEN(entry) != klen)
continue;
- if (memNE(HeKEY(entry),key,klen)) /* is this it? */
+ if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */
continue;
SvREFCNT_dec(HeVAL(entry));
HeVAL(entry) = val;
=for apidoc hv_delete
Deletes a key/value pair in the hash. The value SV is removed from the
-hash and returned to the caller. The C<klen> is the length of the key.
+hash and returned to the caller. The C<klen> is the length of the key.
The C<flags> value will normally be zero; if set to G_DISCARD then NULL
will be returned.
continue;
if (HeKLEN(entry) != klen)
continue;
- if (memNE(HeKEY(entry),key,klen)) /* is this it? */
+ if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */
continue;
*oentry = HeNEXT(entry);
if (i && !*oentry)
register HE *entry;
register HE **oentry;
SV *sv;
-
+
if (!hv)
return Nullsv;
if (SvRMAGICAL(hv)) {
key = SvPV(keysv, klen);
keysv = sv_2mortal(newSVpvn(key,klen));
(void)strupr(SvPVX(keysv));
- hash = 0;
+ hash = 0;
}
#endif
}
return Nullsv;
key = SvPV(keysv, klen);
-
+
if (!hash)
PERL_HASH(hash, key, klen);
continue;
if (HeKLEN(entry) != klen)
continue;
- if (memNE(HeKEY(entry),key,klen)) /* is this it? */
+ if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */
continue;
*oentry = HeNEXT(entry);
if (i && !*oentry)
if (mg_find((SV*)hv,'P')) {
dTHR;
sv = sv_newmortal();
- mg_copy((SV*)hv, sv, key, klen);
+ mg_copy((SV*)hv, sv, key, klen);
magic_existspack(sv, mg_find(sv, 'p'));
return SvTRUE(sv);
}
xhv = (XPVHV*)SvANY(hv);
#ifndef DYNAMIC_ENV_FETCH
if (!xhv->xhv_array)
- return 0;
+ return 0;
#endif
PERL_HASH(hash, key, klen);
continue;
if (HeKLEN(entry) != klen)
continue;
- if (memNE(HeKEY(entry),key,klen)) /* is this it? */
+ if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */
continue;
return TRUE;
}
dTHR; /* just for SvTRUE */
sv = sv_newmortal();
keysv = sv_2mortal(newSVsv(keysv));
- mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
+ mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
magic_existspack(sv, mg_find(sv, 'p'));
return SvTRUE(sv);
}
key = SvPV(keysv, klen);
keysv = sv_2mortal(newSVpvn(key,klen));
(void)strupr(SvPVX(keysv));
- hash = 0;
+ hash = 0;
}
#endif
}
xhv = (XPVHV*)SvANY(hv);
#ifndef DYNAMIC_ENV_FETCH
if (!xhv->xhv_array)
- return 0;
+ return 0;
#endif
key = SvPV(keysv, klen);
continue;
if (HeKLEN(entry) != klen)
continue;
- if (memNE(HeKEY(entry),key,klen)) /* is this it? */
+ if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */
continue;
return TRUE;
}
xhv = (XPVHV*)SvANY(hv);
SvPOK_off(hv);
SvNOK_off(hv);
-#ifndef NODEFAULT_SHAREKEYS
+#ifndef NODEFAULT_SHAREKEYS
HvSHAREKEYS_on(hv); /* key-sharing on by default */
-#endif
+#endif
xhv->xhv_max = 7; /* start with 8 buckets */
xhv->xhv_fill = 0;
xhv->xhv_pmroot = 0;
#if 0
if (! SvTIED_mg((SV*)ohv, 'P')) {
/* Quick way ???*/
- }
- else
+ }
+ else
#endif
{
HE *entry;
/* Slow way */
hv_iterinit(ohv);
while ((entry = hv_iternext(ohv))) {
- hv_store(hv, HeKEY(entry), HeKLEN(entry),
+ hv_store(hv, HeKEY(entry), HeKLEN(entry),
SvREFCNT_inc(HeVAL(entry)), HeHASH(entry));
}
HvRITER(ohv) = hv_riter;
HvEITER(ohv) = hv_eiter;
}
-
+
return hv;
}
(void)memzero(xhv->xhv_array, (xhv->xhv_max + 1) * sizeof(HE*));
if (SvRMAGICAL(hv))
- mg_clear((SV*)hv);
+ mg_clear((SV*)hv);
}
STATIC void
if (++riter > max)
break;
entry = array[riter];
- }
+ }
}
(void)hv_iterinit(hv);
}
xhv->xhv_keys = 0;
if (SvRMAGICAL(hv))
- mg_clear((SV*)hv);
+ mg_clear((SV*)hv);
}
/*
Prepares a starting point to traverse a hash table. Returns the number of
keys in the hash (i.e. the same as C<HvKEYS(tb)>). The return value is
-currently only meaningful for hashes without tie magic.
+currently only meaningful for hashes without tie magic.
NOTE: Before version 5.004_65, C<hv_iterinit> used to return the number of
hash buckets that happen to be in use. If you still need that esoteric
{
if (HeKLEN(entry) == HEf_SVKEY)
return sv_mortalcopy(HeKEY_sv(entry));
- else
- return sv_2mortal(newSVpvn((HeKLEN(entry) ? HeKEY(entry) : ""),
- HeKLEN(entry)));
+ else {
+ return sv_2mortal(newSVpvn_share((HeKLEN(entry) ? HeKEY(entry) : ""),
+ HeKLEN(entry), HeHASH(entry)));
+ }
}
/*
register HE **oentry;
register I32 i = 1;
I32 found = 0;
-
+
/* what follows is the moral equivalent of:
if ((Svp = hv_fetch(PL_strtab, tmpsv, FALSE, hash))) {
if (--*Svp == Nullsv)
continue;
if (HeKLEN(entry) != len)
continue;
- if (memNE(HeKEY(entry),str,len)) /* is this it? */
+ if (HeKEY(entry) != str && memNE(HeKEY(entry),str,len)) /* is this it? */
continue;
found = 1;
if (--HeVAL(entry) == Nullsv) {
break;
}
UNLOCK_STRTAB_MUTEX;
-
+
{
dTHR;
if (!found && ckWARN_d(WARN_INTERNAL))
- Perl_warner(aTHX_ WARN_INTERNAL, "Attempt to free non-existent shared string");
+ Perl_warner(aTHX_ WARN_INTERNAL, "Attempt to free non-existent shared string '%s'",str);
}
}
I32 found = 0;
/* what follows is the moral equivalent of:
-
+
if (!(Svp = hv_fetch(PL_strtab, str, len, FALSE)))
hv_store(PL_strtab, str, len, Nullsv, hash);
*/
continue;
if (HeKLEN(entry) != len)
continue;
- if (memNE(HeKEY(entry),str,len)) /* is this it? */
+ if (HeKEY(entry) != str && memNE(HeKEY(entry),str,len)) /* is this it? */
continue;
found = 1;
break;
https://perl5.git.perl.org / perl5.git / blobdiff