From: Nicholas Clark <nick@ccl4.org>
Date: Fri, 21 Nov 2003 23:12:33 +0000 (+0000)
Subject: Move the negative key -> utf8 flag conversion out to hv_delete
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=cd6d36ac47e470799713a2a497ee38c219c3cf23;p=p5sagit%2Fp5-mst-13.2.git

Move the negative key -> utf8 flag conversion out to hv_delete

p4raw-id: //depot/perl@21766
---

diff --git a/embed.fnc b/embed.fnc
index ee667f2..35cb136 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 f0cae32..67082e6 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 f21cd20..3fad565 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 ea5219a..7395837 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);