[perl #113016] Parse CORE::foo::bar as a bareword

CORE::print::foo was being parsed as CORE::print followed by
::foo, making it impossible to call a global override directly as
CORE::GLOBAL::uc().

The logic in toke.c that does the CORE:: special-casing was faulty.
This commit fixes it, by checking for a package separator after the
potential keyword.

That d = s part of the KEY_CORE case in yylex was added in perl 5.001
(748a9306) but apparently wasn’t doing anything.  That means I get to
move it before s+=2, now that I have a use for it.

I added the tests a little above the ‘Add new tests HERE’ label in
parser.t, to avoid conflicting with other patches I’m working on.

diff --git a/t/comp/parser.t b/t/comp/parser.t
index c0fc246..9ae7b75 100644 (file)
--- a/t/comp/parser.t
+++ b/t/comp/parser.t
@@ -3,7 +3,7 @@
 # Checks if the parser behaves correctly in edge cases
 # (including weird syntax errors)
 
-print "1..135\n";
+print "1..137\n";
 
 sub failed {
     my ($got, $expected, $name) = @_;
@@ -348,6 +348,12 @@ like($@, qr/BEGIN failed--compilation aborted/, 'BEGIN 7' );
   is(defined &zlonk, '', 'but no body defined');
 }
 
+# [perl #113016] CORE::print::foo
+sub CORE'print'foo { 43 } # apostrophes intentional; do not tempt fate
+sub CORE'foo'bar { 43 }
+is CORE::print::foo, 43, 'CORE::print::foo is not CORE::print ::foo';
+is scalar eval "CORE::foo'bar", 43, "CORE::foo'bar is not an error";
+
 # bug #71748
 eval q{
        $_ = "";

diff --git a/toke.c b/toke.c
index 439ce15..c6e77b2 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -7226,10 +7226,19 @@ Perl_yylex(pTHX)
 
        case KEY_CORE:
            if (*s == ':' && s[1] == ':') {
-               s += 2;
+               STRLEN olen = len;
                d = s;
+               s += 2;
                s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len);
-               if (!(tmp = keyword(PL_tokenbuf, len, 1)))
+               if ((*s == ':' && s[1] == ':')
+                || (!(tmp = keyword(PL_tokenbuf, len, 1)) && *s == '\''))
+               {
+                   s = d;
+                   len = olen;
+                   Copy(PL_bufptr, PL_tokenbuf, olen, char);
+                   goto just_a_word;
+               }
+               if (!tmp)
                    Perl_croak(aTHX_ "CORE::%"SVf" is not a keyword",
                                     SVfARG(newSVpvn_flags(PL_tokenbuf, len,
                                                 (UTF ? SVf_UTF8 : 0) | SVs_TEMP)));