if (!*root)
S_more_he(aTHX);
he = *root;
+ assert(he);
*root = HeNEXT(he);
UNLOCK_SV_MUTEX;
return he;
HEK_KEY(hek)[len] = 0;
HEK_LEN(hek) = len;
HEK_HASH(hek) = hash;
- HEK_FLAGS(hek) = (unsigned char)flags_masked;
+ HEK_FLAGS(hek) = (unsigned char)flags_masked | HVhek_UNSHARED;
if (flags & HVhek_FREEKEY)
Safefree(str);
if (HeVAL(entry) && SvREADONLY(HeVAL(entry))) {
SV* const keysv = hv_iterkeysv(entry);
Perl_croak(aTHX_
- "Attempt to delete readonly key '%"SVf"' from a restricted hash",
- keysv);
+ "Attempt to delete readonly key '%"SVf"' from a restricted hash",
+ (void*)keysv);
}
SvREFCNT_dec(HeVAL(entry));
HeVAL(entry) = &PL_sv_placeholder;
hfreeentries(hv);
HvPLACEHOLDERS_set(hv, 0);
if (HvARRAY(hv))
- (void)memzero(HvARRAY(hv),
- (xhv->xhv_max+1 /* HvMAX(hv)+1 */) * sizeof(HE*));
+ Zero(HvARRAY(hv), xhv->xhv_max+1 /* HvMAX(hv)+1 */, HE*);
if (SvRMAGICAL(hv))
mg_clear((SV*)hv);
iter->xhv_eiter = NULL; /* HvEITER(hv) = NULL */
return NULL;
}
-#ifdef DYNAMIC_ENV_FETCH /* set up %ENV for iteration */
+#if defined(DYNAMIC_ENV_FETCH) && !defined(__riscos__) /* set up %ENV for iteration */
if (!entry && SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env)) {
prime_env_iter();
#ifdef VMS
HV *
Perl_refcounted_he_chain_2hv(pTHX_ const struct refcounted_he *chain)
{
+ dVAR;
HV *hv = newHV();
U32 placeholders = 0;
/* We could chase the chain once to get an idea of the number of keys,
break;
case HVrhek_IV:
value = (chain->refcounted_he_data[0] & HVrhek_UV)
- ? newSViv(chain->refcounted_he_val.refcounted_he_u_iv)
+ ? newSVuv(chain->refcounted_he_val.refcounted_he_u_iv)
: newSViv(chain->refcounted_he_val.refcounted_he_u_uv);
break;
case HVrhek_PV:
struct refcounted_he *
Perl_refcounted_he_new(pTHX_ struct refcounted_he *const parent,
SV *const key, SV *const value) {
+ dVAR;
struct refcounted_he *he;
STRLEN key_len;
const char *key_p = SvPV_const(key, key_len);
STRLEN value_len = 0;
- const char *value_p;
+ const char *value_p = NULL;
char value_type;
char flags;
STRLEN key_offset;
}
flags = value_type;
- he = PerlMemShared_malloc(sizeof(struct refcounted_he) - 1
#ifdef USE_ITHREADS
+ he = PerlMemShared_malloc(sizeof(struct refcounted_he) - 1
+ key_len
-#endif
+ key_offset);
+#else
+ he = PerlMemShared_malloc(sizeof(struct refcounted_he) - 1
+ + key_offset);
+#endif
he->refcounted_he_next = parent;
void
Perl_refcounted_he_free(pTHX_ struct refcounted_he *he) {
+ PERL_UNUSED_CONTEXT;
+
while (he) {
struct refcounted_he *copy;
U32 new_count;
void
Perl_hv_assert(pTHX_ HV *hv)
{
- dVAR;
- HE* entry;
- int withflags = 0;
- int placeholders = 0;
- int real = 0;
- int bad = 0;
- const I32 riter = HvRITER_get(hv);
- HE *eiter = HvEITER_get(hv);
-
- (void)hv_iterinit(hv);
-
- while ((entry = hv_iternext_flags(hv, HV_ITERNEXT_WANTPLACEHOLDERS))) {
- /* sanity check the values */
- if (HeVAL(entry) == &PL_sv_placeholder) {
- placeholders++;
- } else {
- real++;
- }
- /* sanity check the keys */
- if (HeSVKEY(entry)) {
- /*EMPTY*/ /* Don't know what to check on SV keys. */
- } else if (HeKUTF8(entry)) {
- withflags++;
- if (HeKWASUTF8(entry)) {
- PerlIO_printf(Perl_debug_log,
- "hash key has both WASUFT8 and UTF8: '%.*s'\n",
- (int) HeKLEN(entry), HeKEY(entry));
- bad = 1;
- }
- } else if (HeKWASUTF8(entry)) {
- withflags++;
- }
- }
- if (!SvTIED_mg((SV*)hv, PERL_MAGIC_tied)) {
- if (HvUSEDKEYS(hv) != real) {
- PerlIO_printf(Perl_debug_log, "Count %d key(s), but hash reports %d\n",
- (int) real, (int) HvUSEDKEYS(hv));
- bad = 1;
- }
- if (HvPLACEHOLDERS_get(hv) != placeholders) {
- PerlIO_printf(Perl_debug_log,
- "Count %d placeholder(s), but hash reports %d\n",
- (int) placeholders, (int) HvPLACEHOLDERS_get(hv));
- bad = 1;
- }
- }
- if (withflags && ! HvHASKFLAGS(hv)) {
- PerlIO_printf(Perl_debug_log,
- "Hash has HASKFLAGS off but I count %d key(s) with flags\n",
- withflags);
- bad = 1;
- }
- if (bad) {
- sv_dump((SV *)hv);
- }
- HvRITER_set(hv, riter); /* Restore hash iterator state */
- HvEITER_set(hv, eiter);
+ dVAR;
+ HE* entry;
+ int withflags = 0;
+ int placeholders = 0;
+ int real = 0;
+ int bad = 0;
+ const I32 riter = HvRITER_get(hv);
+ HE *eiter = HvEITER_get(hv);
+
+ (void)hv_iterinit(hv);
+
+ while ((entry = hv_iternext_flags(hv, HV_ITERNEXT_WANTPLACEHOLDERS))) {
+ /* sanity check the values */
+ if (HeVAL(entry) == &PL_sv_placeholder)
+ placeholders++;
+ else
+ real++;
+ /* sanity check the keys */
+ if (HeSVKEY(entry)) {
+ NOOP; /* Don't know what to check on SV keys. */
+ } else if (HeKUTF8(entry)) {
+ withflags++;
+ if (HeKWASUTF8(entry)) {
+ PerlIO_printf(Perl_debug_log,
+ "hash key has both WASUFT8 and UTF8: '%.*s'\n",
+ (int) HeKLEN(entry), HeKEY(entry));
+ bad = 1;
+ }
+ } else if (HeKWASUTF8(entry))
+ withflags++;
+ }
+ if (!SvTIED_mg((SV*)hv, PERL_MAGIC_tied)) {
+ static const char bad_count[] = "Count %d %s(s), but hash reports %d\n";
+ const int nhashkeys = HvUSEDKEYS(hv);
+ const int nhashplaceholders = HvPLACEHOLDERS_get(hv);
+
+ if (nhashkeys != real) {
+ PerlIO_printf(Perl_debug_log, bad_count, real, "keys", nhashkeys );
+ bad = 1;
+ }
+ if (nhashplaceholders != placeholders) {
+ PerlIO_printf(Perl_debug_log, bad_count, placeholders, "placeholder", nhashplaceholders );
+ bad = 1;
+ }
+ }
+ if (withflags && ! HvHASKFLAGS(hv)) {
+ PerlIO_printf(Perl_debug_log,
+ "Hash has HASKFLAGS off but I count %d key(s) with flags\n",
+ withflags);
+ bad = 1;
+ }
+ if (bad) {
+ sv_dump((SV *)hv);
+ }
+ HvRITER_set(hv, riter); /* Restore hash iterator state */
+ HvEITER_set(hv, eiter);
}
#endif