Allow => to quote built-in keywords across lines

If I have a sub I can use its name as a bareword as long as I suffix
it with =>, even if the => is on the next line:

$ ./perl -Ilib -e 'sub tim; warn tim' -e '=>'
tim at -e line 1.

If I want to use a built-in keyword’s name as a bareword, I can put =>
after it:

$ ./perl -Ilib -e 'warn time =>'
time at -e line 1.

But if I combine the two (keyword + newline), it does not work:

$ ./perl -Ilib -e 'warn time' -e ' =>'
1373611283 at -e line 1.

unless I override the keyword:

$ ./perl -Ilib -Msubs=time -e 'warn time' -e ' =>'
time at -e line 1.

=> after a bareword is checked for in two places in toke.c.  The first
comes before a comment saying ‘NO SKIPSPACE BEFORE HERE!’; it only
skips spaces and finds a => on the same line.  The second comes later;
it skips vertical space and comments, too.

But the second check is in a code path that is not reached by keywords
that are not overridden (as is the ‘NO SKIPSPACE’ comment).

This commit adds an extra check for built-in keywords after we have
determined that the keyword is not overridden.  In that case, there is
no reason we cannot use skipspace, as we no longer have to worry about
what PL_oldbufptr etc. point to.

This commit leaves __DATA__ and __END__ alone, since they
are special, problematic and controversial.  (See, e.g.,
<https://rt.perl.org/rt3/Ticket/Display.html?id=78348#txn-1234355>.)

diff --git a/embed.fnc b/embed.fnc
index df387d1..9873ba5 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -2212,7 +2212,7 @@ s |char*  |scan_word      |NN char *s|NN char *dest|STRLEN destlen \
                                |int allow_package|NN STRLEN *slp
 s      |void   |update_debugger_info|NULLOK SV *orig_sv \
                                |NULLOK const char *const buf|STRLEN len
-sR     |char*  |skipspace      |NN char *s
+sR     |char*  |skipspace_flags|NN char *s|U32 flags
 sR     |char*  |swallow_bom    |NN U8 *s
 #ifndef PERL_NO_UTF16_FILTER
 s      |I32    |utf16_textfilter|int idx|NN SV *sv|int maxlen

diff --git a/embed.h b/embed.h
index 2fc8466..82fa57d 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -1621,7 +1621,7 @@
 #define scan_subst(a)          S_scan_subst(aTHX_ a)
 #define scan_trans(a)          S_scan_trans(aTHX_ a)
 #define scan_word(a,b,c,d,e)   S_scan_word(aTHX_ a,b,c,d,e)
-#define skipspace(a)           S_skipspace(aTHX_ a)
+#define skipspace_flags(a,b)   S_skipspace_flags(aTHX_ a,b)
 #define sublex_done()          S_sublex_done(aTHX)
 #define sublex_push()          S_sublex_push(aTHX)
 #define sublex_start()         S_sublex_start(aTHX)

diff --git a/proto.h b/proto.h
index 242e35b..b0197e5 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -7340,10 +7340,10 @@ STATIC char*    S_scan_word(pTHX_ char *s, char *dest, STRLEN destlen, int allow_pa
 #define PERL_ARGS_ASSERT_SCAN_WORD     \
        assert(s); assert(dest); assert(slp)
 
-STATIC char*   S_skipspace(pTHX_ char *s)
+STATIC char*   S_skipspace_flags(pTHX_ char *s, U32 flags)
                        __attribute__warn_unused_result__
                        __attribute__nonnull__(pTHX_1);
-#define PERL_ARGS_ASSERT_SKIPSPACE     \
+#define PERL_ARGS_ASSERT_SKIPSPACE_FLAGS       \
        assert(s)
 
 STATIC I32     S_sublex_done(pTHX)

diff --git a/t/base/lex.t b/t/base/lex.t
index 7ef7538..7821e76 100644 (file)
--- a/t/base/lex.t
+++ b/t/base/lex.t
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..93\n";
+print "1..94\n";
 
 $x = 'x';
 
@@ -443,3 +443,7 @@ y # comment
  ;
 print "not " unless $_ eq 'b';
 print "ok 93 - y <comment> <newline> ...\n";
+
+print "not " unless (time
+                     =>) eq time=>;
+print "ok 94 - => quotes keywords across lines\n";

diff --git a/toke.c b/toke.c
index 45f9f0e..a9f1bb7 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -1512,14 +1512,16 @@ chunk will not be discarded.
 =cut
 */
 
+#define LEX_NO_INCLINE    0x40000000
 #define LEX_NO_NEXT_CHUNK 0x80000000
 
 void
 Perl_lex_read_space(pTHX_ U32 flags)
 {
     char *s, *bufend;
+    const bool can_incline = !(flags & LEX_NO_INCLINE);
     bool need_incline = 0;
-    if (flags & ~(LEX_KEEP_PREVIOUS|LEX_NO_NEXT_CHUNK))
+    if (flags & ~(LEX_KEEP_PREVIOUS|LEX_NO_NEXT_CHUNK|LEX_NO_INCLINE))
        Perl_croak(aTHX_ "Lexing code internal error (%s)", "lex_read_space");
 #ifdef PERL_MAD
     if (PL_skipwhite) {
@@ -1539,11 +1541,13 @@ Perl_lex_read_space(pTHX_ U32 flags)
            } while (!(c == '\n' || (c == 0 && s == bufend)));
        } else if (c == '\n') {
            s++;
-           PL_parser->linestart = s;
-           if (s == bufend)
-               need_incline = 1;
-           else
-               incline(s);
+           if (can_incline) {
+               PL_parser->linestart = s;
+               if (s == bufend)
+                   need_incline = 1;
+               else
+                   incline(s);
+           }
        } else if (isSPACE(c)) {
            s++;
        } else if (c == 0 && s == bufend) {
@@ -1555,14 +1559,14 @@ Perl_lex_read_space(pTHX_ U32 flags)
            if (flags & LEX_NO_NEXT_CHUNK)
                break;
            PL_parser->bufptr = s;
-           COPLINE_INC_WITH_HERELINES;
+           if (can_incline) COPLINE_INC_WITH_HERELINES;
            got_more = lex_next_chunk(flags);
-           CopLINE_dec(PL_curcop);
+           if (can_incline) CopLINE_dec(PL_curcop);
            s = PL_parser->bufptr;
            bufend = PL_parser->bufend;
            if (!got_more)
                break;
-           if (need_incline && PL_parser->rsfp) {
+           if (can_incline && need_incline && PL_parser->rsfp) {
                incline(s);
                need_incline = 0;
            }
@@ -1830,6 +1834,8 @@ S_incline(pTHX_ const char *s)
     CopLINE_set(PL_curcop, line_num);
 }
 
+#define skipspace(s) skipspace_flags(s, 0)
+
 #ifdef PERL_MAD
 /* skip space before PL_thistoken */
 
@@ -1935,12 +1941,12 @@ S_update_debugger_info(pTHX_ SV *orig_sv, const char *const buf, STRLEN len)
  */
 
 STATIC char *
-S_skipspace(pTHX_ char *s)
+S_skipspace_flags(pTHX_ char *s, U32 flags)
 {
 #ifdef PERL_MAD
     char *start = s;
 #endif /* PERL_MAD */
-    PERL_ARGS_ASSERT_SKIPSPACE;
+    PERL_ARGS_ASSERT_SKIPSPACE_FLAGS;
 #ifdef PERL_MAD
     if (PL_skipwhite) {
        sv_free(PL_skipwhite);
@@ -1953,7 +1959,7 @@ S_skipspace(pTHX_ char *s)
     } else {
        STRLEN bufptr_pos = PL_bufptr - SvPVX(PL_linestr);
        PL_bufptr = s;
-       lex_read_space(LEX_KEEP_PREVIOUS |
+       lex_read_space(flags | LEX_KEEP_PREVIOUS |
                (PL_sublex_info.sub_inwhat || PL_lex_state == LEX_FORMLINE ?
                    LEX_NO_NEXT_CHUNK : 0));
        s = PL_bufptr;
@@ -6961,6 +6967,7 @@ Perl_yylex(pTHX)
 
        /* Is this a word before a => operator? */
        if (*d == '=' && d[1] == '>') {
+         fat_arrow:
            CLINE;
            pl_yylval.opval
                = (OP*)newSVOP(OP_CONST, 0,
@@ -7094,6 +7101,18 @@ Perl_yylex(pTHX)
            }
        }
 
+       if (tmp && tmp != KEY___DATA__ && tmp != KEY___END__
+        && (!anydelim || *s != '#')) {
+           /* no override, and not s### either; skipspace is safe here
+            * check for => on following line */
+           STRLEN bufoff = PL_bufptr - SvPVX(PL_linestr);
+           STRLEN   soff = s         - SvPVX(PL_linestr);
+           s = skipspace_flags(s, LEX_NO_INCLINE);
+           if (*s == '=' && s[1] == '>') goto fat_arrow;
+           PL_bufptr = SvPVX(PL_linestr) + bufoff;
+           s         = SvPVX(PL_linestr) +   soff;
+       }
+
       reserved_word:
        switch (tmp) {