This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Set PL_statgv to null when freed or coerced
authorFather Chrysostomos <sprout@cpan.org>
Fri, 13 Jan 2012 23:50:51 +0000 (15:50 -0800)
committerFather Chrysostomos <sprout@cpan.org>
Sat, 14 Jan 2012 05:24:54 +0000 (21:24 -0800)
If PL_statgv is not set to null when freed, that same SV could be
reused for another GV, in which case -T _ will then use another handle
unrelated to the previous stat.

Similarly, if PL_statgv points to a fake glob that gets coerced into
a non-glob before it is freed, it will not follow the code path in
sv_free that sets PL_statgv to null.  Furthermore, if it becomes a GV
again, it could be a completely different filehandle, unrelated to the
previous stat.

sv.c
t/op/filetest.t

diff --git a/sv.c b/sv.c
index 1f9f787..b04649b 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -6136,6 +6136,8 @@ Perl_sv_clear(pTHX_ SV *const orig_sv)
            /* See also S_sv_unglob, which does the same thing. */
            if ((const GV *)sv == PL_last_in_gv)
                PL_last_in_gv = NULL;
+           else if ((const GV *)sv == PL_statgv)
+               PL_statgv = NULL;
        case SVt_PVMG:
        case SVt_PVNV:
        case SVt_PVIV:
@@ -9542,6 +9544,8 @@ S_sv_unglob(pTHX_ SV *const sv, U32 flags)
 
     if ((const GV *)sv == PL_last_in_gv)
        PL_last_in_gv = NULL;
+    else if ((const GV *)sv == PL_statgv)
+       PL_statgv = NULL;
 }
 
 /*
index 647bd9d..43baaf9 100644 (file)
@@ -10,7 +10,7 @@ BEGIN {
 }
 
 use Config;
-plan(tests => 36 + 27*14);
+plan(tests => 38 + 27*14);
 
 ok( -d 'op' );
 ok( -f 'TEST' );
@@ -248,14 +248,33 @@ for my $op (split //, "rwxoRWXOezsfdlpSbctugkTMBAC") {
   is $w, 1, 'file test does not call FETCH on stack item not its own';
 }
 
-# Test that -T HANDLE sets the last stat type
+# -T and -B
+
 SKIP: {
-    skip "no -T on filehandles", 1 unless eval { -T STDERR; 1 };
+    skip "no -T on filehandles", 3 unless eval { -T STDERR; 1 };
+
+    # Test that -T HANDLE sets the last stat type
     -l "perl.c";   # last stat type is now lstat
     -T STDERR;     # should set it to stat, since -T does a stat
     eval { -l _ }; # should die, because the last stat type is not lstat
     like $@, qr/^The stat preceding -l _ wasn't an lstat at /,
        '-T HANDLE sets the stat type';
+
+    # statgv should be cleared when freed
+    fresh_perl_is
+       'open my $fh, "test.pl"; -r $fh; undef $fh; open my $fh2, '
+       . "q\0" . which_perl() . "\0; print -B _",
+       '',
+       { switches => ['-l'] },
+       'PL_statgv should not point to freed-and-reused SV';
+
+    # or coerced into a non-glob
+    fresh_perl_is
+       'open Fh, "test.pl"; -r($h{i} = *Fh); $h{i} = 3; undef %h;'
+       . 'open my $fh2, ' . "q\0" . which_perl() . "\0; print -B _",
+       '',
+       { switches => ['-l'] },
+       'PL_statgv should not point to coerced-freed-and-reused GV';
 }
 
 is runperl(prog => '-T _', switches => ['-w'], stderr => 1), "",