static void
Perl_hv_notallowed(pTHX_ bool is_utf8, const char *key, I32 klen,
- const char *keysave)
+ const char *keysave, const char *msg)
{
SV *sv = sv_newmortal();
if (key == keysave) {
if (is_utf8) {
SvUTF8_on(sv);
}
- Perl_croak(aTHX_ "Attempt to access key '%"SVf"' in fixed hash",sv);
+ Perl_croak(aTHX_ msg, sv);
}
/* (klen == HEf_SVKEY) is special for MAGICAL hv entries, meaning key slot
}
#endif
if (!entry && SvREADONLY(hv)) {
- Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave);
+ Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave,
+ "Attempt to access disallowed key '%"SVf"' in a fixed hash"
+ );
}
if (lval) { /* gonna assign to this, so it better be there */
sv = NEWSV(61,0);
}
#endif
if (!entry && SvREADONLY(hv)) {
- Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave);
+ Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave,
+ "Attempt to access disallowed key '%"SVf"' in a fixed hash"
+ );
}
if (key != keysave)
Safefree(key);
#endif
}
}
+
if (is_utf8) {
STRLEN tmplen = klen;
/* See the note in hv_fetch(). --jhi */
key = (char*)bytes_from_utf8((U8*)key, &tmplen, &is_utf8);
klen = tmplen;
+ HvUTF8KEYS_on((SV*)hv);
}
if (!hash)
}
if (SvREADONLY(hv)) {
- Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave);
+ Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave,
+ "Attempt to access disallowed key '%"SVf"' to a fixed hash"
+ );
}
entry = new_HE();
keysave = key = SvPV(keysv, klen);
is_utf8 = (SvUTF8(keysv) != 0);
- if (is_utf8)
+ if (is_utf8) {
key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
+ HvUTF8KEYS_on((SV*)hv);
+ }
if (!hash)
PERL_HASH(hash, key, klen);
}
if (SvREADONLY(hv)) {
- Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave);
+ Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave,
+ "Attempt to access disallowed key '%"SVf"' to a fixed hash"
+ );
}
entry = new_HE();
else
hv_free_ent(hv, entry);
xhv->xhv_keys--; /* HvKEYS(hv)-- */
+ if (xhv->xhv_keys == 0)
+ HvUTF8KEYS_off(hv);
xhv->xhv_placeholders--;
return Nullsv;
}
}
else if (SvREADONLY(hv) && HeVAL(entry) && SvREADONLY(HeVAL(entry))) {
- Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave);
+ Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave,
+ "Attempt to delete readonly key '%"SVf"' from a fixed hash"
+ );
}
if (flags & G_DISCARD)
else
hv_free_ent(hv, entry);
xhv->xhv_keys--; /* HvKEYS(hv)-- */
+ if (xhv->xhv_keys == 0)
+ HvUTF8KEYS_off(hv);
}
return sv;
}
if (SvREADONLY(hv)) {
- Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave);
+ Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave,
+ "Attempt to access disallowed key '%"SVf"' from a fixed hash"
+ );
}
if (key != keysave)
else
hv_free_ent(hv, entry);
xhv->xhv_keys--; /* HvKEYS(hv)-- */
+ if (xhv->xhv_keys == 0)
+ HvUTF8KEYS_off(hv);
xhv->xhv_placeholders--;
return Nullsv;
}
else if (SvREADONLY(hv) && HeVAL(entry) && SvREADONLY(HeVAL(entry))) {
- Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave);
+ Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave,
+ "Attempt to delete readonly key '%"SVf"' from a fixed hash"
+ );
}
if (flags & G_DISCARD)
else
hv_free_ent(hv, entry);
xhv->xhv_keys--; /* HvKEYS(hv)-- */
+ if (xhv->xhv_keys == 0)
+ HvUTF8KEYS_off(hv);
}
return sv;
}
if (SvREADONLY(hv)) {
- Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave);
+ Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave,
+ "Attempt to delete disallowed key '%"SVf"' from a fixed hash"
+ );
}
if (key != keysave)
register XPVHV* xhv;
if (!hv)
return;
+
+ if(SvREADONLY(hv)) {
+ Perl_croak(aTHX_ "Attempt to clear a fixed hash");
+ }
+
xhv = (XPVHV*)SvANY(hv);
hfreeentries(hv);
xhv->xhv_fill = 0; /* HvFILL(hv) = 0 */
if (SvRMAGICAL(hv))
mg_clear((SV*)hv);
+
+ HvUTF8KEYS_off(hv);
}
STATIC void