[PATCH] [perl #3096] undefing hash with object values

A rather old bug in the bugs database demonstrates a problem with undefining
a hash which contains objects with destructors.
These destructors may try to access that hash, with nasty results
(errors about freeing unrefed values, shared strings etc).

This patch makes a hash that is in the process of being undefed or
cleared, appear to be empty.

Dave.

-- 
Never do today what you can put off till tomorrow.


--- hv.c-	Thu May  1 13:15:02 2003
+++ hv.c	Thu May  1 13:13:06 2003
@@ -1728,8 +1728,6 @@ Perl_hv_clear(pTHX_ HV *hv)
     }
 
     hfreeentries(hv);
-    xhv->xhv_fill = 0; /* HvFILL(hv) = 0 */
-    xhv->xhv_keys = 0; /* HvKEYS(hv) = 0 */
     xhv->xhv_placeholders = 0; /* HvPLACEHOLDERS(hv) = 0 */
     if (xhv->xhv_array /* HvARRAY(hv) */)
 	(void)memzero(xhv->xhv_array /* HvARRAY(hv) */,
@@ -1758,6 +1756,12 @@ S_hfreeentries(pTHX_ HV *hv)
     riter = 0;
     max = HvMAX(hv);
     array = HvARRAY(hv);
+    /* make everyone else think the array is empty, so that the destructors
+     * called for freed entries can't recusively mess with us */
+    HvARRAY(hv) = Null(HE**); 
+    HvFILL(hv) = 0;
+    ((XPVHV*) SvANY(hv))->xhv_keys = 0;
+
     entry = array[0];
     for (;;) {
 	if (entry) {
@@ -1771,6 +1775,7 @@ S_hfreeentries(pTHX_ HV *hv)
 	    entry = array[riter];
 	}
     }
+    HvARRAY(hv) = array;
     (void)hv_iterinit(hv);
 }
 
@@ -1799,8 +1804,6 @@ Perl_hv_undef(pTHX_ HV *hv)
     }
     xhv->xhv_max   = 7;	/* HvMAX(hv) = 7 (it's a normal hash) */
     xhv->xhv_array = 0;	/* HvARRAY(hv) = 0 */
-    xhv->xhv_fill  = 0;	/* HvFILL(hv) = 0 */
-    xhv->xhv_keys  = 0;	/* HvKEYS(hv) = 0 */
     xhv->xhv_placeholders = 0; /* HvPLACEHOLDERS(hv) = 0 */
 
     if (SvRMAGICAL(hv))
--- t/op/undef.t-	Thu May  1 13:15:19 2003
+++ t/op/undef.t	Thu May  1 13:13:39 2003
@@ -5,7 +5,7 @@
     @INC = '../lib';
 }
 
-print "1..28\n";
+print "1..36\n";
 
 print defined($a) ? "not ok 1\n" : "ok 1\n";
 
@@ -85,3 +85,20 @@
     eval 'undef tcp';
     print $@ =~ /^Can't modify constant item/ ? "ok 28\n" : "not ok 28\n";
 }
+
+# bugid 3096
+# undefing a hash may free objects with destructors that then try to
+# modify the hash. To them, the hash should appear empty.
+
+$test = 29;
+%hash = (
+    key1 => bless({}, 'X'),
+    key2 => bless({}, 'X'),
+);
+undef %hash;
+sub X::DESTROY {
+    print "not " if keys   %hash; print "ok $test\n"; $test++;
+    print "not " if values %hash; print "ok $test\n"; $test++;
+    print "not " if each   %hash; print "ok $test\n"; $test++;
+    print "not " if defined delete $hash{'key2'}; print "ok $test\n"; $test++;
+}

• [PATCH] [perl #3096] undefing hash with object values by Dave Mitchell
• Re: [PATCH] [perl #3096] undefing hash with object values by Jarkko Hietaniemi