From 2be08ad105a2a12613bb690aae26e2a9d3b225f2 Mon Sep 17 00:00:00 2001 From: Father Chrysostomos Date: Sun, 27 Oct 2013 16:02:44 -0700 Subject: [PATCH] gv:gv_try_downgrade: Leave PL_last_in_gv alone 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. PL_last_in_gv is the internal variable underlying ${^LAST_FH}. If gv_try_downgrade deletes the last-read handle, then ${^LAST_FH} will become undefined, whereas eval "*foo if 0" is not supposed to do anything: $ ./miniperl -le 'readline *{"foo"}; warn ${^LAST_FH}; eval "*foo if 0"; warn ${^LAST_FH}' GLOB(0x7f8f5a0052a0) at -e line 1. Warning: something's wrong at -e line 1. --- gv.c | 3 ++- t/op/gv.t | 6 +++++- 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/gv.c b/gv.c index 93e6ccc..c745315 100644 --- a/gv.c +++ b/gv.c @@ -3320,7 +3320,8 @@ 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 || gv == PL_stderrgv) return; + if (gv == PL_statgv || gv == PL_last_in_gv || gv == PL_stderrgv) + return; if (SvMAGICAL(gv)) { MAGIC *mg; /* only backref magic is allowed */ diff --git a/t/op/gv.t b/t/op/gv.t index 804ddd6..ef46951 100644 --- a/t/op/gv.t +++ b/t/op/gv.t @@ -12,7 +12,7 @@ BEGIN { use warnings; -plan( tests => 256 ); +plan( tests => 257 ); # type coercion on assignment $foo = 'foo'; @@ -986,6 +986,10 @@ package lrcg { -T _; is "$!",$bang, 'try_downgrade does not touch PL_statgv (last stat handle)'; + readline *{"try_downgrade2"}; + my $lastfh = "${^LAST_FH}"; + eval "*try_downgrade2 if 0"; + is ${^LAST_FH}, $lastfh, 'try_downgrade does not touch PL_last_in_gv'; } is runperl(prog => '$s = STDERR; close $s; undef *$s;' -- 2.7.4