X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=hv.c;h=e71759f9ae30daf4308ada1f7dfd562345ec3fca;hb=0a76ff6528f0ab52947d4f1b9664310ce137b9a0;hp=78b1f9de2a7648f7792043417a4629939eaca226;hpb=4e2344ada78d8742c0023d545c1baed6597bae39;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/hv.c b/hv.c
index 78b1f9d..e71759f 100644
--- a/hv.c
+++ b/hv.c
@@ -80,6 +80,7 @@ S_more_he(pTHX)
 STATIC HEK *
 S_save_hek_flags(pTHX_ const char *str, I32 len, U32 hash, int flags)
 {
+    int flags_masked = flags & HVhek_MASK;
     char *k;
     register HEK *hek;
 
@@ -89,7 +90,10 @@ S_save_hek_flags(pTHX_ const char *str, I32 len, U32 hash, int flags)
     HEK_KEY(hek)[len] = 0;
     HEK_LEN(hek) = len;
     HEK_HASH(hek) = hash;
-    HEK_FLAGS(hek) = (unsigned char)flags;
+    HEK_FLAGS(hek) = (unsigned char)flags_masked;
+
+    if (flags & HVhek_FREEKEY)
+	Safefree(str);
     return hek;
 }
 
@@ -365,7 +369,7 @@ Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, register U32 hash)
 			   (lval ? HV_FETCH_LVALUE : 0), Nullsv, hash);
 }
 
-HE *
+STATIC HE *
 S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 		  int flags, int action, SV *val, register U32 hash)
 {
@@ -381,6 +385,8 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 	return 0;
 
     if (keysv) {
+	if (flags & HVhek_FREEKEY)
+	    Safefree(key);
 	key = SvPV(keysv, klen);
 	flags = 0;
 	is_utf8 = (SvUTF8(keysv) != 0);
@@ -437,25 +443,28 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 		U32 i;
 		for (i = 0; i < klen; ++i)
 		    if (isLOWER(key[i])) {
-			const char *keysave = key;
-			/* Will need to free this, so set FREEKEY flag
-			   on call to hv_fetch_common.  */
-			key = savepvn(key,klen);
-			key = (const char*)strupr((char*)key);
-
-			if (flags & HVhek_FREEKEY)
-			    Safefree(keysave);
-
-			/* This isn't strictly the same as the old hv_fetch
-			   magic, which made a call to hv_fetch, followed
-			   by a call to hv_store if that failed and lvalue
-			   was true.
-			   Which I believe could have been done by simply
-			   passing the lvalue through to the first hv_fetch.
-			   So I will do that here.  */
-			return hv_fetch_common(hv, Nullsv, key, klen,
-					       HVhek_FREEKEY,
-					       action, Nullsv, 0);
+			/* Would be nice if we had a routine to do the
+			   copy and upercase in a single pass through.  */
+			char *nkey = strupr(savepvn(key,klen));
+			/* Note that this fetch is for nkey (the uppercased
+			   key) whereas the store is for key (the original)  */
+			entry = hv_fetch_common(hv, Nullsv, nkey, klen,
+						HVhek_FREEKEY, /* free nkey */
+						0 /* non-LVAL fetch */,
+						Nullsv /* no value */,
+						0 /* compute hash */);
+			if (!entry && (action & HV_FETCH_LVALUE)) {
+			    /* This call will free key if necessary.
+			       Do it this way to encourage compiler to tail
+			       call optimise.  */
+			    entry = hv_fetch_common(hv, keysv, key, klen,
+						    flags, HV_FETCH_ISSTORE,
+						    NEWSV(61,0), hash);
+			} else {
+			    if (flags & HVhek_FREEKEY)
+				Safefree(key);
+			}
+			return entry;
 		    }
 	    }
 #endif
@@ -857,7 +866,7 @@ Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash)
     return hv_delete_common(hv, keysv, NULL, 0, 0, flags, hash);
 }
 
-SV *
+STATIC SV *
 S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 		   int k_flags, I32 d_flags, U32 hash)
 {
@@ -873,6 +882,8 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 	return Nullsv;
 
     if (keysv) {
+	if (k_flags & HVhek_FREEKEY)
+	    Safefree(key);
 	key = SvPV(keysv, klen);
 	k_flags = 0;
 	is_utf8 = (SvUTF8(keysv) != 0);
@@ -902,25 +913,20 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 		    }		
 		    return Nullsv;		/* element cannot be deleted */
 		}
-	    }
 #ifdef ENV_IS_CASELESS
-	    if (mg_find((SV*)hv, PERL_MAGIC_env)) {
-		/* XXX This code isn't UTF8 clean.  */
-		keysv = sv_2mortal(newSVpvn(key,klen));
-		key = strupr(SvPVX(keysv));
-
-#if 0
-		/* keysave not in scope - don't understand - NI-S */
-                if (k_flags & HVhek_FREEKEY) {
-                    Safefree(keysave);
+		else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
+		    /* XXX This code isn't UTF8 clean.  */
+		    keysv = sv_2mortal(newSVpvn(key,klen));
+		    if (k_flags & HVhek_FREEKEY) {
+			Safefree(key);
+		    }
+		    key = strupr(SvPVX(keysv));
+		    is_utf8 = 0;
+		    k_flags = 0;
+		    hash = 0;
 		}
 #endif
-
-		is_utf8 = 0;
-		k_flags = 0;
-		hash = 0;
 	    }
-#endif
 	}
     }
     xhv = (XPVHV*)SvANY(hv);
@@ -954,7 +960,6 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
         } else {
             PERL_HASH(hash, key, klen);
         }
-	PERL_HASH(hash, key, klen);
     }
 
     masked_flags = (k_flags & HVhek_MASK);
@@ -978,21 +983,6 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 	/* if placeholder is here, it's already been deleted.... */
 	if (HeVAL(entry) == &PL_sv_placeholder)
 	{
-	    if (SvREADONLY(hv))
-		return Nullsv; /* if still SvREADONLY, leave it deleted. */
-
-           /* okay, really delete the placeholder. */
-           *oentry = HeNEXT(entry);
-           if (i && !*oentry)
-               xhv->xhv_fill--; /* HvFILL(hv)-- */
-           if (entry == xhv->xhv_eiter /* HvEITER(hv) */)
-               HvLAZYDEL_on(hv);
-           else
-               hv_free_ent(hv, entry);
-           xhv->xhv_keys--; /* HvKEYS(hv)-- */
-	   if (xhv->xhv_keys == 0)
-               HvHASKFLAGS_off(hv);
-           xhv->xhv_placeholders--;
            return Nullsv;
 	}
 	else if (SvREADONLY(hv) && HeVAL(entry) && SvREADONLY(HeVAL(entry))) {
@@ -1015,6 +1005,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 	 * an error.
 	 */
 	if (SvREADONLY(hv)) {
+	    SvREFCNT_dec(HeVAL(entry));
 	    HeVAL(entry) = &PL_sv_placeholder;
 	    /* We'll be saving this slot, so the number of allocated keys
 	     * doesn't go down, but the number placeholders goes up */
@@ -1047,6 +1038,11 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 STATIC void
 S_hsplit(pTHX_ HV *hv)
 {
+    /* Can't make this clear any placeholders first for non-restricted hashes,
+       as Storable rebuilds restricted hashes by putting in all the
+       placeholders (first) before turning on the readonly flag.  Hence midway
+       through restoring the hash there are placeholders which need to remain
+       even though the hash isn't (currently) flagged as restricted. */
     register XPVHV* xhv = (XPVHV*)SvANY(hv);
     I32 oldsize = (I32) xhv->xhv_max+1; /* HvMAX(hv)+1 (sick) */
     register I32 newsize = oldsize * 2;
@@ -1490,42 +1486,45 @@ See Hash::Util::lock_keys() for an example of its use.
 void
 Perl_hv_clear_placeholders(pTHX_ HV *hv)
 {
-    I32 items;
-    items = (I32)HvPLACEHOLDERS(hv);
-    if (items) {
-        HE *entry;
-        I32 riter = HvRITER(hv);
-        HE *eiter = HvEITER(hv);
-        hv_iterinit(hv);
-        /* This may look suboptimal with the items *after* the iternext, but
-           it's quite deliberate. We only get here with items==0 if we've
-           just deleted the last placeholder in the hash. If we've just done
-           that then it means that the hash is in lazy delete mode, and the
-           HE is now only referenced in our iterator. If we just quit the loop
-           and discarded our iterator then the HE leaks. So we do the && the
-           other way to ensure iternext is called just one more time, which
-           has the side effect of triggering the lazy delete.  */
-        while ((entry = hv_iternext_flags(hv, HV_ITERNEXT_WANTPLACEHOLDERS))
-            && items) {
-            SV *val = hv_iterval(hv, entry);
-
-            if (val == &PL_sv_placeholder) {
-
-                /* It seems that I have to go back in the front of the hash
-                   API to delete a hash, even though I have a HE structure
-                   pointing to the very entry I want to delete, and could hold
-                   onto the previous HE that points to it. And it's easier to
-                   go in with SVs as I can then specify the precomputed hash,
-                   and don't have fun and games with utf8 keys.  */
-                SV *key = hv_iterkeysv(entry);
-
-                hv_delete_ent (hv, key, G_DISCARD, HeHASH(entry));
-                items--;
-            }
-        }
-        HvRITER(hv) = riter;
-        HvEITER(hv) = eiter;
-    }
+    I32 items = (I32)HvPLACEHOLDERS(hv);
+    I32 i = HvMAX(hv);
+
+    if (items == 0)
+	return;
+
+    do {
+	/* Loop down the linked list heads  */
+	int first = 1;
+	HE **oentry = &(HvARRAY(hv))[i];
+	HE *entry = *oentry;
+
+	if (!entry)
+	    continue;
+
+	for (; entry; first=0, oentry = &HeNEXT(entry), entry = *oentry) {
+	    if (HeVAL(entry) == &PL_sv_placeholder) {
+		*oentry = HeNEXT(entry);
+		if (first && !*oentry)
+		    HvFILL(hv)--; /* This linked list is now empty.  */
+		if (HvEITER(hv))
+		    HvLAZYDEL_on(hv);
+		else
+		    hv_free_ent(hv, entry);
+
+		if (--items == 0) {
+		    /* Finished.  */
+		    HvTOTALKEYS(hv) -= HvPLACEHOLDERS(hv);
+		    if (HvKEYS(hv) == 0)
+			HvHASKFLAGS_off(hv);
+		    HvPLACEHOLDERS(hv) = 0;
+		    return;
+		}
+	    }
+	}
+    } while (--i >= 0);
+    /* You can't get here, hence assertion should always fail.  */
+    assert (items == 0);
+    assert (0);
 }
 
 STATIC void
@@ -2081,7 +2080,7 @@ S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags)
     }
     if (!found) {
 	entry = new_HE();
-	HeKEY_hek(entry) = save_hek_flags(str, len, hash, flags);
+	HeKEY_hek(entry) = save_hek_flags(str, len, hash, flags_masked);
 	HeVAL(entry) = Nullsv;
 	HeNEXT(entry) = *oentry;
 	*oentry = entry;