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().

1 files changed, 9 insertions, 9 deletions

diff --git a/toke.c b/toke.c
index 7e77faedc2..c359813509 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)