Allow => to quote built-in keywords across lines

This is the second try.  5969c5766a5d3 had a bug in it under non-
MAD builds.

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>.)

Allowing whitespace to be scanned across line boundaries without
increasing the line number (something this commit has to do to make
this work) can cause the way PL_linestr is handled to change.

PL_linestr usually holds just the current line when reading from a
handle.  Now it can hold the current line plus the next line or seve-
ral lines, depending on how much whitespace is to be found there.

When '\n' or '#' was encountered, the lexer would modify the buffer in
place and add a null, setting PL_bufend to point to that null.  That
would make it look as though the end of the line had been reached, and
avoided having to scan to find the end of a comment.

In string eval and quote-like operators, the end of the comment does
have to be scanned for.  We can’t just fake EOL and read the next
line of input.

Under MAD builds, the end of the comment was being scanned for any-
way, even when reading from a handle.  So everything worked under MAD,
which was what I tested 5969c5766a5d3 under.

This commit changes the '\n' and '#' handling to match the MAD code
(scan for the end of the comment instead of faking a buffer trunca-
tion), which 5969c5766a5d3 failed to do.

diff --git a/embed.fnc b/embed.fnc
index a9e4215..18919f1 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -2220,7 +2220,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 8e9b059..795dd8c 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -1622,7 +1622,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 9a6f5dd..32607ff 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -7345,10 +7345,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 00c8964..1615cb6 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;
            }
@@ -1834,6 +1838,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 */
 
@@ -1939,12 +1945,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);
@@ -1957,7 +1963,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;
@@ -5636,8 +5642,12 @@ Perl_yylex(pTHX)
                PL_bufend = s; */
            }
 #else
-           *s = '\0';
-           PL_bufend = s;
+           while (s < PL_bufend && *s != '\n')
+               s++;
+           if (s < PL_bufend)
+               s++;
+           else if (s > PL_bufend) /* Found by Ilya: feed random input to Perl. */
+             Perl_croak(aTHX_ "panic: input overflow");
 #endif
        }
        goto retry;
@@ -6965,6 +6975,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,
@@ -7098,6 +7109,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) {