In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/8941bf970eeb8009630d57a0b1bacb99f40db9bf?hp=3b927101bf18bfcb197cacec8603d2b8297963ae>
- Log ----------------------------------------------------------------- commit 8941bf970eeb8009630d57a0b1bacb99f40db9bf Author: Father Chrysostomos <[email protected]> Date: Tue Nov 5 06:14:59 2013 -0800 Stop gv_try_downgrade from anonymising referenced CVs I keep discovering ways in which gv_try_downgrade, which is supposed to be an optimisation, changes observable behaviour even without look- ing at the stash. This one had me confused at first: $ ./perl -Ilib -e 'use constant foo=>1; BEGIN { $x = \&foo } undef &$x; $x->()' Undefined subroutine called at -e line 1. $ ./perl -Ilib -e 'use constant foo=>1; BEGIN { $x = \&{"foo"} } undef &$x; $x->()' Undefined subroutine &main::foo called at -e line 1. Notice how the first example (where gv_try_downgrade kicks in) shows no name in the error message. This only happens on non- threaded builds. Whatâs happening is that, when the BEGIN block is freed, the GV op corresponding to &foo get freed, triggering gv_try_downgrade, which checks to see whether it can downgrade the GV to a simple reference to a constant (the way constants are stored by default). It then pro- ceeds to do that, so the GV qua GV ceases to exist, and the CV gets automatically anonymised as a result (the same thing happens with â$x = \&{"foo"}; Dump $x; delete $::{foo}â, but legitimately in that case). The solution here is to check the reference count on the CV before downgrading the GV. If the CVâs reference count > 1, then we should leave it alone. ----------------------------------------------------------------------- Summary of changes: gv.c | 2 +- t/op/gv.t | 8 +++++++- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/gv.c b/gv.c index f600942..97036bc 100644 --- a/gv.c +++ b/gv.c @@ -3345,7 +3345,7 @@ Perl_gv_try_downgrade(pTHX_ GV *gv) if (!cv) { HEK *gvnhek = GvNAME_HEK(gv); (void)hv_deletehek(stash, gvnhek, G_DISCARD); - } else if (GvMULTI(gv) && cv && + } else if (GvMULTI(gv) && cv && SvREFCNT(cv) == 1 && !SvOBJECT(cv) && !SvMAGICAL(cv) && !SvREADONLY(cv) && CvSTASH(cv) == stash && CvGV(cv) == gv && CvCONST(cv) && !CvMETHOD(cv) && !CvLVALUE(cv) && !CvUNIQUE(cv) && diff --git a/t/op/gv.t b/t/op/gv.t index ef46951..4910ee2 100644 --- a/t/op/gv.t +++ b/t/op/gv.t @@ -12,7 +12,7 @@ BEGIN { use warnings; -plan( tests => 257 ); +plan( tests => 258 ); # type coercion on assignment $foo = 'foo'; @@ -997,6 +997,12 @@ is runperl(prog => '$s = STDERR; close $s; undef *$s;' "Warning: something's wrong at -e line 1.\n", "try_downgrade does not touch PL_stderrgv"; +is runperl(prog => + 'use constant foo=>1; BEGIN { $x = \&foo } undef &$x; $x->()', + stderr=>1), + "Undefined subroutine &main::foo called at -e line 1.\n", + "gv_try_downgrade does not anonymise CVs referenced elsewhere"; + # 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 -- Perl5 Master Repository
