In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/7d6175ef71f6339fae97e36c1cdae9e4f47f74d0?hp=30b0736d971c494432c032b4ca9fd2e8dcd31680>
- Log ----------------------------------------------------------------- commit 7d6175ef71f6339fae97e36c1cdae9e4f47f74d0 Author: Father Chrysostomos <[email protected]> Date: Sun Jun 12 14:46:44 2011 -0700 Completely free hashes containing nulls 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. ----------------------------------------------------------------------- Summary of changes: ext/XS-APItest/APItest.xs | 10 ++++++++++ ext/XS-APItest/t/hash.t | 25 +++++++++++++++++++++++++ hv.c | 10 ++++++---- sv.c | 5 +++-- 4 files changed, 44 insertions(+), 6 deletions(-) diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs index 3ddf8d1..cb5de2d 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 5d28c7d..dd124a1 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; diff --git a/hv.c b/hv.c index 51c782a..a230c16 100644 --- a/hv.c +++ b/hv.c @@ -1662,12 +1662,12 @@ STATIC void S_hfreeentries(pTHX_ HV *hv) { STRLEN index = 0; - SV* sv; + XPVHV * const xhv = (XPVHV*)SvANY(hv); PERL_ARGS_ASSERT_HFREEENTRIES; - while ( ((sv = Perl_hfree_next_entry(aTHX_ hv, &index))) ) { - SvREFCNT_dec(sv); + while (xhv->xhv_keys) { + SvREFCNT_dec(Perl_hfree_next_entry(aTHX_ hv, &index)); } } @@ -1675,7 +1675,9 @@ S_hfreeentries(pTHX_ HV *hv) /* hfree_next_entry() * For use only by S_hfreeentries() and sv_clear(). * Delete the next available HE from hv and return the associated SV. - * Returns null on empty hash. + * Returns null on empty hash. Nevertheless null is not a reliable + * indicator that the hash is empty, as the deleted entry may have a + * null value. * indexp is a pointer to the current index into HvARRAY. The index should * initially be set to 0. hfree_next_entry() may update it. */ diff --git a/sv.c b/sv.c index faddfdc..6750ef1 100644 --- a/sv.c +++ b/sv.c @@ -6180,8 +6180,8 @@ Perl_sv_clear(pTHX_ SV *const orig_sv) goto free_body; } } else if (SvTYPE(iter_sv) == SVt_PVHV) { - sv = Perl_hfree_next_entry(aTHX_ (HV*)iter_sv, &hash_index); - if (!sv) { /* no more elements of current HV to free */ + if (!HvTOTALKEYS((HV *)iter_sv)) { + /* no more elements of current HV to free */ sv = iter_sv; type = SvTYPE(sv); /* Restore previous value of iter_sv, squirrelled away */ @@ -6197,6 +6197,7 @@ Perl_sv_clear(pTHX_ SV *const orig_sv) assert(!HvARRAY((HV*)sv)); goto free_body; } + sv = Perl_hfree_next_entry(aTHX_ (HV*)iter_sv, &hash_index); } /* unrolled SvREFCNT_dec and sv_free2 follows: */ -- Perl5 Master Repository
