Re: [PATCH] Re: Storing &PL_sv_undef as a hash key with perl-5.8.x

From: "Marcus Holland-Moritz" <mhx-perl@gmx.net>
Message-ID: <006801c34efe$8aac1920$0c2f1fac@R2D2>

p4raw-id: //depot/perl@20224

9 files changed, 59 insertions, 27 deletions

diff --git a/dump.c b/dump.c
index d6b65580cb..52a43a9af4 100644
--- a/dump.c
+++ b/dump.c
@@ -160,7 +160,7 @@ Perl_sv_peek(pTHX_ SV *sv)
 	sv_catpv(t, "WILD");
 	goto finish;
     }
-    else if (sv == &PL_sv_undef || sv == &PL_sv_no || sv == &PL_sv_yes) {
+    else if (sv == &PL_sv_undef || sv == &PL_sv_no || sv == &PL_sv_yes || sv == &PL_sv_placeholder) {
 	if (sv == &PL_sv_undef) {
 	    sv_catpv(t, "SV_UNDEF");
 	    if (!(SvFLAGS(sv) & (SVf_OK|SVf_OOK|SVs_OBJECT|
@@ -178,7 +178,7 @@ Perl_sv_peek(pTHX_ SV *sv)
 		SvNVX(sv) == 0.0)
 		goto finish;
 	}
-	else {
+	else if (sv == &PL_sv_yes) {
 	    sv_catpv(t, "SV_YES");
 	    if (!(SvFLAGS(sv) & (SVf_ROK|SVf_OOK|SVs_OBJECT|
 				 SVs_GMG|SVs_SMG|SVs_RMG)) &&
@@ -189,6 +189,13 @@ Perl_sv_peek(pTHX_ SV *sv)
 		SvNVX(sv) == 1.0)
 		goto finish;
 	}
+	else {
+	    sv_catpv(t, "SV_PLACEHOLDER");
+	    if (!(SvFLAGS(sv) & (SVf_OK|SVf_OOK|SVs_OBJECT|
+				 SVs_GMG|SVs_SMG|SVs_RMG)) &&
+		SvREADONLY(sv))
+		goto finish;
+	}
 	sv_catpv(t, ":");
     }
     else if (SvREFCNT(sv) == 0) {
diff --git a/embedvar.h b/embedvar.h
index 98d8b21665..2fe48407d6 100644
--- a/embedvar.h
+++ b/embedvar.h
@@ -396,6 +396,7 @@
 #define PL_sv_count		(vTHX->Isv_count)
 #define PL_sv_no		(vTHX->Isv_no)
 #define PL_sv_objcount		(vTHX->Isv_objcount)
+#define PL_sv_placeholder	(vTHX->Isv_placeholder)
 #define PL_sv_root		(vTHX->Isv_root)
 #define PL_sv_undef		(vTHX->Isv_undef)
 #define PL_sv_yes		(vTHX->Isv_yes)
@@ -700,6 +701,7 @@
 #define PL_Isv_count		PL_sv_count
 #define PL_Isv_no		PL_sv_no
 #define PL_Isv_objcount		PL_sv_objcount
+#define PL_Isv_placeholder	PL_sv_placeholder
 #define PL_Isv_root		PL_sv_root
 #define PL_Isv_undef		PL_sv_undef
 #define PL_Isv_yes		PL_sv_yes
diff --git a/ext/Storable/Storable.xs b/ext/Storable/Storable.xs
index 19470cbc49..055aefc8fc 100644
--- a/ext/Storable/Storable.xs
+++ b/ext/Storable/Storable.xs
@@ -1237,13 +1237,13 @@ static void clean_store_context(stcxt_t *cxt)
 	if (cxt->hseen) {
 		hv_iterinit(cxt->hseen);
 		while ((he = hv_iternext(cxt->hseen)))	/* Extra () for -Wall, grr.. */
-			HeVAL(he) = &PL_sv_undef;
+			HeVAL(he) = &PL_sv_placeholder;
 	}
 
 	if (cxt->hclass) {
 		hv_iterinit(cxt->hclass);
 		while ((he = hv_iternext(cxt->hclass)))	/* Extra () for -Wall, grr.. */
-			HeVAL(he) = &PL_sv_undef;
+			HeVAL(he) = &PL_sv_placeholder;
 	}
 
 	/*
@@ -2208,7 +2208,11 @@ static int store_hash(stcxt_t *cxt, HV *hv)
                             = (((hash_flags & SHV_RESTRICTED)
                                 && SvREADONLY(val))
                                ? SHV_K_LOCKED : 0);
+#ifdef PL_sv_placeholder
+                        if (val == &PL_sv_placeholder)
+#else
                         if (val == &PL_sv_undef)
+#endif
                             flags |= SHV_K_PLACEHOLDER;
 
 			keyval = SvPV(key, keylen_tmp);
@@ -2304,7 +2308,11 @@ static int store_hash(stcxt_t *cxt, HV *hv)
                             = (((hash_flags & SHV_RESTRICTED)
                                 && SvREADONLY(val))
                                              ? SHV_K_LOCKED : 0);
+#ifdef PL_sv_placeholder
+                        if (val == &PL_sv_placeholder)
+#else
                         if (val == &PL_sv_undef)
+#endif
                             flags |= SHV_K_PLACEHOLDER;
 
                         hek = HeKEY_hek(he);
@@ -4896,7 +4904,7 @@ static SV *retrieve_flag_hash(stcxt_t *cxt, char *cname)
 
             if (flags & SHV_K_PLACEHOLDER) {
                 SvREFCNT_dec (sv);
-                sv = &PL_sv_undef;
+                sv = &PL_sv_placeholder;
 		store_flags |= HVhek_PLACEHOLD;
 	    }
             if (flags & SHV_K_UTF8) {
diff --git a/hv.c b/hv.c
index 0bbebc6aeb..78082d0af4 100644
--- a/hv.c
+++ b/hv.c
@@ -312,7 +312,7 @@ S_hv_fetch_flags(pTHX_ HV *hv, const char *key, I32 klen, I32 lval, int flags)
         if (flags & HVhek_FREEKEY)
             Safefree(key);
 	/* if we find a placeholder, we pretend we haven't found anything */
-	if (HeVAL(entry) == &PL_sv_undef)
+	if (HeVAL(entry) == &PL_sv_placeholder)
 	    break;
 	return &HeVAL(entry);
 
@@ -482,7 +482,7 @@ Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, register U32 hash)
 	if (key != keysave)
 	    Safefree(key);
 	/* if we find a placeholder, we pretend we haven't found anything */
-	if (HeVAL(entry) == &PL_sv_undef)
+	if (HeVAL(entry) == &PL_sv_placeholder)
 	    break;
 	return entry;
     }
@@ -645,7 +645,7 @@ Perl_hv_store_flags(pTHX_ HV *hv, const char *key, I32 klen, SV *val,
 	    continue;
 	if ((HeKFLAGS(entry) ^ flags) & HVhek_UTF8)
 	    continue;
-	if (HeVAL(entry) == &PL_sv_undef)
+	if (HeVAL(entry) == &PL_sv_placeholder)
 	    xhv->xhv_placeholders--; /* yes, can store into placeholder slot */
 	else
 	    SvREFCNT_dec(HeVAL(entry));
@@ -653,7 +653,7 @@ Perl_hv_store_flags(pTHX_ HV *hv, const char *key, I32 klen, SV *val,
             /* We have been requested to insert a placeholder. Currently
                only Storable is allowed to do this.  */
             xhv->xhv_placeholders++;
-            HeVAL(entry) = &PL_sv_undef;
+            HeVAL(entry) = &PL_sv_placeholder;
         } else
             HeVAL(entry) = val;
 
@@ -696,7 +696,7 @@ Perl_hv_store_flags(pTHX_ HV *hv, const char *key, I32 klen, SV *val,
         /* We have been requested to insert a placeholder. Currently
            only Storable is allowed to do this.  */
         xhv->xhv_placeholders++;
-        HeVAL(entry) = &PL_sv_undef;
+        HeVAL(entry) = &PL_sv_placeholder;
     } else
         HeVAL(entry) = val;
     HeNEXT(entry) = *oentry;
@@ -820,7 +820,7 @@ Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, U32 hash)
 	    continue;
 	if ((HeKFLAGS(entry) ^ flags) & HVhek_UTF8)
 	    continue;
-	if (HeVAL(entry) == &PL_sv_undef)
+	if (HeVAL(entry) == &PL_sv_placeholder)
 	    xhv->xhv_placeholders--; /* yes, can store into placeholder slot */
 	else
 	    SvREFCNT_dec(HeVAL(entry));
@@ -964,7 +964,7 @@ Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen, I32 flags)
 	if (k_flags & HVhek_FREEKEY)
 	    Safefree(key);
 	/* if placeholder is here, it's already been deleted.... */
-	if (HeVAL(entry) == &PL_sv_undef)
+	if (HeVAL(entry) == &PL_sv_placeholder)
 	{
 	    if (SvREADONLY(hv))
 		return Nullsv;  /* if still SvREADONLY, leave it deleted. */
@@ -994,7 +994,7 @@ Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen, I32 flags)
 	    sv = Nullsv;
 	else {
 	    sv = sv_2mortal(HeVAL(entry));
-	    HeVAL(entry) = &PL_sv_undef;
+	    HeVAL(entry) = &PL_sv_placeholder;
 	}
 
 	/*
@@ -1004,7 +1004,7 @@ Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen, I32 flags)
 	 * an error.
 	 */
 	if (SvREADONLY(hv)) {
-	    HeVAL(entry) = &PL_sv_undef;
+	    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 */
 	    xhv->xhv_placeholders++; /* HvPLACEHOLDERS(hv)++ */
@@ -1123,7 +1123,7 @@ Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash)
             Safefree(key);
 
 	/* if placeholder is here, it's already been deleted.... */
-	if (HeVAL(entry) == &PL_sv_undef)
+	if (HeVAL(entry) == &PL_sv_placeholder)
 	{
 	    if (SvREADONLY(hv))
 		return Nullsv; /* if still SvREADONLY, leave it deleted. */
@@ -1152,7 +1152,7 @@ Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash)
 	    sv = Nullsv;
 	else {
 	    sv = sv_2mortal(HeVAL(entry));
-	    HeVAL(entry) = &PL_sv_undef;
+	    HeVAL(entry) = &PL_sv_placeholder;
 	}
 
 	/*
@@ -1162,7 +1162,7 @@ Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash)
 	 * an error.
 	 */
 	if (SvREADONLY(hv)) {
-	    HeVAL(entry) = &PL_sv_undef;
+	    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 */
 	    xhv->xhv_placeholders++; /* HvPLACEHOLDERS(hv)++ */
@@ -1271,7 +1271,7 @@ Perl_hv_exists(pTHX_ HV *hv, const char *key, I32 klen)
 	if (k_flags & HVhek_FREEKEY)
 	    Safefree(key);
 	/* If we find the key, but the value is a placeholder, return false. */
-	if (HeVAL(entry) == &PL_sv_undef)
+	if (HeVAL(entry) == &PL_sv_placeholder)
 	    return FALSE;
 
 	return TRUE;
@@ -1376,7 +1376,7 @@ Perl_hv_exists_ent(pTHX_ HV *hv, SV *keysv, U32 hash)
 	if (k_flags & HVhek_FREEKEY)
 	    Safefree(key);
 	/* If we find the key, but the value is a placeholder, return false. */
-	if (HeVAL(entry) == &PL_sv_undef)
+	if (HeVAL(entry) == &PL_sv_placeholder)
 	    return FALSE;
 	return TRUE;
     }
@@ -1713,7 +1713,7 @@ Perl_hv_clear(pTHX_ HV *hv)
 	    entry = ((HE**)xhv->xhv_array)[i];
 	    for (; entry; entry = HeNEXT(entry)) {
 		/* not already placeholder */
-		if (HeVAL(entry) != &PL_sv_undef) {
+		if (HeVAL(entry) != &PL_sv_placeholder) {
 		    if (HeVAL(entry) && SvREADONLY(HeVAL(entry))) {
 			SV* keysv = hv_iterkeysv(entry);
 			Perl_croak(aTHX_
@@ -1721,7 +1721,7 @@ Perl_hv_clear(pTHX_ HV *hv)
 				   keysv);
 		    }
 		    SvREFCNT_dec(HeVAL(entry));
-		    HeVAL(entry) = &PL_sv_undef;
+		    HeVAL(entry) = &PL_sv_placeholder;
 		    xhv->xhv_placeholders++; /* HvPLACEHOLDERS(hv)++ */
 		}
 	    }
@@ -1875,9 +1875,8 @@ Returns entries from a hash iterator.  See C<hv_iterinit> and C<hv_iternext>.
 The C<flags> value will normally be zero; if HV_ITERNEXT_WANTPLACEHOLDERS is
 set the placeholders keys (for restricted hashes) will be returned in addition
 to normal keys. By default placeholders are automatically skipped over.
-Currently a placeholder is implemented with a value that is literally
-<&Perl_sv_undef> (a regular C<undef> value is a normal read-write SV for which
-C<!SvOK> is false). Note that the implementation of placeholders and
+Currently a placeholder is implemented with a value that is
+C<&Perl_sv_placeholder>. Note that the implementation of placeholders and
 restricted hashes may change, and the implementation currently is
 insufficiently abstracted for any change to be tidy.
 
@@ -1946,7 +1945,7 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
              * Skip past any placeholders -- don't want to include them in
              * any iteration.
              */
-            while (entry && HeVAL(entry) == &PL_sv_undef) {
+            while (entry && HeVAL(entry) == &PL_sv_placeholder) {
                 entry = HeNEXT(entry);
             }
 	}
@@ -1966,7 +1965,7 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
         if (!(flags & HV_ITERNEXT_WANTPLACEHOLDERS)) {
             /* If we have an entry, but it's a placeholder, don't count it.
 	       Try the next.  */
-	    while (entry && HeVAL(entry) == &PL_sv_undef)
+	    while (entry && HeVAL(entry) == &PL_sv_placeholder)
 		entry = HeNEXT(entry);
 	}
 	/* Will loop again if this linked list starts NULL
diff --git a/intrpvar.h b/intrpvar.h
index 6a34ea4e67..dbb9a12ebd 100644
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -531,6 +531,9 @@ PERLVAR(IDBassertion,   SV *)
 
 PERLVARI(Icv_has_eval, I32, 0) /* PL_compcv includes an entereval or similar */
 
+/* Restricted hashes placeholder value */
+PERLVAR(Isv_placeholder, SV)
+
 /* New variables must be added to the very end, before this comment,
  * for binary compatibility (the offsets of the old members must not change).
  * (Don't forget to add your variable also to perl_clone()!)
diff --git a/perl.c b/perl.c
index 0968e26363..eb86c7238e 100644
--- a/perl.c
+++ b/perl.c
@@ -181,6 +181,9 @@ perl_construct(pTHXx)
 	    SvNV(&PL_sv_yes);
 	    SvREADONLY_on(&PL_sv_yes);
 	    SvREFCNT(&PL_sv_yes) = (~(U32)0)/2;
+
+	    SvREADONLY_on(&PL_sv_placeholder);
+	    SvREFCNT(&PL_sv_placeholder) = (~(U32)0)/2;
 	}
 
 	PL_sighandlerp = Perl_sighandler;
@@ -783,6 +786,9 @@ perl_destruct(pTHXx)
     SvREFCNT(&PL_sv_undef) = 0;
     SvREADONLY_off(&PL_sv_undef);
 
+    SvREFCNT(&PL_sv_placeholder) = 0;
+    SvREADONLY_off(&PL_sv_placeholder);
+
     Safefree(PL_origfilename);
     Safefree(PL_reg_start_tmp);
     if (PL_reg_curpm)
diff --git a/perlapi.h b/perlapi.h
index 524e84b1c7..9af1ede4ce 100644
--- a/perlapi.h
+++ b/perlapi.h
@@ -550,6 +550,8 @@ END_EXTERN_C
 #define PL_sv_no		(*Perl_Isv_no_ptr(aTHX))
 #undef  PL_sv_objcount
 #define PL_sv_objcount		(*Perl_Isv_objcount_ptr(aTHX))
+#undef  PL_sv_placeholder
+#define PL_sv_placeholder	(*Perl_Isv_placeholder_ptr(aTHX))
 #undef  PL_sv_root
 #define PL_sv_root		(*Perl_Isv_root_ptr(aTHX))
 #undef  PL_sv_undef
diff --git a/sv.c b/sv.c
index c31ada73e9..45d09d0ac1 100644
--- a/sv.c
+++ b/sv.c
@@ -10913,6 +10913,11 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     SvNVX(&PL_sv_yes)		= 1;
     ptr_table_store(PL_ptr_table, &proto_perl->Isv_yes, &PL_sv_yes);
 
+    SvANY(&PL_sv_placeholder)	= NULL;
+    SvREFCNT(&PL_sv_placeholder)= (~(U32)0)/2;
+    SvFLAGS(&PL_sv_placeholder)	= SVf_READONLY|SVt_NULL;
+    ptr_table_store(PL_ptr_table, &proto_perl->Isv_placeholder, &PL_sv_placeholder);
+
     /* create (a non-shared!) shared string table */
     PL_strtab		= newHV();
     HvSHAREKEYS_off(PL_strtab);
diff --git a/universal.c b/universal.c
index 9ee3e21a73..6ba5a13785 100644
--- a/universal.c
+++ b/universal.c
@@ -755,7 +755,7 @@ XS(XS_Internals_hv_clear_placehold)
             && items) {
             SV *val = hv_iterval(hv, entry);
 
-            if (val == &PL_sv_undef) {
+            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