Fix readpipe overriden with a constant

qx and `` don’t take into account that some subs are stored in a more
lightweight form than usual.  These two programs should behave the
same way, but, as you can see below the __END__ markers, the output is
different:

use constant foo=>1;
BEGIN { *{"CORE::GLOBAL::readpipe"} = \&{"foo"}; 1}
warn ``
__END__
Warning: something's wrong at - line 3.

use constant foo=>1; BEGIN { *{"CORE::GLOBAL::readpipe"} = \&{"foo"}; 1} warn ``
__END__
Too many arguments for CORE::GLOBAL::readpipe at - line 3, at end of line
Execution of -e aborted due to compilation errors.

The latter is the correct behaviour.¹  The only different is \&{"foo"}
vs \&foo, which triggers an optimisation.

S_readpipe_override in toke.c needs to take the optimisation into
account (that stash entries are not necessarily globs but can be
upgraded to such).

¹ Except that the sub name reported is unexpected.  Non-threaded
  builds give me that; threaded builds give me main::foo.  But that is
  a separate bug.

diff --git a/t/op/override.t b/t/op/override.t
index 71c2ac2..15afb05 100644 (file)
--- a/t/op/override.t
+++ b/t/op/override.t
@@ -8,7 +8,7 @@ BEGIN {
     require 'Config_heavy.pl'; # since runperl will need them
 }
 
-plan tests => 32;
+plan tests => 33;
 
 #
 # This file tries to test builtin override using CORE::GLOBAL
@@ -162,3 +162,10 @@ is runperl(prog => 'sub CORE::GLOBAL::glob; glob; print qq-ok\n-'),
 is runperl(prog => 'sub CORE::GLOBAL::require; require re; print qq-o\n-'),
   "o\n",
   'no crash with CORE::GLOBAL::require stub';
+
+like runperl(prog => 'use constant foo=>1; '
+                    .'BEGIN { *{q|CORE::GLOBAL::readpipe|} = \&{q|foo|};1}'
+                    .'warn ``',
+             stderr => 1),
+     qr/Too many arguments/,
+    '`` does not ignore &CORE::GLOBAL::readpipe aliased to a constant';

diff --git a/toke.c b/toke.c
index f9d0a62..bd65fd3 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -4487,8 +4487,13 @@ S_readpipe_override(pTHX)
                && GvCVu(gv_readpipe) && GvIMPORTED_CV(gv_readpipe))
            ||
            ((gvp = (GV**)hv_fetchs(PL_globalstash, "readpipe", FALSE))
-            && (gv_readpipe = *gvp) && isGV_with_GP(gv_readpipe)
-            && GvCVu(gv_readpipe) && GvIMPORTED_CV(gv_readpipe)))
+            && (gv_readpipe = *gvp) && (
+               isGV_with_GP(gv_readpipe)
+                   ? GvCVu(gv_readpipe) && GvIMPORTED_CV(gv_readpipe)
+                   :   SvPCS_IMPORTED(gv_readpipe)
+                    && (gv_init(gv_readpipe, PL_globalstash, "readpipe",
+                                8, 0), 1)
+            )))
     {
        COPLINE_SET_FROM_MULTI_END;
        PL_lex_op = (OP*)newUNOP(OP_ENTERSUB, OPf_STACKED,