(perl #133850) fix parsing hints for print $fh "foo" in s///e

The replacement code in s///e is parsed using a sublex, similarly
to double-quotish replacement.

The code that handles C< $id > tries to detect what the next token
should be, but only special cased code similar to C< print $fh ... >
in a non-sublex, so s/../print $fh $1/e set PL_expect to XOPERATOR
which caused the parser to complain when the $1 wasn't an operator.

The fix here handles two cases:

 s/.../code here/e

In this case the code is inserted into a do {} block like:

  do { code here }

so PL_lex_brackets ends up non-zero.

The second case is code like:

  "xxx${code here}"

which had the same problem, which this also fixes.

diff --git a/t/lib/warnings/toke b/t/lib/warnings/toke
index 83641e5..944e5d9 100644 (file)
--- a/t/lib/warnings/toke
+++ b/t/lib/warnings/toke
@@ -1691,3 +1691,17 @@ EXPECT
 OPTION regex
 Malformed UTF-8 character: .*non-continuation.*
 The eval did not crash the program
+########
+# NAME [perl #133850] print $fh $1 in s///e expression
+use warnings;
+my $fh = \*STDOUT;
+$_ = "abc";
+s/(x)/ print $fh $1 /e;
+EXPECT
+########
+# NAME [perl #133850] side case
+use warnings;
+my $fh = \*STDOUT;
+my $y = "";
+my $x = "${print $fh $y; \'x'}";
+EXPECT

diff --git a/toke.c b/toke.c
index cecfa82..f3b643c 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -6838,7 +6838,7 @@ Perl_yylex(pTHX)
            }
 
            PL_expect = XOPERATOR;
-           if (PL_lex_state == LEX_NORMAL && isSPACE((char)tmp)) {
+           if ((PL_lex_state == LEX_NORMAL || PL_lex_brackets) && isSPACE((char)tmp)) {
                const bool islop = (PL_last_lop == PL_oldoldbufptr);
                if (!islop || PL_last_lop_op == OP_GREPSTART)
                    PL_expect = XOPERATOR;