In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/8abd6374ff4d4e3baa6f4befa3b08b59cfe6dce5?hp=d82e2a6d8f2cc6469125270842b1e69ea0d72831>
- Log ----------------------------------------------------------------- commit 8abd6374ff4d4e3baa6f4befa3b08b59cfe6dce5 Merge: d82e2a6 d6a4f4b Author: Nicholas Clark <n...@ccl4.org> Date: Tue Jun 11 15:04:40 2013 +0200 Merge the refactoring of toke.c's S_force_word. The C level changes are invisible to anything outside of toke.c. Nothing should notice this change. commit d6a4f4b5319be6b18d1a7e66172237c8b6137820 Author: Nicholas Clark <n...@ccl4.org> Date: Wed Feb 27 16:09:29 2013 +0100 Inline a subset of S_force_word() into the KEY_format section of Perl_yylex(). In code handling formats, Perl_yylex() calls S_force_word() at a point where it has already done half the work that S_force_word() does. The validation Perl_yylex() has already passed, along with the normalisation performed by S_scan_word() mean that all it actually needs from S_force_word() is the token forcing. Inlining these lines decouples the code. M toke.c commit 345b3785326c7725d2f52bfa4a802d2428eb8a17 Author: Brian Fraser <frase...@gmail.com> Date: Tue Feb 26 17:07:59 2013 -0300 toke.c: Remove the allow_initial_tick hack from S_force_word. Over the years, every caller which used this hack had it progressively turned off. Prior to this commit, only one call remained, which ostensibly handled this case: format 'STDOUT = ... However, turns out that even there it was superflous, since a scan_word a dozen lines before will've already turned all ticks into double colons. M embed.fnc M embed.h M proto.h M toke.c commit 7196fc2f2d32b6d967837833bdf1bccf50f7f714 Author: Brian Fraser <frase...@gmail.com> Date: Tue Feb 26 20:07:41 2013 -0300 Eliminate the last call to S_force_word() passing allow_initial_tick as TRUE. Turns out that that final place using the allow_tick hack could get a tick, because it was using the original buffer, rather than the already processed identifier from scan_word. M toke.c commit 1a01716a33e6e32e48b6631819e8f1c4bee8d0bd Author: Nicholas Clark <n...@ccl4.org> Date: Wed Feb 27 10:50:46 2013 +0100 Test that C<format ::Foo> is identical to C<format Foo> This wasn't being explicitly tested. M t/comp/parser.t commit a20e6aaed858bacbfb2592e4d1ac5c0d3983de0c Author: Brian Fraser <frase...@gmail.com> Date: Tue Feb 26 20:07:41 2013 -0300 Test that C<format 'Foo> is identical to C<format Foo> When declaring a format, using a leading package separator requires careful handling in the parser, to avoid confusion with a subroutine of the same name. M t/comp/parser.t ----------------------------------------------------------------------- Summary of changes: embed.fnc | 2 +- embed.h | 2 +- proto.h | 2 +- t/comp/parser.t | 24 +++++++++++++++++++++++- toke.c | 46 +++++++++++++++++++++++++++------------------- 5 files changed, 53 insertions(+), 23 deletions(-) diff --git a/embed.fnc b/embed.fnc index 3551161..6e6f2cd 100644 --- a/embed.fnc +++ b/embed.fnc @@ -2192,7 +2192,7 @@ s |void |force_next |I32 type s |char* |force_version |NN char *s|int guessing s |char* |force_strict_version |NN char *s s |char* |force_word |NN char *start|int token|int check_keyword \ - |int allow_pack|int allow_tick + |int allow_pack s |SV* |tokeq |NN SV *sv s |void |readpipe_override| sR |char* |scan_const |NN char *start diff --git a/embed.h b/embed.h index 9446875..f2003af 100644 --- a/embed.h +++ b/embed.h @@ -1597,7 +1597,7 @@ #define force_next(a) S_force_next(aTHX_ a) #define force_strict_version(a) S_force_strict_version(aTHX_ a) #define force_version(a,b) S_force_version(aTHX_ a,b) -#define force_word(a,b,c,d,e) S_force_word(aTHX_ a,b,c,d,e) +#define force_word(a,b,c,d) S_force_word(aTHX_ a,b,c,d) #define get_and_check_backslash_N_name(a,b) S_get_and_check_backslash_N_name(aTHX_ a,b) #define incline(a) S_incline(aTHX_ a) #define intuit_method(a,b,c) S_intuit_method(aTHX_ a,b,c) diff --git a/proto.h b/proto.h index cad9f2e..3cebd4e 100644 --- a/proto.h +++ b/proto.h @@ -7216,7 +7216,7 @@ STATIC char* S_force_version(pTHX_ char *s, int guessing) #define PERL_ARGS_ASSERT_FORCE_VERSION \ assert(s) -STATIC char* S_force_word(pTHX_ char *start, int token, int check_keyword, int allow_pack, int allow_tick) +STATIC char* S_force_word(pTHX_ char *start, int token, int check_keyword, int allow_pack) __attribute__nonnull__(pTHX_1); #define PERL_ARGS_ASSERT_FORCE_WORD \ assert(start) diff --git a/t/comp/parser.t b/t/comp/parser.t index 7c0db7f..fa11de9 100644 --- a/t/comp/parser.t +++ b/t/comp/parser.t @@ -3,7 +3,7 @@ # Checks if the parser behaves correctly in edge cases # (including weird syntax errors) -print "1..154\n"; +print "1..156\n"; sub failed { my ($got, $expected, $name) = @_; @@ -450,6 +450,28 @@ for my $pkg(()){} $pkg = 3; is $pkg, 3, '[perl #114942] for my $foo()){} $foo'; +# Check that format 'Foo still works after removing the hack from +# force_word +$test++; +format 'one = +ok @<< - format 'foo still works +$test +. +{ + local $~ = "one"; + write(); +} + +$test++; +format ::two = +ok @<< - format ::foo still works +$test +. +{ + local $~ = "two"; + write(); +} + # Add new tests HERE (above this line) # bug #74022: Loop on characters in \p{OtherIDContinue} diff --git a/toke.c b/toke.c index d3bc457..05131b7 100644 --- a/toke.c +++ b/toke.c @@ -2114,7 +2114,7 @@ S_newSV_maybe_utf8(pTHX_ const char *const start, STRLEN len) */ STATIC char * -S_force_word(pTHX_ char *start, int token, int check_keyword, int allow_pack, int allow_initial_tick) +S_force_word(pTHX_ char *start, int token, int check_keyword, int allow_pack) { dVAR; char *s; @@ -2125,8 +2125,7 @@ S_force_word(pTHX_ char *start, int token, int check_keyword, int allow_pack, in start = SKIPSPACE1(start); s = start; if (isIDFIRST_lazy_if(s,UTF) || - (allow_pack && *s == ':') || - (allow_initial_tick && *s == '\'') ) + (allow_pack && *s == ':') ) { s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, allow_pack, &len); if (check_keyword) { @@ -4557,12 +4556,12 @@ S_tokenize_use(pTHX_ int is_use, char *s) { force_next(WORD); } else if (*s == 'v') { - s = force_word(s,WORD,FALSE,TRUE,FALSE); + s = force_word(s,WORD,FALSE,TRUE); s = force_version(s, FALSE); } } else { - s = force_word(s,WORD,FALSE,TRUE,FALSE); + s = force_word(s,WORD,FALSE,TRUE); s = force_version(s, FALSE); } pl_yylval.ival = is_use; @@ -5554,7 +5553,7 @@ Perl_yylex(pTHX) s++; if (strnEQ(s,"=>",2)) { - s = force_word(PL_bufptr,WORD,FALSE,FALSE,FALSE); + s = force_word(PL_bufptr,WORD,FALSE,FALSE); DEBUG_T( { printbuf("### Saw unary minus before =>, forcing word %s\n", s); } ); OPERATOR('-'); /* unary minus */ } @@ -5626,7 +5625,7 @@ Perl_yylex(pTHX) s++; s = SKIPSPACE1(s); if (isIDFIRST_lazy_if(s,UTF)) { - s = force_word(s,METHOD,FALSE,TRUE,FALSE); + s = force_word(s,METHOD,FALSE,TRUE); TOKEN(ARROW); } else if (*s == '$') @@ -5989,7 +5988,7 @@ Perl_yylex(pTHX) d++; if (*d == '}') { const char minus = (PL_tokenbuf[0] == '-'); - s = force_word(s + minus, WORD, FALSE, TRUE, FALSE); + s = force_word(s + minus, WORD, FALSE, TRUE); if (minus) force_next('-'); } @@ -7749,7 +7748,7 @@ Perl_yylex(pTHX) case KEY_dump: PL_expect = XOPERATOR; - s = force_word(s,WORD,TRUE,FALSE,FALSE); + s = force_word(s,WORD,TRUE,FALSE); LOOPX(OP_DUMP); case KEY_else: @@ -7882,7 +7881,7 @@ Perl_yylex(pTHX) case KEY_goto: PL_expect = XOPERATOR; - s = force_word(s,WORD,TRUE,FALSE,FALSE); + s = force_word(s,WORD,TRUE,FALSE); LOOPX(OP_GOTO); case KEY_gmtime: @@ -8008,7 +8007,7 @@ Perl_yylex(pTHX) case KEY_last: PL_expect = XOPERATOR; - s = force_word(s,WORD,TRUE,FALSE,FALSE); + s = force_word(s,WORD,TRUE,FALSE); LOOPX(OP_LAST); case KEY_lc: @@ -8116,7 +8115,7 @@ Perl_yylex(pTHX) case KEY_next: PL_expect = XOPERATOR; - s = force_word(s,WORD,TRUE,FALSE,FALSE); + s = force_word(s,WORD,TRUE,FALSE); LOOPX(OP_NEXT); case KEY_ne: @@ -8200,7 +8199,7 @@ Perl_yylex(pTHX) LOP(OP_PACK,XTERM); case KEY_package: - s = force_word(s,WORD,FALSE,TRUE,FALSE); + s = force_word(s,WORD,FALSE,TRUE); s = SKIPSPACE1(s); s = force_strict_version(s); PL_lex_expect = XBLOCK; @@ -8303,7 +8302,7 @@ Perl_yylex(pTHX) || (s = force_version(s, TRUE), *s == 'v')) { *PL_tokenbuf = '\0'; - s = force_word(s,WORD,TRUE,TRUE,FALSE); + s = force_word(s,WORD,TRUE,TRUE); if (isIDFIRST_lazy_if(PL_tokenbuf,UTF)) gv_stashpvn(PL_tokenbuf, strlen(PL_tokenbuf), GV_ADD | (UTF ? SVf_UTF8 : 0)); @@ -8328,7 +8327,7 @@ Perl_yylex(pTHX) case KEY_redo: PL_expect = XOPERATOR; - s = force_word(s,WORD,TRUE,FALSE,FALSE); + s = force_word(s,WORD,TRUE,FALSE); LOOPX(OP_REDO); case KEY_rename: @@ -8469,7 +8468,7 @@ Perl_yylex(pTHX) checkcomma(s,PL_tokenbuf,"subroutine name"); s = SKIPSPACE1(s); PL_expect = XTERM; - s = force_word(s,WORD,TRUE,TRUE,FALSE); + s = force_word(s,WORD,TRUE,TRUE); LOP(OP_SORT,XREF); case KEY_split: @@ -8505,6 +8504,7 @@ Perl_yylex(pTHX) expectation attrful; bool have_name, have_proto; const int key = tmp; + SV *format_name = NULL; #ifdef PERL_MAD SV *tmpwhite = 0; @@ -8539,6 +8539,8 @@ Perl_yylex(pTHX) if (PL_madskills) nametoke = newSVpvn_flags(s, d - s, SvUTF8(PL_linestr)); #endif + if (key == KEY_format) + format_name = S_newSV_maybe_utf8(aTHX_ s, d - s); *PL_tokenbuf = '&'; if (memchr(tmpbuf, ':', len) || key != KEY_sub || pad_findmy_pvn( @@ -8586,9 +8588,15 @@ Perl_yylex(pTHX) s = d; PERL_UNUSED_VAR(tboffset); #else - if (have_name) - (void) force_word(PL_oldbufptr + tboffset, WORD, - FALSE, TRUE, TRUE); + if (format_name) { + start_force(PL_curforce); + if (PL_madskills) + curmad('X', newSVpvn(start,s-start)); + NEXTVAL_NEXTTOKE.opval + = (OP*)newSVOP(OP_CONST,0, format_name); + NEXTVAL_NEXTTOKE.opval->op_private |= OPpCONST_BARE; + force_next(WORD); + } #endif PREBLOCK(FORMAT); } -- Perl5 Master Repository