This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix refcounting in rv2gv when it calls newGVgen
authorFather Chrysostomos <sprout@cpan.org>
Wed, 3 Sep 2014 05:11:08 +0000 (22:11 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Wed, 3 Sep 2014 05:11:08 +0000 (22:11 -0700)
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.

pp.c
t/op/gv.t

diff --git a/pp.c b/pp.c
index b098ede..7cadace 100644 (file)
--- 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));
index 5fa8d6d..279a9af 100644 (file)
--- 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