This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Stop readline(*$glob_copy) from clearing PL_last_in_gv
authorFather Chrysostomos <sprout@cpan.org>
Sun, 18 Dec 2011 21:34:44 +0000 (13:34 -0800)
committerFather Chrysostomos <sprout@cpan.org>
Sun, 18 Dec 2011 21:34:44 +0000 (13:34 -0800)
This is related to commit 8dc99089, which fixed a similar bug in tell.
In readline(*$glob_copy), the * makes a mortal copy of $glob_copy,
turning off its fake flag.  readline sets PL_last_in_gv to its argu-
ment, but it gets freed at the end of the statement and PL_last_in_gv
gets cleared.

op.c
t/op/readline.t

diff --git a/op.c b/op.c
index 146c368..46b0522 100644 (file)
--- a/op.c
+++ b/op.c
@@ -8285,7 +8285,11 @@ Perl_ck_readline(pTHX_ OP *o)
 {
     PERL_ARGS_ASSERT_CK_READLINE;
 
-    if (!(o->op_flags & OPf_KIDS)) {
+    if (o->op_flags & OPf_KIDS) {
+        OP *kid = cLISTOPo->op_first;
+        if (kid->op_type == OP_RV2GV) kid->op_private |= OPpALLOW_FAKE;
+    }
+    else {
        OP * const newop
            = newUNOP(OP_READLINE, 0, newGVOP(OP_GV, 0, PL_argvgv));
 #ifdef PERL_MAD
index fa0c4f7..944cd7a 100644 (file)
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 29;
+plan tests => 30;
 
 # [perl #19566]: sv_gets writes directly to its argument via
 # TARG. Test that we respect SvREADONLY.
@@ -266,6 +266,8 @@ $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';
+readline *{$f{g}};
+is tell, tell *foom, 'readline *$glob_copy sets PL_last_in_gv';
 
 __DATA__
 moo