flags = is_utf8 ? HVhek_UTF8 : 0;
}
} else {
- is_utf8 = ((flags & HVhek_UTF8) ? TRUE : FALSE);
+ is_utf8 = cBOOL(flags & HVhek_UTF8);
}
if (action & HV_DELETE) {
if (!entry && SvREADONLY(hv) && !(action & HV_FETCH_ISEXISTS)) {
hv_notallowed(flags, key, klen,
- "Attempt to access disallowed key '%"SVf"' in"
+ "Attempt to access disallowed key '%" SVf "' in"
" a restricted hash");
}
if (!(action & (HV_FETCH_LVALUE|HV_FETCH_ISSTORE))) {
}
/*
-=for apidoc Perl_hv_bucket_ratio
+=for apidoc hv_bucket_ratio
If the hash is tied dispatches through to the SCALAR tied method,
otherwise if the hash contains no keys returns 0, otherwise returns
}
sv = sv_newmortal();
- if (HvUSEDKEYS((const HV *)hv))
+ if (HvUSEDKEYS((HV *)hv))
Perl_sv_setpvf(aTHX_ sv, "%ld/%ld",
(long)HvFILL(hv), (long)HvMAX(hv) + 1);
else
HE *entry;
HE **oentry;
HE **first_entry;
- bool is_utf8 = (k_flags & HVhek_UTF8) ? TRUE : FALSE;
+ bool is_utf8 = cBOOL(k_flags & HVhek_UTF8);
int masked_flags;
HEK *keysv_hek = NULL;
U8 mro_changes = 0; /* 1 = isa; 2 = package moved */
}
if (SvREADONLY(hv) && HeVAL(entry) && SvREADONLY(HeVAL(entry))) {
hv_notallowed(k_flags, key, klen,
- "Attempt to delete readonly key '%"SVf"' from"
+ "Attempt to delete readonly key '%" SVf "' from"
" a restricted hash");
}
if (k_flags & HVhek_FREEKEY)
sv_2mortal((SV *)gv)
);
}
- else if (klen == 3 && strnEQ(key, "ISA", 3) && GvAV(gv)) {
+ else if (klen == 3 && strEQs(key, "ISA") && GvAV(gv)) {
AV *isa = GvAV(gv);
MAGIC *mg = mg_find((SV*)isa, PERL_MAGIC_isa);
not_found:
if (SvREADONLY(hv)) {
hv_notallowed(k_flags, key, klen,
- "Attempt to delete disallowed key '%"SVf"' from"
+ "Attempt to delete disallowed key '%" SVf "' from"
" a restricted hash");
}
Perl_hv_clear(pTHX_ HV *hv)
{
dVAR;
+ SSize_t orig_ix;
+
XPVHV* xhv;
if (!hv)
return;
xhv = (XPVHV*)SvANY(hv);
- ENTER;
- SAVEFREESV(SvREFCNT_inc_simple_NN(hv));
+ /* avoid hv being freed when calling destructors below */
+ EXTEND_MORTAL(1);
+ PL_tmps_stack[++PL_tmps_ix] = SvREFCNT_inc_simple_NN(hv);
+ orig_ix = PL_tmps_ix;
if (SvREADONLY(hv) && HvARRAY(hv) != NULL) {
/* restricted hash: convert all keys to placeholders */
STRLEN i;
if (SvREADONLY(HeVAL(entry))) {
SV* const keysv = hv_iterkeysv(entry);
Perl_croak_nocontext(
- "Attempt to delete readonly key '%"SVf"' from a restricted hash",
+ "Attempt to delete readonly key '%" SVf "' from a restricted hash",
(void*)keysv);
}
SvREFCNT_dec_NN(HeVAL(entry));
mro_isa_changed_in(hv);
HvEITER_set(hv, NULL);
}
- LEAVE;
+ /* disarm hv's premature free guard */
+ if (LIKELY(PL_tmps_ix == orig_ix))
+ PL_tmps_ix--;
+ else
+ PL_tmps_stack[orig_ix] = &PL_sv_undef;
+ SvREFCNT_dec_NN(hv);
}
/*
{
XPVHV* xhv;
bool save;
+ SSize_t orig_ix;
if (!hv)
return;
- save = !!SvREFCNT(hv);
+ save = cBOOL(SvREFCNT(hv));
DEBUG_A(Perl_hv_assert(aTHX_ hv));
xhv = (XPVHV*)SvANY(hv);
if (PL_phase != PERL_PHASE_DESTRUCT && HvNAME(hv)) {
if (PL_stashcache) {
DEBUG_o(Perl_deb(aTHX_ "hv_undef_flags clearing PL_stashcache for '%"
- HEKf"'\n", HEKfARG(HvNAME_HEK(hv))));
+ HEKf "'\n", HEKfARG(HvNAME_HEK(hv))));
(void)hv_deletehek(PL_stashcache, HvNAME_HEK(hv), G_DISCARD);
}
hv_name_set(hv, NULL, 0, 0);
}
if (save) {
- ENTER;
- SAVEFREESV(SvREFCNT_inc_simple_NN(hv));
+ /* avoid hv being freed when calling destructors below */
+ EXTEND_MORTAL(1);
+ PL_tmps_stack[++PL_tmps_ix] = SvREFCNT_inc_simple_NN(hv);
+ orig_ix = PL_tmps_ix;
}
hfreeentries(hv);
if (SvOOK(hv)) {
mro_isa_changed_in(hv);
if (PL_stashcache) {
DEBUG_o(Perl_deb(aTHX_ "hv_undef_flags clearing PL_stashcache for effective name '%"
- HEKf"'\n", HEKfARG(HvENAME_HEK(hv))));
+ HEKf "'\n", HEKfARG(HvENAME_HEK(hv))));
(void)hv_deletehek(PL_stashcache, HvENAME_HEK(hv), G_DISCARD);
}
}
if (flags & HV_NAME_SETALL ? !!HvAUX(hv)->xhv_name_u.xhvnameu_name : !!name) {
if (name && PL_stashcache) {
DEBUG_o(Perl_deb(aTHX_ "hv_undef_flags clearing PL_stashcache for name '%"
- HEKf"'\n", HEKfARG(HvNAME_HEK(hv))));
+ HEKf "'\n", HEKfARG(HvNAME_HEK(hv))));
(void)hv_deletehek(PL_stashcache, HvNAME_HEK(hv), G_DISCARD);
}
hv_name_set(hv, NULL, 0, flags);
if (SvRMAGICAL(hv))
mg_clear(MUTABLE_SV(hv));
- if (save) LEAVE;
+
+ if (save) {
+ /* disarm hv's premature free guard */
+ if (LIKELY(PL_tmps_ix == orig_ix))
+ PL_tmps_ix--;
+ else
+ PL_tmps_stack[orig_ix] = &PL_sv_undef;
+ SvREFCNT_dec_NN(hv);
+ }
}
/*
STRLEN count = 0;
HE **ents = HvARRAY(hv);
+ PERL_UNUSED_CONTEXT;
PERL_ARGS_ASSERT_HV_FILL;
/* No keys implies no buckets used.
=for apidoc hv_iterinit
Prepares a starting point to traverse a hash table. Returns the number of
-keys in the hash (i.e. the same as C<HvUSEDKEYS(hv)>). The return value is
-currently only meaningful for hashes without tie magic.
+keys in the hash, including placeholders (i.e. the same as C<HvTOTALKEYS(hv)>).
+The return value is 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
PERL_ARGS_ASSERT_HV_NAME_SET;
if (len > I32_MAX)
- Perl_croak(aTHX_ "panic: hv name too long (%"UVuf")", (UV) len);
+ Perl_croak(aTHX_ "panic: hv name too long (%" UVuf ")", (UV) len);
if (SvOOK(hv)) {
iter = HvAUX(hv);
PERL_ARGS_ASSERT_HV_ENAME_ADD;
if (len > I32_MAX)
- Perl_croak(aTHX_ "panic: hv name too long (%"UVuf")", (UV) len);
+ Perl_croak(aTHX_ "panic: hv name too long (%" UVuf ")", (UV) len);
PERL_HASH(hash, name, len);
PERL_ARGS_ASSERT_HV_ENAME_DELETE;
if (len > I32_MAX)
- Perl_croak(aTHX_ "panic: hv name too long (%"UVuf")", (UV) len);
+ Perl_croak(aTHX_ "panic: hv name too long (%" UVuf ")", (UV) len);
if (!SvOOK(hv)) return;
SvUTF8_on(value);
break;
default:
- Perl_croak(aTHX_ "panic: refcounted_he_value bad flags %"UVxf,
+ Perl_croak(aTHX_ "panic: refcounted_he_value bad flags %" UVxf,
(UV)he->refcounted_he_data[0]);
}
return value;
U32 placeholders, max;
if (flags)
- Perl_croak(aTHX_ "panic: refcounted_he_chain_2hv bad flags %"UVxf,
+ Perl_croak(aTHX_ "panic: refcounted_he_chain_2hv bad flags %" UVxf,
(UV)flags);
/* We could chase the chain once to get an idea of the number of keys,
PERL_ARGS_ASSERT_REFCOUNTED_HE_FETCH_PVN;
if (flags & ~(REFCOUNTED_HE_KEY_UTF8|REFCOUNTED_HE_EXISTS))
- Perl_croak(aTHX_ "panic: refcounted_he_fetch_pvn bad flags %"UVxf,
+ Perl_croak(aTHX_ "panic: refcounted_he_fetch_pvn bad flags %" UVxf,
(UV)flags);
if (!chain)
goto ret;
STRLEN keylen;
PERL_ARGS_ASSERT_REFCOUNTED_HE_FETCH_SV;
if (flags & REFCOUNTED_HE_KEY_UTF8)
- Perl_croak(aTHX_ "panic: refcounted_he_fetch_sv bad flags %"UVxf,
+ Perl_croak(aTHX_ "panic: refcounted_he_fetch_sv bad flags %" UVxf,
(UV)flags);
keypv = SvPV_const(key, keylen);
if (SvUTF8(key))
STRLEN keylen;
PERL_ARGS_ASSERT_REFCOUNTED_HE_NEW_SV;
if (flags & REFCOUNTED_HE_KEY_UTF8)
- Perl_croak(aTHX_ "panic: refcounted_he_new_sv bad flags %"UVxf,
+ Perl_croak(aTHX_ "panic: refcounted_he_new_sv bad flags %" UVxf,
(UV)flags);
keypv = SvPV_const(key, keylen);
if (SvUTF8(key))