#if defined(USE_ITHREADS)
HE *
-Perl_he_dup(pTHX_ HE *e, bool shared, clone_params* param)
+Perl_he_dup(pTHX_ HE *e, bool shared, CLONE_PARAMS* param)
{
HE *ret;
}
#endif /* USE_ITHREADS */
+static void
+Perl_hv_notallowed(pTHX_ bool is_utf8, const char *key, I32 klen,
+ const char *keysave)
+{
+ SV *sv = sv_newmortal();
+ if (key == keysave) {
+ sv_setpvn(sv, key, klen);
+ }
+ else {
+ /* Need to free saved eventually assign to mortal SV */
+ SV *sv = sv_newmortal();
+ sv_usepvn(sv, (char *) key, klen);
+ }
+ if (is_utf8) {
+ SvUTF8_on(sv);
+ }
+ Perl_croak(aTHX_ "Attempt to access to key '%_' in fixed hash",sv);
+}
+
/* (klen == HEf_SVKEY) is special for MAGICAL hv entries, meaning key slot
* contains an SV* */
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 an 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.
}
}
#endif
+ if (SvREADONLY(hv)) {
+ Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave);
+ }
if (lval) { /* gonna assign to this, so it better be there */
sv = NEWSV(61,0);
if (key != keysave) { /* must be is_utf8 == 0 */
return 0;
}
-/* returns a HE * structure with the all fields set */
+/* returns an HE * structure with the all fields set */
/* note that hent_val will be a mortal sv for MAGICAL hashes */
/*
=for apidoc hv_fetch_ent
}
}
#endif
+ if (SvREADONLY(hv)) {
+ Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave);
+ }
if (key != keysave)
Safefree(key);
if (lval) { /* gonna assign to this, so it better be there */
return &HeVAL(entry);
}
+ if (SvREADONLY(hv)) {
+ Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave);
+ }
+
entry = new_HE();
if (HvSHAREKEYS(hv))
HeKEY_hek(entry) = share_hek(key, is_utf8?-klen:klen, hash);
return entry;
}
+ if (SvREADONLY(hv)) {
+ Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave);
+ }
+
entry = new_HE();
if (HvSHAREKEYS(hv))
HeKEY_hek(entry) = share_hek(key, is_utf8?-(I32)klen:klen, hash);
klen = tmplen;
}
+ if (SvREADONLY(hv)) {
+ Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave);
+ }
+
PERL_HASH(hash, key, klen);
/* oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
if (is_utf8)
key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
+ if (SvREADONLY(hv)) {
+ Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave);
+ }
+
if (!hash)
PERL_HASH(hash, key, klen);
/* It's an ordinary hash, so copy it fast. AMS 20010804 */
int i, shared = !!HvSHAREKEYS(ohv);
HE **ents, **oents = (HE **)HvARRAY(ohv);
- New(0, (char *)ents, PERL_HV_ARRAY_ALLOC_BYTES(hv_max+1), char);
+ char *a;
+ New(0, a, PERL_HV_ARRAY_ALLOC_BYTES(hv_max+1), char);
+ ents = (HE**)a;
/* In each bucket... */
for (i = 0; i <= hv_max; i++) {
STRLEN len = HeKLEN_UTF8(oent);
ent = new_HE();
- HeVAL(ent) = SvREFCNT_inc(HeVAL(oent));
+ HeVAL(ent) = newSVsv(HeVAL(oent));
HeKEY_hek(ent) = shared ? share_hek(key, len, hash)
: save_hek(key, len, hash);
if (prev)