In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/3c47da3c2ebf51f08bb927dfa456939cc6c8c30f?hp=21732d5c67323d747a91102253591325b3569ec3>
- Log ----------------------------------------------------------------- commit 3c47da3c2ebf51f08bb927dfa456939cc6c8c30f Author: Father Chrysostomos <[email protected]> Date: Sat Feb 7 10:04:40 2015 -0800 [perl #123753] &\0foo parsing Normally the lexer skips over stray nulls, treating them as white- space. After a sigil, though, it was getting confused. While $\0foo would work and was equivalent to $foo (but did not work for lexicals), $\0eq was a syntax error. Some cases of &\0foo would cause assertion failures or outright buggy behaviour, such as strictures randomly turning on and off. There were two problems occurring: 1) Nulls were not being treated as whitespace right after a sigil, unlike elsewhere. 2) '&' not followed immediately by an identifier was not getting pl_yylval set, so the previous value, which might be an op address, was being passed as a flags parameter to an op constructor. (The other sigil tokens never use their values.) This commit addresses the first of those. I still need to investigate whether the second can still cause problems. M t/op/lex.t M toke.c commit da851177806c43a2985cad82a3c80046879f482b Author: Father Chrysostomos <[email protected]> Date: Sat Feb 7 07:32:19 2015 -0800 t/op/lex.t: Add comment about the fileâs purpose M t/op/lex.t ----------------------------------------------------------------------- Summary of changes: t/op/lex.t | 50 +++++++++++++++++++++++++++++++++++++++++++++++++- toke.c | 6 ++++-- 2 files changed, 53 insertions(+), 3 deletions(-) diff --git a/t/op/lex.t b/t/op/lex.t index 25ae754..07cdcca 100644 --- a/t/op/lex.t +++ b/t/op/lex.t @@ -1,10 +1,13 @@ #!perl + +# Tests too complex for t/base/lex.t + use strict; use warnings; BEGIN { chdir 't' if -d 't'; require './test.pl'; } -plan(tests => 10); +plan(tests => 16); { no warnings 'deprecated'; @@ -93,3 +96,48 @@ $_ = "rhubarb"; is ${no strict; \$_}, "rhubarb", '${no strict; ...}'; is join("", map{no strict; "rhu$_" } "barb"), 'rhubarb', 'map{no strict;...}'; + +# [perl #123753] +fresh_perl_is( + '$eq = "ok\n"; print $' . "\0eq\n", + "ok\n", + { stderr => 1 }, + '$ <null> ident' +); +fresh_perl_is( + '@eq = "ok\n"; print @' . "\0eq\n", + "ok\n", + { stderr => 1 }, + '@ <null> ident' +); +fresh_perl_is( + '%eq = ("o"=>"k\n"); print %' . "\0eq\n", + "ok\n", + { stderr => 1 }, + '% <null> ident' +); +fresh_perl_is( + 'sub eq { "ok\n" } print &' . "\0eq\n", + "ok\n", + { stderr => 1 }, + '& <null> ident' +); +fresh_perl_is( + '$eq = "ok\n"; print ${*' . "\0eq{SCALAR}}\n", + "ok\n", + { stderr => 1 }, + '* <null> ident' +); +SKIP: { + skip "Different output on EBCDIC (presumably)", 1 if ord("A") != 65; + fresh_perl_is( + qq'"ab}"ax;&\0z\x8Ao}\x82x;', <<gibberish, +Bareword found where operator expected at - line 1, near ""ab}"ax" + (Missing operator before ax?) +syntax error at - line 1, near ""ab}"ax" +Unrecognized character \\x8A; marked by <-- HERE after ab}"ax;&\0z<-- HERE near column 12 at - line 1. +gibberish + { stderr => 1 }, + 'gibberish containing &\0z - used to crash [perl #123753]' + ); +} diff --git a/toke.c b/toke.c index cb411d4..0929b68 100644 --- a/toke.c +++ b/toke.c @@ -1520,6 +1520,8 @@ Perl_lex_read_space(pTHX_ U32 flags) incline(s); need_incline = 0; } + } else if (!c) { + s++; } else { break; } @@ -1796,7 +1798,7 @@ S_skipspace_flags(pTHX_ char *s, U32 flags) { PERL_ARGS_ASSERT_SKIPSPACE_FLAGS; if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) { - while (s < PL_bufend && SPACE_OR_TAB(*s)) + while (s < PL_bufend && (SPACE_OR_TAB(*s) || !*s)) s++; } else { STRLEN bufptr_pos = PL_bufptr - SvPVX(PL_linestr); @@ -8593,7 +8595,7 @@ S_scan_ident(pTHX_ char *s, char *dest, STRLEN destlen, I32 ck_uni) PERL_ARGS_ASSERT_SCAN_IDENT; - if (isSPACE(*s)) + if (isSPACE(*s) || !*s) s = skipspace(s); if (isDIGIT(*s)) { while (isDIGIT(*s)) { -- Perl5 Master Repository
