In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/39984de3a8e9c16c0fee320a579cb465d0ce7314?hp=253f88ce6ee2d400a0c748e239c2acd0f84bcffb>
- Log ----------------------------------------------------------------- commit 39984de3a8e9c16c0fee320a579cb465d0ce7314 Author: Father Chrysostomos <[email protected]> Date: Sat Sep 22 12:06:45 2012 -0700 Stop array assignment from leaking on croak This made a to-do test in sort.t pass, but adventitiously, so I modi- fied it to fail again. M pp_hot.c M t/op/sort.t M t/op/svleak.t commit 9c744f4f4d7678009336db8141276918751b7c52 Author: Father Chrysostomos <[email protected]> Date: Sat Sep 22 07:12:04 2012 -0700 Stop hash assignment from leaking on croak M pp_hot.c M t/op/svleak.t commit 895cdc83ca4f8ad093074b3bd5d0fbc1d09f7628 Author: Father Chrysostomos <[email protected]> Date: Fri Sep 21 22:01:19 2012 -0700 Free iterator when freeing tied hash The current iterator was leaking when a tied hash was freed or undefined. Since we already have a mechanism, namely HvLAZYDEL, for freeing HvEITER when not referenced elsewhere, we can use that. M hv.c M t/op/svleak.t commit aec0c0cc27651656899efeb7c4f64d2838a9cf9e Author: Father Chrysostomos <[email protected]> Date: Fri Sep 21 18:23:20 2012 -0700 Donât leak deleted iterator when tying hash M pp_sys.c M t/op/tie.t ----------------------------------------------------------------------- Summary of changes: hv.c | 3 +++ pp_hot.c | 10 ++++------ pp_sys.c | 7 +++++++ t/op/sort.t | 3 ++- t/op/svleak.t | 33 ++++++++++++++++++++++++++++++++- t/op/tie.t | 12 ++++++++++++ 6 files changed, 60 insertions(+), 8 deletions(-) diff --git a/hv.c b/hv.c index 36b7038..14f3399 100644 --- a/hv.c +++ b/hv.c @@ -2370,6 +2370,7 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags) if (entry) { sv_setsv(key, HeSVKEY_force(entry)); SvREFCNT_dec(HeSVKEY(entry)); /* get rid of previous key */ + HeSVKEY_set(entry, NULL); } else { char *k; @@ -2377,6 +2378,7 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags) /* one HE per MAGICAL hash */ iter->xhv_eiter = entry = new_HE(); /* HvEITER(hv) = new_HE() */ + HvLAZYDEL_on(hv); /* make sure entry gets freed */ Zero(entry, 1, HE); Newxz(k, HEK_BASESIZE + sizeof(const SV *), char); hek = (HEK*)k; @@ -2393,6 +2395,7 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags) Safefree(HeKEY_hek(entry)); del_HE(entry); iter->xhv_eiter = NULL; /* HvEITER(hv) = NULL */ + HvLAZYDEL_off(hv); return NULL; } } diff --git a/pp_hot.c b/pp_hot.c index 827395f..a8d762b 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -982,15 +982,14 @@ PP(pp_aassign) while (relem <= lastrelem) { /* gobble up all the rest */ SV **didstore; assert(*relem); - sv = newSV(0); + sv = sv_newmortal(); sv_setsv(sv, *relem); *(relem++) = sv; didstore = av_store(ary,i++,sv); + if (didstore) SvREFCNT_inc_simple_void_NN(sv); if (magic) { if (SvSMAGICAL(sv)) mg_set(sv); - if (!didstore) - sv_2mortal(sv); } TAINT_NOT; } @@ -1013,7 +1012,7 @@ PP(pp_aassign) HE *didstore; sv = *relem ? *relem : &PL_sv_no; relem++; - tmpstr = newSV(0); + tmpstr = sv_newmortal(); if (*relem) sv_setsv(tmpstr,*relem); /* value */ relem++; @@ -1030,11 +1029,10 @@ PP(pp_aassign) } } didstore = hv_store_ent(hash,sv,tmpstr,0); + if (didstore) SvREFCNT_inc_simple_void_NN(tmpstr); if (magic) { if (SvSMAGICAL(tmpstr)) mg_set(tmpstr); - if (!didstore) - sv_2mortal(tmpstr); } TAINT_NOT; } diff --git a/pp_sys.c b/pp_sys.c index 2a7f43e..a41c6d1 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -861,9 +861,16 @@ PP(pp_tie) switch(SvTYPE(varsv)) { case SVt_PVHV: + { + HE *entry; methname = "TIEHASH"; + if (HvLAZYDEL(varsv) && (entry = HvEITER((HV *)varsv))) { + HvLAZYDEL_off(varsv); + hv_free_ent((HV *)varsv, entry); + } HvEITER_set(MUTABLE_HV(varsv), 0); break; + } case SVt_PVAV: methname = "TIEARRAY"; if (!AvREAL(varsv)) { diff --git a/t/op/sort.t b/t/op/sort.t index 6dedeeb..0371f4f 100644 --- a/t/op/sort.t +++ b/t/op/sort.t @@ -770,7 +770,8 @@ cmp_ok($answer,'eq','good','sort subr called from other package'); { local $TODO = "sort should make sure elements are not freed in the sort block"; - eval { @nomodify_x=(1..8); our @copy = sort { @nomodify_x = (0) } (@nomodify_x, 3); }; + eval { @nomodify_x=(1..8); + our @copy = sort { undef @nomodify_x; 1 } (@nomodify_x, 3); }; is($@, ""); } diff --git a/t/op/svleak.t b/t/op/svleak.t index e6636b8..d975cf1 100644 --- a/t/op/svleak.t +++ b/t/op/svleak.t @@ -15,7 +15,7 @@ BEGIN { use Config; -plan tests => 28; +plan tests => 31; # run some code N times. If the number of SVs at the end of loop N is # greater than (N-1)*delta at the end of loop 1, we've got a leak @@ -186,3 +186,34 @@ SKIP: { # [perl #114764] Attributes leak scalars leak(2, 0, sub { eval 'my $x : shared' }, 'my $x :shared used to leak'); + +# Tied hash iteration was leaking if the hash was freed before itera- +# tion was over. +package t { + sub TIEHASH { bless [] } + sub FIRSTKEY { 0 } +} +leak(2, 0, sub { + my $h = {}; + tie %$h, t; + each %$h; + undef $h; +}, 'tied hash iteration does not leak'); + +# List assignment was leaking when assigning explosive scalars to +# aggregates. +package sty { + sub TIESCALAR { bless [] } + sub FETCH { die } +} +leak(2, 0, sub { + tie my $x, sty; + eval {%a = ($x, 0)}; # key + eval {%a = (0, $x)}; # value + eval {%a = ($x,$x)}; # both +}, 'hash assignment does not leak'); +leak(2, 0, sub { + tie my $x, sty; + eval {@a = ($x)}; +}, 'array assignment does not leak'); + diff --git a/t/op/tie.t b/t/op/tie.t index a997c41..5808a09 100644 --- a/t/op/tie.t +++ b/t/op/tie.t @@ -1289,4 +1289,16 @@ untie @a; sub T::TIEARRAY { my $s; bless \$s => "T" } EXPECT +######## +# NAME Test that tying a hash does not leak a deleted iterator +# This produced unbalanced string table warnings under +# PERL_DESTRUCT_LEVEL=2. +package l { + sub TIEHASH{bless[]} +} +$h = {foo=>0}; +each %$h; +delete $$h{foo}; +tie %$h, 'l'; +EXPECT -- Perl5 Master Repository
