In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/7bdb4ff0943cf93297712faf504cdd425426e57f?hp=3ee45b3fd72ecaa02e3aa6aa1fe48554cc8acd4c>
- Log ----------------------------------------------------------------- commit 7bdb4ff0943cf93297712faf504cdd425426e57f Author: Father Chrysostomos <[email protected]> Date: Tue Sep 2 22:11:08 2014 -0700 Fix refcounting in rv2gv when it calls newGVgen When the compiler (op.c) canât figure out the name of a vivified file- handle based on the variable name, then pp.c:S_rv2gv (which vivifies the handle at run time) calls newGVgen, which generates something named _GEN_0 or suchlike. When it does that, the reference counting is wrong, because the stash gets a *_GEN_0 typeglob and the reference stored in openâs argument points to it, too; but the reference count is nevertheless 1. So if both sources shed their pointers to the GV, then you get a double free. Because usually the typeglob sits in the stash until program exit, this bug has gone unnoticed for a long time. This bug appears to have been present ever since rv2gv started call- ing newGVgen, in 2c8ac474a0. ----------------------------------------------------------------------- Summary of changes: pp.c | 1 + t/op/gv.t | 14 +++++++++++++- 2 files changed, 14 insertions(+), 1 deletion(-) diff --git a/pp.c b/pp.c index b098ede..7cadace 100644 --- a/pp.c +++ b/pp.c @@ -249,6 +249,7 @@ S_rv2gv(pTHX_ SV *sv, const bool vivify_sv, const bool strict, const char * const name = CopSTASHPV(PL_curcop); gv = newGVgen_flags(name, HvNAMEUTF8(CopSTASH(PL_curcop)) ? SVf_UTF8 : 0 ); + SvREFCNT_inc_simple_void_NN(gv); } prepare_SV_for_RV(sv); SvRV_set(sv, MUTABLE_SV(gv)); diff --git a/t/op/gv.t b/t/op/gv.t index 5fa8d6d..279a9af 100644 --- a/t/op/gv.t +++ b/t/op/gv.t @@ -12,7 +12,7 @@ BEGIN { use warnings; -plan( tests => 269 ); +plan( tests => 270 ); # type coercion on assignment $foo = 'foo'; @@ -1072,6 +1072,18 @@ package glob_constant_test { ::is "$@", "", 'no error from eval { &{+glob_constant} }'; } +{ + my $free2; + local $SIG{__WARN__} = sub { ++$free2 if shift =~ /Attempt to free/ }; + my $handleref; + my $proxy = \$handleref; + open $$proxy, "TEST"; + delete $::{*$handleref{NAME}}; # delete *main::_GEN_xxx + undef $handleref; + is $free2, undef, + 'no double free because of bad rv2gv/newGVgen refcounting'; +} + # Look away, please. # This violates perl's internal structures by fiddling with stashes in a # way that should never happen, but perl should not start trying to free -- Perl5 Master Repository
