From 7d6175ef71f6339fae97e36c1cdae9e4f47f74d0 Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Sun, 12 Jun 2011 14:46:44 -0700
Subject: Completely free hashes containing nulls
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
This fixes a regression introduced since 5.14.0, by commit e0171a1a3.
The new Perl_hfree_next_entry function that that commit introduced
returns the value of the hash element, or NULL if there are none left.
If the value of the hash element is NULL, the two cases are indistin-
guishable.
Before e0171a1a3, all the hash code took null values into account.
mro_package_moved took advantage of that, stealing values out of a
hash and leaving it to the freeing code to delete the elements.
The two places that call Perl_hfree_next_entry (there was only one,
S_hfreeentries, with commit e0171a1a3, but the following commit,
104d7b699c, made sv_clear call it, too) were not accounting for NULL
values’ being returned, and could terminate early, resulting in mem-
ory leaks.
One could argue that the perl core should not be assigning nulls to
HeVAL, but HeVAL is part of the public API and there could be CPAN
code assigning NULL to it, too.
So the safest approach seems to be to modify Perl_hfree_next_entry’s
callers to check the number of keys and not to attribute a signifi-
cance to a returned NULL.
---
ext/XS-APItest/APItest.xs | 10 ++++++++++
ext/XS-APItest/t/hash.t | 25 +++++++++++++++++++++++++
2 files changed, 35 insertions(+)
(limited to 'ext')
diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index 3ddf8d10e7..cb5de2d871 100644
--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@@ -2792,6 +2792,16 @@ CODE:
OUTPUT:
RETVAL
+void
+fill_hash_with_nulls(HV *hv)
+CODE:
+ UV i = 0;
+ for(; i < 1000; ++i) {
+ HE *entry = hv_fetch_ent(hv, sv_2mortal(newSVuv(i)), 1, 0);
+ SvREFCNT_dec(HeVAL(entry));
+ HeVAL(entry) = NULL;
+ }
+
MODULE = XS::APItest PACKAGE = XS::APItest::Magic
PROTOTYPES: DISABLE
diff --git a/ext/XS-APItest/t/hash.t b/ext/XS-APItest/t/hash.t
index 5d28c7d8af..dd124a14be 100644
--- a/ext/XS-APItest/t/hash.t
+++ b/ext/XS-APItest/t/hash.t
@@ -180,6 +180,31 @@ sub test_precomputed_hashes {
}
}
+{
+ use Scalar::Util 'weaken';
+ my %h;
+ fill_hash_with_nulls(\%h);
+ my @objs;
+ for("a".."z","A".."Z") {
+ weaken($objs[@objs] = $h{$_} = []);
+ }
+ undef %h;
+ no warnings 'uninitialized';
+ local $" = "";
+ is "@objs", "",
+ 'explicitly undeffing a hash with nulls frees all entries';
+
+ my $h = {};
+ fill_hash_with_nulls($h);
+ @objs = ();
+ for("a".."z","A".."Z") {
+ weaken($objs[@objs] = $$h{$_} = []);
+ }
+ undef $h;
+ is "@objs", "", 'freeing a hash with nulls frees all entries';
+}
+
+
done_testing;
exit;
--
cgit v1.2.1