Stop ck_rvconst from treating GV constants as strings

sub foo { 42 }
use constant bar => *foo;
BEGIN { undef *foo }
warn &{+bar};
warn bar->();

Obviously the last two lines should print the same thing, because they
both call the value of the ‘bar’ constant as a suroutine.

But op.c:ck_rvconst messes up the ‘bar->()’ at compile time, treating
the bar glob (a copy of the original *foo glob, and not the *foo glob
itself, which has since been undefined) as a string and using it to
look up a glob.

ck_rvconst should not do anything if the constant’s value is a glob.

diff --git a/op.c b/op.c
index ff3855e..e017842 100644 (file)
--- a/op.c
+++ b/op.c
@@ -8833,7 +8833,7 @@ Perl_ck_rvconst(pTHX_ OP *o)
        SV * const kidsv = kid->op_sv;
 
        /* Is it a constant from cv_const_sv()? */
-       if (SvROK(kidsv) && SvREADONLY(kidsv)) {
+       if ((SvROK(kidsv) || isGV_with_GP(kidsv)) && SvREADONLY(kidsv)) {
            return o;
        }
        if (SvTYPE(kidsv) == SVt_PVAV) return o;

diff --git a/t/op/gv.t b/t/op/gv.t
index f1ef962..c1b741a 100644 (file)
--- a/t/op/gv.t
+++ b/t/op/gv.t
@@ -12,7 +12,7 @@ BEGIN {
 
 use warnings;
 
-plan( tests => 267 );
+plan( tests => 269 );
 
 # type coercion on assignment
 $foo = 'foo';
@@ -1063,6 +1063,15 @@ is runperl(prog =>
   "Undefined subroutine &main::foo called at -e line 1.\n",
   "gv_try_downgrade does not anonymise CVs referenced elsewhere";
 
+package glob_constant_test {
+  sub foo { 42 }
+  use constant bar => *foo;
+  BEGIN { undef *foo }
+  ::is eval { bar->() }, eval { &{+bar} },
+    'glob_constant->() is not mangled at compile time';
+  ::is "$@", "", 'no error from eval { &{+glob_constant} }';
+}
+
 # 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