From 5969c5766a5d3f6b42a5140548d7c3d6812fec8b Mon Sep 17 00:00:00 2001 From: Father Chrysostomos Date: Fri, 12 Jul 2013 22:34:48 -0700 Subject: [PATCH] Allow => to quote built-in keywords across lines MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit 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., .) --- embed.fnc | 2 +- embed.h | 2 +- proto.h | 4 ++-- t/base/lex.t | 6 +++++- toke.c | 43 +++++++++++++++++++++++++++++++------------ 5 files changed, 40 insertions(+), 17 deletions(-) diff --git a/embed.fnc b/embed.fnc index df387d1..9873ba5 100644 --- 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 --- 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 --- 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 --- 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 ...\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 --- 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) { -- 2.7.4