In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/467582e8e8af9e7a3cd4a20c4f30f72c3f2a9ce6?hp=79abde3aeeb4da102feaf1bf38ae2f05a1a2541d>
- Log ----------------------------------------------------------------- commit 467582e8e8af9e7a3cd4a20c4f30f72c3f2a9ce6 Author: Father Chrysostomos <[email protected]> Date: Tue Jul 16 23:06:53 2013 -0700 perldelta for => M pod/perldelta.pod commit 21791330af556dc082f3ef837d772ba9a4d0b197 Author: Father Chrysostomos <[email protected]> Date: Fri Jul 12 23:37:26 2013 -0700 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. M embed.fnc M embed.h M proto.h M t/base/lex.t M toke.c ----------------------------------------------------------------------- Summary of changes: embed.fnc | 2 +- embed.h | 2 +- pod/perldelta.pod | 6 ++++++ proto.h | 4 ++-- t/base/lex.t | 6 +++++- toke.c | 51 +++++++++++++++++++++++++++++++++++++-------------- 6 files changed, 52 insertions(+), 19 deletions(-) diff --git a/embed.fnc b/embed.fnc index a9e4215..18919f1 100644 --- 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 --- 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/pod/perldelta.pod b/pod/perldelta.pod index 085603b..b6334ab 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -630,6 +630,12 @@ C<pos>, C<tie>, C<tied> and C<untie> did not work properly on subroutine arguments aliased to nonexistent hash and array elements [perl #77814, #27010]. +=item * + +The C<< => >> fat arrow operator can now quote built-in keywords even if it +occurs on the next line, making it consistent with how it treats other +barewords. + =back =head1 Known Problems diff --git a/proto.h b/proto.h index 9a6f5dd..32607ff 100644 --- 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 --- 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 --- 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) { -- Perl5 Master Repository
