This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
ensure hash iterator gets deleted
authorDavid Mitchell <davem@iabyn.com>
Wed, 11 May 2011 15:17:08 +0000 (16:17 +0100)
committerDavid Mitchell <davem@iabyn.com>
Thu, 19 May 2011 13:49:44 +0000 (14:49 +0100)
The recent commits to make sv_clear() iterative when freeing a hash,
introduced a bug. If the hash only has one key, and that becomes the
iterator, and is then deleted; then when the hash is freed, the LAZYDEL
feature is skipped, and the iterated hash value fails to get deleted.

The fix is simple: check for LAZYDEL before return is keys == 0.

hv.c
t/op/each.t

diff --git a/hv.c b/hv.c
index 3bd3e6e..785a306 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -1651,9 +1651,6 @@ S_hfreeentries(pTHX_ HV *hv)
 
     PERL_ARGS_ASSERT_HFREEENTRIES;
 
-    if (!((XPVHV*)SvANY(hv))->xhv_keys)
-       return;
-
     while ( ((sv = Perl_hfree_next_entry(aTHX_ hv, &index))) ) {
        SvREFCNT_dec(sv);
     }
@@ -1679,9 +1676,6 @@ Perl_hfree_next_entry(pTHX_ HV *hv, STRLEN *indexp)
 
     PERL_ARGS_ASSERT_HFREE_NEXT_ENTRY;
 
-    if (!((XPVHV*)SvANY(hv))->xhv_keys)
-       return NULL;
-
     if (SvOOK(hv) && ((iter = HvAUX(hv)))
        && ((entry = iter->xhv_eiter)) )
     {
@@ -1697,6 +1691,9 @@ Perl_hfree_next_entry(pTHX_ HV *hv, STRLEN *indexp)
        iter->xhv_eiter = NULL; /* HvEITER(hv) = NULL */
     }
 
+    if (!((XPVHV*)SvANY(hv))->xhv_keys)
+       return NULL;
+
     array = HvARRAY(hv);
     assert(array);
     while ( ! ((entry = array[*indexp])) ) {
index a7b128a..d9e1542 100644 (file)
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 54;
+plan tests => 56;
 
 $h{'abc'} = 'ABC';
 $h{'def'} = 'DEF';
@@ -238,3 +238,20 @@ for my $k (qw(each keys values)) {
     my @arr=%foo&&%foo;
     is(@arr,10,"Got expected number of elements in list context");
 }    
+{
+    # make sure a deleted active iterator gets freed timely, even if the
+    # hash is otherwise empty
+
+    package Single;
+
+    my $c = 0;
+    sub DESTROY { $c++ };
+
+    {
+       my %h = ("a" => bless []);
+       my ($k,$v) = each %h;
+       delete $h{$k};
+       ::is($c, 0, "single key not yet freed");
+    }
+    ::is($c, 1, "single key now freed");
+}