In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/5969c5766a5d3f6b42a5140548d7c3d6812fec8b?hp=13d0d101a48a328c651a6ca3c89e392bc65f9e1f>
- Log ----------------------------------------------------------------- commit 5969c5766a5d3f6b42a5140548d7c3d6812fec8b Author: Father Chrysostomos <[email protected]> Date: Fri Jul 12 22:34:48 2013 -0700 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>.) M embed.fnc M embed.h M proto.h M t/base/lex.t M toke.c commit 8b12970a83017badfde9752dbd1480e612591839 Author: Father Chrysostomos <[email protected]> Date: Thu Jul 11 22:46:22 2013 -0700 t/base/lex.t: Test pyoq with comment before delim perlop says: There can be whitespace between the operator and the quoting characters, except when C<#> is being used as the quoting character. C<q#foo#> is parsed as the string C<foo>, while C<q #foo#> is the operator C<q> followed by a comment. Its argument will be taken from the next line. But I do not find tests for this anywhere. Here are some. M t/base/lex.t ----------------------------------------------------------------------- Summary of changes: embed.fnc | 2 +- embed.h | 2 +- proto.h | 4 ++-- t/base/lex.t | 49 ++++++++++++++++++++++++++++++++++++++++++++++++- toke.c | 43 +++++++++++++++++++++++++++++++------------ 5 files changed, 83 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 b1c4a09..7821e76 100644 --- a/t/base/lex.t +++ b/t/base/lex.t @@ -1,6 +1,6 @@ #!./perl -print "1..85\n"; +print "1..94\n"; $x = 'x'; @@ -400,3 +400,50 @@ print "ok 84 - call a function in package v10::foo\n"; print "not " unless (1?v65:"bar") eq 'A'; print "ok 85 - colon detection after vstring does not break ? vstring :\n"; + +# Test pyoq ops with comments before the first delim +q # comment + "b"# + eq 'b' or print "not "; +print "ok 86 - q <comment> <newline> ...\n"; +qq # comment + "b"# + eq 'b' or print "not "; +print "ok 87 - qq <comment> <newline> ...\n"; +qw # comment + "b"# + [0] eq 'b' or print "not "; +print "ok 88 - qw <comment> <newline> ...\n"; +"b" =~ m # comment + "b"# + or print "not "; +print "ok 89 - m <comment> <newline> ...\n"; +qr # comment + "b"# + eq qr/b/ or print "not "; +print "ok 90 - qr <comment> <newline> ...\n"; +$_ = "a"; +s # comment + [a] # + [b] # + ; +print "not " unless $_ eq 'b'; +print "ok 91 - s <comment> <newline> ...\n"; +$_ = "a"; +tr # comment + [a] # + [b] # + ; +print "not " unless $_ eq 'b'; +print "ok 92 - tr <comment> <newline> ...\n"; +$_ = "a"; +y # comment + [a] # + [b] # + ; +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 --- 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) { -- Perl5 Master Repository
