Tests for hv_delayfree_ent and hv_free_ent

p4raw-id: //depot/perl@25070

3 files changed, 73 insertions, 1 deletions

diff --git a/ext/XS/APItest/APItest.pm b/ext/XS/APItest/APItest.pm
index e90594881b..5a00b31bcd 100644
--- a/ext/XS/APItest/APItest.pm
+++ b/ext/XS/APItest/APItest.pm
@@ -33,7 +33,7 @@ sub G_KEEPERR()	{  16 }
 sub G_NODEBUG()	{  32 }
 sub G_METHOD()	{  64 }
 
-our $VERSION = '0.07';
+our $VERSION = '0.08';
 
 bootstrap XS::APItest $VERSION;
 
diff --git a/ext/XS/APItest/APItest.xs b/ext/XS/APItest/APItest.xs
index a5a2bf00fa..ea825b28c2 100644
--- a/ext/XS/APItest/APItest.xs
+++ b/ext/XS/APItest/APItest.xs
@@ -5,6 +5,58 @@
 /* from exception.c */
 int exception(int);
 
+/* A routine to test hv_delayfree_ent
+   (which itself is tested by testing on hv_free_ent  */
+
+typedef void (freeent_function)(pTHX_ HV *, register HE *);
+
+void
+test_freeent(freeent_function *f) {
+    dTHX;
+    dSP;
+    HV *test_hash = newHV();
+    HE *victim;
+    SV *test_scalar;
+    U32 results[4];
+    int i;
+
+    /* Storing then deleting something should ensure that a hash entry is
+       available.  */
+    hv_store(test_hash, "", 0, &PL_sv_yes, 0);
+    hv_delete(test_hash, "", 0, 0);
+
+    /* We need to "inline" new_he here as it's static, and the functions we
+       test expect to be able to call del_HE on the HE  */
+    if (!PL_he_root)
+	croak("PL_he_root is 0");
+
+    victim = PL_he_root;
+    PL_he_root = HeNEXT(victim);
+
+    victim->hent_hek = Perl_share_hek(aTHX_ "", 0, 0);
+
+    test_scalar = newSV(0);
+    SvREFCNT_inc(test_scalar);
+    victim->hent_val = test_scalar;
+
+    /* Need this little game else we free the temps on the return stack.  */
+    results[0] = SvREFCNT(test_scalar);
+    SAVETMPS;
+    results[1] = SvREFCNT(test_scalar);
+    f(aTHX_ test_hash, victim);
+    results[2] = SvREFCNT(test_scalar);
+    FREETMPS;
+    results[3] = SvREFCNT(test_scalar);
+
+    i = 0;
+    do {
+	mPUSHu(results[i]);
+    } while (++i < sizeof(results)/sizeof(results[0]));
+
+    /* Goodbye to our extra reference.  */
+    SvREFCNT_dec(test_scalar);
+}
+
 MODULE = XS::APItest:Hash		PACKAGE = XS::APItest::Hash
 
 #define UTF8KLEN(sv, len)   (SvUTF8(sv) ? -(I32)len : (I32)len)
@@ -108,6 +160,19 @@ fetch(hash, key_sv)
 	RETVAL = newSVsv(*result);
         OUTPUT:
         RETVAL
+
+void *
+test_hv_free_ent()
+	PPCODE:
+	test_freeent(&Perl_hv_free_ent);
+	XSRETURN(4);
+
+void *
+test_hv_delayfree_ent()
+	PPCODE:
+	test_freeent(&Perl_hv_delayfree_ent);
+	XSRETURN(4);
+	    
 =pod
 
 sub TIEHASH  { bless {}, $_[0] }
diff --git a/ext/XS/APItest/t/hash.t b/ext/XS/APItest/t/hash.t
index 8e6beeea8e..7c60b64dd4 100644
--- a/ext/XS/APItest/t/hash.t
+++ b/ext/XS/APItest/t/hash.t
@@ -82,6 +82,13 @@ main_tests (\@keys, \@testkeys, ' [utf8 hash]');
     # I can't work out how to get to the code that flips the wasutf8 flag on
     # the hash key without some ikcy XS
 }
+
+{
+    is_deeply([&XS::APItest::Hash::test_hv_free_ent], [2,2,1,1],
+	      "hv_free_ent frees the value immediately");
+    is_deeply([&XS::APItest::Hash::test_hv_delayfree_ent], [2,2,2,1],
+	      "hv_delayfree_ent keeps the value around until FREETMPS");
+}
 exit;
 
 ################################   The End   ################################