Don’t let gv.c:gv_try_downgrade touch PL_statgv
authorFather Chrysostomos <sprout@cpan.org>
Sat, 26 Oct 2013 19:28:11 +0000 (12:28 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Sat, 26 Oct 2013 19:28:11 +0000 (12:28 -0700)
PL_statgv remembers the handle last used by stat, for the sake of -T _
and -B _.  If a glob is freed when PL_statgv points to it, PL_statgv
is set to null.

gv_try_downgrade exists to remove globs and subs that were (possibly
temporarily) vivified by bareword lookup.  It is called whenever a
gvop is freed and its gv looks like a candidate for downgrading.  That
means it applies, not only to potential sub calls, but also to *foo
and *bar.  gv_try_downgrade may delete a glob from the stash alto-
gether if it is empty.  So eval "*foo if 0" may delete the *foo glob.

If PL_statgv is pointing to *foo, then eval "*foo if 0" may change the
behaviour, which is not supposed to happen:

$ ./perl -Ilib -le 'stat *{"foo"}; -T _; print $!; -T _; print $!'
Bad file descriptor
Bad file descriptor
$ ./perl -Ilib -le 'stat *{"foo"}; -T _; print $!; eval "*foo if 0"; -T _; print $!'
Bad file descriptor
No such file or directory

gv.c
t/op/gv.t

diff --git a/gv.c b/gv.c
index 476afc5..4e0611b 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -3322,6 +3322,7 @@ Perl_gv_try_downgrade(pTHX_ GV *gv)
            !GvSV(gv) && !GvAV(gv) && !GvHV(gv) && !GvIOp(gv) && !GvFORM(gv) &&
            GvEGVx(gv) == gv && (stash = GvSTASH(gv))))
        return;
+    if (gv == PL_statgv) return;
     if (SvMAGICAL(gv)) {
         MAGIC *mg;
        /* only backref magic is allowed */
index 7494e09..8a70f31 100644 (file)
--- a/t/op/gv.t
+++ b/t/op/gv.t
@@ -12,7 +12,7 @@ BEGIN {
 
 use warnings;
 
-plan( tests => 254 );
+plan( tests => 255 );
 
 # type coercion on assignment
 $foo = 'foo';
@@ -977,6 +977,17 @@ package lrcg {
     'constants w/nulls in their names point 2 the right GVs when promoted';
 }
 
+{
+  no warnings 'io';
+  stat *{"try_downgrade"};
+  -T _;
+  $bang = $!;
+  eval "*try_downgrade if 0";
+  -T _;
+  is "$!",$bang,
+     'try_downgrade does not touch PL_statgv (last stat handle)';
+}
+
 # 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