Fix readline overriden with a constant
authorFather Chrysostomos <sprout@cpan.org>
Tue, 5 Nov 2013 21:02:36 +0000 (13:02 -0800)
committerFather Chrysostomos <sprout@cpan.org>
Wed, 6 Nov 2013 13:56:03 +0000 (05:56 -0800)
<> doesn’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::readline"} = \&{"foo"}; 1}
warn <a>
__END__
Warning: something's wrong at - line 3.

use constant foo=>1;
BEGIN { *{"CORE::GLOBAL::readline"} = \&foo; 1}
warn <a>
__END__
Too many arguments for main::foo 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, the first of which triggers an optimisation.

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

t/op/override.t
toke.c

index 4fdb6a0..ce740ea 100644 (file)
@@ -8,7 +8,7 @@ BEGIN {
     require 'Config_heavy.pl'; # since runperl will need them
 }
 
-plan tests => 34;
+plan tests => 35;
 
 #
 # This file tries to test builtin override using CORE::GLOBAL
@@ -169,6 +169,12 @@ like runperl(prog => 'use constant foo=>1; '
              stderr => 1),
      qr/Too many arguments/,
     '`` does not ignore &CORE::GLOBAL::readpipe aliased to a constant';
+like runperl(prog => 'use constant foo=>1; '
+                    .'BEGIN { *{q|CORE::GLOBAL::readline|} = \&{q|foo|};1}'
+                    .'warn <a>',
+             stderr => 1),
+     qr/Too many arguments/,
+    '<> does not ignore &CORE::GLOBAL::readline aliased to a constant';
 
 is runperl(prog => 'use constant t=>42; '
                   .'BEGIN { *{q|CORE::GLOBAL::time|} = \&{q|t|};1}'
diff --git a/toke.c b/toke.c
index 6479336..63f7990 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -10435,8 +10435,13 @@ S_scan_inputsymbol(pTHX_ char *start)
                && GvCVu(gv_readline) && GvIMPORTED_CV(gv_readline))
                ||
                ((gvp = (GV**)hv_fetchs(PL_globalstash, "readline", FALSE))
-                && (gv_readline = *gvp) && isGV_with_GP(gv_readline)
-               && GvCVu(gv_readline) && GvIMPORTED_CV(gv_readline)))
+                && (gv_readline = *gvp) && (
+                   isGV_with_GP(gv_readline)
+                       ? GvCVu(gv_readline) && GvIMPORTED_CV(gv_readline)
+                       :   SvPCS_IMPORTED(gv_readline)
+                        && (gv_init(gv_readline, PL_globalstash,
+                                   "readline", 8, 0), 1)
+               )))
            readline_overriden = TRUE;
 
        /* if <$fh>, create the ops to turn the variable into a