This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #97988] Nullify PL_last_in_gv when unglobbed
authorFather Chrysostomos <sprout@cpan.org>
Sun, 18 Dec 2011 03:22:51 +0000 (19:22 -0800)
committerFather Chrysostomos <sprout@cpan.org>
Sun, 18 Dec 2011 07:19:03 +0000 (23:19 -0800)
Code like this can cause PL_last_in_gv to point to a coercible glob:

    $f{g} = *STDOUT;
    readline $f{g};

If $f{g} is then modified such that it is no longer a glob,
PL_last_in_gv ends up pointing to a non-glob:

    $f{g} = 3;

If $f{g} is freed now, the PL_last_in_gv-nulling code in sv_clear will
be skipped, as it only applies to globs.

    undef %f; # now PL_last_in_gv points to a freed scalar

The resulting freed scalar can be reused by another handle,

    *{"foom"} = *other;

causing tell() with no arguments to return the position on *other,
even though *other was no the last handle read from.

This commit fixes it by nulling PL_last_in_gv when a coercible glob
is coerced.

sv.c
t/op/readline.t

diff --git a/sv.c b/sv.c
index dec1794..fc8ee86 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -6116,6 +6116,7 @@ Perl_sv_clear(pTHX_ SV *const orig_sv)
            /* FIXME. There are probably more unreferenced pointers to SVs
             * in the interpreter struct that we should check and tidy in
             * a similar fashion to this:  */
+           /* See also S_sv_unglob, which does the same thing. */
            if ((const GV *)sv == PL_last_in_gv)
                PL_last_in_gv = NULL;
        case SVt_PVMG:
@@ -9518,6 +9519,9 @@ S_sv_unglob(pTHX_ SV *const sv, U32 flags)
        set operation as merely an internal storage change.  */
     if (flags & SV_COW_DROP_PV) SvOK_off(sv);
     else sv_setsv_flags(sv, temp, 0);
+
+    if ((const GV *)sv == PL_last_in_gv)
+       PL_last_in_gv = NULL;
 }
 
 /*
index 17567cd..fa0c4f7 100644 (file)
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 27;
+plan tests => 29;
 
 # [perl #19566]: sv_gets writes directly to its argument via
 # TARG. Test that we respect SvREADONLY.
@@ -256,6 +256,17 @@ ok !defined *$yunk, '<> does not autovivify';
 readline($yunk);
 ok !defined *$yunk, "readline does not autovivify";
 
+# [perl #97988] PL_last_in_gv could end up pointing to junk.
+#               Now glob copies set PL_last_in_gv to null when unglobbed.
+open *foom,'test.pl';
+my %f;
+$f{g} = *foom;
+readline $f{g};
+$f{g} = 3; # PL_last_in_gv should be cleared now
+is tell, -1, 'tell returns -1 after last gv is unglobbed';
+$f{g} = *foom; # since PL_last_in_gv is null, this should have no effect
+is tell, -1, 'unglobbery of last gv nullifies PL_last_in_gv';
+
 __DATA__
 moo
 moo