In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/59a08c763def19a317f229e4a95b1cdf6db8e12d?hp=fc0fe26a7d286480c1bb25f57e469ece575bb68d>
- Log ----------------------------------------------------------------- commit 59a08c763def19a317f229e4a95b1cdf6db8e12d Author: David Mitchell <[email protected]> Date: Fri Jul 8 09:48:04 2016 +0100 RT #128255: Assert fail in S_sublex_done Some code that handles deprecated behaviour in formats was triggering an assertion. This: format STDOUT = @ 0"$x" gave this warning: Use of comma-less variable list is deprecated but then gave this panic: toke.c:2457: S_sublex_done: Assertion `(PL_parser->lex_inwhat) == OP_SUBST || (PL_parser->lex_inwhat) == OP_TRANS' failed. This is due to the lexer calling scan_str(), then backing off and doing the warning and returning a comma, then on the next token get, calling scan_str() again. Because scan_str() has been called twice, the second time it extracts the string to PL_sublex_info.repl rather than PL_lex_stuff, as it does with things like s/foo/bar/ and tr/abc/ABC/. Later an assert that PL_sublex_info.repl is only set for a s/// or tr/// fails. The solution seems to be to check and return a comma *before* trying to call scan_str(). ----------------------------------------------------------------------- Summary of changes: t/op/write.t | 15 ++++++++++++++- toke.c | 18 +++++++++--------- 2 files changed, 23 insertions(+), 10 deletions(-) diff --git a/t/op/write.t b/t/op/write.t index 590d658..93f70fa 100644 --- a/t/op/write.t +++ b/t/op/write.t @@ -98,7 +98,7 @@ for my $tref ( @NumTests ){ my $bas_tests = 21; # number of tests in section 3 -my $bug_tests = 66 + 3 * 3 * 5 * 2 * 3 + 2 + 66 + 4 + 2 + 3 + 96 + 11 + 3; +my $bug_tests = 66 + 3 * 3 * 5 * 2 * 3 + 2 + 66 + 4 + 2 + 3 + 96 + 11 + 4; # number of tests in section 4 my $hmb_tests = 37; @@ -1972,6 +1972,19 @@ a x EXPECT { stderr => 1 }, '#123538 crash in FF_MORE'); +# this used to assert fail +fresh_perl_like(<<'EOP', +format STDOUT = +@ +0"$x" +. +print "got here\n"; +EOP + qr/Use of comma-less variable list is deprecated.*got here/s, + { stderr => 1 }, + '#128255 Assert fail in S_sublex_done'); + + ############################# ## Section 4 ## Add new tests *above* here diff --git a/toke.c b/toke.c index 7e77fae..c359813 100644 --- a/toke.c +++ b/toke.c @@ -6505,22 +6505,26 @@ Perl_yylex(pTHX) TERM(THING); case '\'': + if ( PL_expect == XOPERATOR + && (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack)) + return deprecate_commaless_var_list(); + s = scan_str(s,FALSE,FALSE,FALSE,NULL); if (!s) missingterm(NULL); COPLINE_SET_FROM_MULTI_END; DEBUG_T( { printbuf("### Saw string before %s\n", s); } ); if (PL_expect == XOPERATOR) { - if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack) { - return deprecate_commaless_var_list(); - } - else - no_op("String",s); + no_op("String",s); } pl_yylval.ival = OP_CONST; TERM(sublex_start()); case '"': + if ( PL_expect == XOPERATOR + && (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack)) + return deprecate_commaless_var_list(); + s = scan_str(s,FALSE,FALSE,FALSE,NULL); DEBUG_T( { if (s) @@ -6530,10 +6534,6 @@ Perl_yylex(pTHX) "### Saw unterminated string\n"); } ); if (PL_expect == XOPERATOR) { - if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack) { - return deprecate_commaless_var_list(); - } - else no_op("String",s); } if (!s) -- Perl5 Master Repository
