In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/3607ca02d65ff63a9322effaf09e60361984e109?hp=8376a7bfebc88cd8955782fa2c6b6ce3a54a7cb0>
- Log ----------------------------------------------------------------- commit 3607ca02d65ff63a9322effaf09e60361984e109 Author: Father Chrysostomos <[email protected]> Date: Sun Apr 15 22:01:26 2012 -0700 [perl #112444] Donât leak %^H autovivified by destructor More precisely, donât let a hint hash autovivified by a destructor during scope exit leak to outer scopes. GvHV(PL_hintgv) (aka *^H{HASH}) must be set to null before the hash in it is freed on scope exit. Otherwise destructors will see %^H with a refcount of zero, and might try to iterate over a hash that is in the process of being freed. Bad things then happen. Commit 2653c1e3b1 took care of this. Now, if GvHV(PL_hintgv) is null when destructors are called, those destructors might end up autovivifying it. The code in scope.c that handles hints when a scope is left (SAVEt_HINTS in Perl_leave_scope) would then end up leaving that new autovivified %^H in place when the scope exited, if the outer scope did not have HINT_LOCALIZE_HH set (meaning %^H was unused). That in itself would not be so much of a problem, if it were not for the fact that %^H is magicalised by the scope-handling code, not when it is autovivified (see also bug #112458). Hence, subsequent changes to %^H would not magically set the HINT_LOCALIZE_HH hint bit, which bit is checked all over the place to see whether %^H is in use. This, in turn, would cause hints subsequently added to %^H to leak to outer scopes. This commit fixes that by repeatedly freeing GvHV(PL_hintgv). If a destructor autovivifies it again, it just causes another iteration of the while loop. This does mean a destructor could autovivify %^H and cause the new %^H itself to trigger a destructor, resulting in infi- nite loops. But then that is that own codeâs fault. This originally came up because commit 2653c1e3b1 also caused des- tructors that try to add new free magic to %^H to add it to a new autovivified %^H instead of the existing %^H that was being freed. This caused the nextgen module to fail its tests, because it uses B::Hooks::EndOfScope to register a sub to be called on scope exit, and it does this from a destructor itself called during scope exit. If the autovivified %^H leaks to an outer scope, the second destructor is not called. ----------------------------------------------------------------------- Summary of changes: scope.c | 4 +++- t/comp/hints.t | 34 ++++++++++++++++++++++++++++++++-- 2 files changed, 35 insertions(+), 3 deletions(-) diff --git a/scope.c b/scope.c index 1bf79e0..ffd0552 100644 --- a/scope.c +++ b/scope.c @@ -1023,10 +1023,12 @@ Perl_leave_scope(pTHX_ I32 base) PL_op = (OP*)SSPOPPTR; break; case SAVEt_HINTS: - if ((PL_hints & HINT_LOCALIZE_HH) && GvHV(PL_hintgv)) { + if ((PL_hints & HINT_LOCALIZE_HH)) { + while (GvHV(PL_hintgv)) { HV *hv = GvHV(PL_hintgv); GvHV(PL_hintgv) = NULL; SvREFCNT_dec(MUTABLE_SV(hv)); + } } cophh_free(CopHINTHASH_get(&PL_compiling)); CopHINTHASH_set(&PL_compiling, (COPHH*)SSPOPPTR); diff --git a/t/comp/hints.t b/t/comp/hints.t index d22b15e..a857755 100644 --- a/t/comp/hints.t +++ b/t/comp/hints.t @@ -6,7 +6,7 @@ BEGIN { @INC = qw(. ../lib); } -BEGIN { print "1..30\n"; } +BEGIN { print "1..31\n"; } BEGIN { print "not " if exists $^H{foo}; print "ok 1 - \$^H{foo} doesn't exist initially\n"; @@ -238,6 +238,36 @@ print "ok 26 - no crash when cloning a tied hint hash\n"; } +# [perl #112444] +# A destructor called while %^H is freed should not be able to stop %^H +# from being magical (due to *^H{HASH} being undef). +{ + BEGIN { + # Make sure %^H is clear and not localised, to begin with + %^H = (); + $^H = 0; + } + DESTROY { %^H } + { + { + BEGIN { + $^H{foom} = bless[]; + } + } # scope exit triggers destructor, which autovivifies a non- + # magical %^H + BEGIN { + # Here we have the %^H created by DESTROY, which is + # not localised + $^H{112444} = 'baz'; + } + } # %^H leaks on scope exit + BEGIN { @keez = keys %^H } +} +print "not " if @keez; +print "ok 30 - %^H does not leak when autovivified in destructor\n"; +print "# keys are: @keez\n" if @keez; + + # Add new tests above this require, in case it fails. require './test.pl'; @@ -247,7 +277,7 @@ my $result = runperl( stderr => 1 ); print "not " if length $result; -print "ok 30 - double-freeing hints hash\n"; +print "ok 31 - double-freeing hints hash\n"; print "# got: $result\n" if length $result; __END__ -- Perl5 Master Repository
