X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=universal.c;h=b92bd7a5680ccdf729d555bfc260b2890d075054;hb=30ef33217aeee51ee47b2433e9384b011646254a;hp=16000f723d56327afb81edd58301e98ed9c5080a;hpb=2956957731badfc3e16c029c1f22e4098fb8c46a;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/universal.c b/universal.c
index 16000f7..b92bd7a 100644
--- a/universal.c
+++ b/universal.c
@@ -49,7 +49,7 @@ S_isa_lookup(pTHX_ HV *stash, const char *name, HV* name_stash,
     if (gvp && (gv = *gvp) != (GV*)&PL_sv_undef && (subgen = GvSV(gv))
 	&& (hv = GvHV(gv)))
     {
-	if (SvIV(subgen) == PL_sub_generation) {
+	if (SvIV(subgen) == (IV)PL_sub_generation) {
 	    SV* sv;
 	    SV** svp = (SV**)hv_fetch(hv, name, len, FALSE);
 	    if (svp && (sv = *svp) != (SV*)&PL_sv_undef) {
@@ -169,6 +169,7 @@ XS(XS_utf8_unicode_to_native);
 XS(XS_utf8_native_to_unicode);
 XS(XS_Internals_SvREADONLY);
 XS(XS_Internals_SvREFCNT);
+XS(XS_Internals_hv_clear_placehold);
 
 void
 Perl_boot_core_UNIVERSAL(pTHX)
@@ -187,6 +188,8 @@ Perl_boot_core_UNIVERSAL(pTHX)
     newXS("utf8::unicode_to_native", XS_utf8_unicode_to_native, file);
     newXSproto("Internals::SvREADONLY",XS_Internals_SvREADONLY, file, "\\[$%@];$");
     newXSproto("Internals::SvREFCNT",XS_Internals_SvREFCNT, file, "\\[$%@];$");
+    newXSproto("Internals::hv_clear_placeholders",
+               XS_Internals_hv_clear_placehold, file, "\\%");
 }
 
 
@@ -462,7 +465,7 @@ XS(XS_utf8_unicode_to_native)
  XSRETURN(1);
 }
 
-XS(XS_Internals_SvREADONLY)
+XS(XS_Internals_SvREADONLY)	/* This is dangerous stuff. */
 {
     dXSARGS;
     SV *sv = SvRV(ST(0));
@@ -478,23 +481,74 @@ XS(XS_Internals_SvREADONLY)
 	    XSRETURN_YES;
 	}
 	else {
+	    /* I hope you really know what you are doing. */
 	    SvREADONLY_off(sv);
 	    XSRETURN_NO;
 	}
     }
-    XSRETURN_UNDEF;
+    XSRETURN_UNDEF; /* Can't happen. */
 }
 
-XS(XS_Internals_SvREFCNT)
+XS(XS_Internals_SvREFCNT)	/* This is dangerous stuff. */
 {
     dXSARGS;
     SV *sv = SvRV(ST(0));
     if (items == 1)
-	 XSRETURN_IV(SvREFCNT(sv) - 1); /* minus the SvRV above */
+	 XSRETURN_IV(SvREFCNT(sv) - 1); /* Minus the ref created for us. */
     else if (items == 2) {
+         /* I hope you really know what you are doing. */
 	 SvREFCNT(sv) = SvIV(ST(1));
 	 XSRETURN_IV(SvREFCNT(sv));
     }
-    XSRETURN_UNDEF;
+    XSRETURN_UNDEF; /* Can't happen. */
 }
 
+/* Maybe this should return the number of placeholders found in scalar context,
+   and a list of them in list context.  */
+XS(XS_Internals_hv_clear_placehold)
+{
+    dXSARGS;
+    HV *hv = (HV *) SvRV(ST(0));
+
+    /* I don't care how many parameters were passed in, but I want to avoid
+       the unused variable warning. */
+
+    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_undef) {
+
+                /* 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;
+    }
+
+    XSRETURN(0);
+}