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.

diff --git a/gv.c b/gv.c
index f600942..97036bc 100644 (file)
--- 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 (file)
--- 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