summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--embed.fnc2
-rw-r--r--embed.h2
-rw-r--r--hv.c47
-rw-r--r--proto.h2
4 files changed, 33 insertions, 20 deletions
diff --git a/embed.fnc b/embed.fnc
index ee667f2393..35cb136121 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1394,7 +1394,7 @@ Ap |void |save_set_svflags|SV* sv|U32 mask|U32 val
Apod |void |hv_assert |HV* tb
#if defined(PERL_IN_HV_C) || defined(PERL_DECL_PROT)
-sM |SV* |hv_delete_common|HV* tb|SV* key_sv|const char* key|I32 klen|I32 flags|U32 hash
+sM |SV* |hv_delete_common|HV* tb|SV* key_sv|const char* key|STRLEN klen|int k_flags|I32 d_flags|U32 hash
sM |bool |hv_exists_common|HV* tb|SV* key_sv|const char* key|I32 klen|U32 hash
sM |HE* |hv_fetch_common|HV* tb|SV* key_sv|const char* key|STRLEN klen|int flags|int action|U32 hash
sM |HE* |hv_store_common|HV* tb|SV* key_sv|const char* key|I32 klen|int flags|SV* val|U32 hash
diff --git a/embed.h b/embed.h
index f0cae3295b..67082e6019 100644
--- a/embed.h
+++ b/embed.h
@@ -4639,7 +4639,7 @@
#define save_set_svflags(a,b,c) Perl_save_set_svflags(aTHX_ a,b,c)
#if defined(PERL_IN_HV_C) || defined(PERL_DECL_PROT)
#ifdef PERL_CORE
-#define hv_delete_common(a,b,c,d,e,f) S_hv_delete_common(aTHX_ a,b,c,d,e,f)
+#define hv_delete_common(a,b,c,d,e,f,g) S_hv_delete_common(aTHX_ a,b,c,d,e,f,g)
#endif
#ifdef PERL_CORE
#define hv_exists_common(a,b,c,d,e) S_hv_exists_common(aTHX_ a,b,c,d,e)
diff --git a/hv.c b/hv.c
index f21cd20094..3fad5656b9 100644
--- a/hv.c
+++ b/hv.c
@@ -738,9 +738,18 @@ will be returned.
*/
SV *
-Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen, I32 flags)
+Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen_i32, I32 flags)
{
- return hv_delete_common(hv, NULL, key, klen, flags, 0);
+ STRLEN klen;
+ int k_flags = 0;
+
+ if (klen_i32 < 0) {
+ klen = -klen_i32;
+ k_flags |= HVhek_UTF8;
+ } else {
+ klen = klen_i32;
+ }
+ return hv_delete_common(hv, NULL, key, klen, k_flags, flags, 0);
}
/*
@@ -757,21 +766,19 @@ precomputed hash value, or 0 to ask for it to be computed.
SV *
Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash)
{
- return hv_delete_common(hv, keysv, NULL, 0, flags, hash);
+ return hv_delete_common(hv, keysv, NULL, 0, 0, flags, hash);
}
SV *
-S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, I32 klen_i32,
- I32 flags, U32 hash)
+S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
+ int k_flags, I32 d_flags, U32 hash)
{
register XPVHV* xhv;
register I32 i;
- STRLEN klen;
register HE *entry;
register HE **oentry;
SV *sv;
bool is_utf8;
- int k_flags = 0;
const char *keysave;
int masked_flags;
@@ -780,15 +787,10 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, I32 klen_i32,
if (keysv) {
key = SvPV(keysv, klen);
+ k_flags = 0;
is_utf8 = (SvUTF8(keysv) != 0);
} else {
- if (klen_i32 < 0) {
- klen = -klen_i32;
- is_utf8 = TRUE;
- } else {
- klen = klen_i32;
- is_utf8 = FALSE;
- }
+ is_utf8 = ((k_flags & HVhek_UTF8) ? TRUE : FALSE);
}
keysave = key;
@@ -821,6 +823,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, I32 klen_i32,
keysv = sv_2mortal(newSVpvn(key,klen));
keysave = key = strupr(SvPVX(keysv));
is_utf8 = 0;
+ k_flags = 0;
hash = 0;
}
#endif
@@ -832,10 +835,20 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, I32 klen_i32,
if (is_utf8) {
key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
+
+ if (k_flags & HVhek_FREEKEY) {
+ /* This shouldn't happen if our caller does what we expect,
+ but strictly the API allows it. */
+ Safefree(keysave);
+ }
+
if (is_utf8)
- k_flags = HVhek_UTF8;
+ k_flags |= HVhek_UTF8;
+ else
+ k_flags &= ~HVhek_UTF8;
if (key != keysave)
- k_flags |= HVhek_FREEKEY;
+ k_flags |= HVhek_WASUTF8 | HVhek_FREEKEY;
+ HvHASKFLAGS_on((SV*)hv);
}
if (HvREHASH(hv)) {
@@ -893,7 +906,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, I32 klen_i32,
);
}
- if (flags & G_DISCARD)
+ if (d_flags & G_DISCARD)
sv = Nullsv;
else {
sv = sv_2mortal(HeVAL(entry));
diff --git a/proto.h b/proto.h
index ea5219ab52..7395837388 100644
--- a/proto.h
+++ b/proto.h
@@ -1335,7 +1335,7 @@ PERL_CALLCONV void Perl_save_set_svflags(pTHX_ SV* sv, U32 mask, U32 val);
PERL_CALLCONV void Perl_hv_assert(pTHX_ HV* tb);
#if defined(PERL_IN_HV_C) || defined(PERL_DECL_PROT)
-STATIC SV* S_hv_delete_common(pTHX_ HV* tb, SV* key_sv, const char* key, I32 klen, I32 flags, U32 hash);
+STATIC SV* S_hv_delete_common(pTHX_ HV* tb, SV* key_sv, const char* key, STRLEN klen, int k_flags, I32 d_flags, U32 hash);
STATIC bool S_hv_exists_common(pTHX_ HV* tb, SV* key_sv, const char* key, I32 klen, U32 hash);
STATIC HE* S_hv_fetch_common(pTHX_ HV* tb, SV* key_sv, const char* key, STRLEN klen, int flags, int action, U32 hash);
STATIC HE* S_hv_store_common(pTHX_ HV* tb, SV* key_sv, const char* key, I32 klen, int flags, SV* val, U32 hash);