Fix substitution in substitution pattern

Guess what this prints:

s/${s|||, \""}Just another Perl hacker,
/anything/;
print

And look at this:

$ perl5.6.2 -e 's/${s|||;\""}/foo\n/; print;'
$ perl5.16.0 -e 's/${s|||;\""}/foo\n/; print;'
$ perl5.17.2 -e 's/${s|||;\""}/foo\n/; print;'
Bus error
$ ./miniperl -e 's/${s|||;\""}/foo\n/; print;'
Bus error

The first two gave no output, though they should have shown "foo".
And bleadperl now crashes.

When the lexer parses a quote-like operator, it begins by extracting
what is between the quotes.  It puts it in an SV stored in the varia-
ble PL_lex_stuff.  Then, if it is y/// or s///, it scans the replace-
ment part and puts it in an SV in PL_lex_repl.  When it finishes with
it, it sets PL_lex_repl to NULL.

Now, if you put s/// in the pattern part of s/// (or y in s), the
inner s/// will clobber PL_lex_repl with its own replacement string.
So, when the outer s/// finish parsing its pattern and wants its
replacement string.  If it is not there, it assumes it has already
parsed it (whether PL_lex_repl is set is how it remembers which half
of s/// it is parsing), and proceeds to feed bad code to the parser,
resulting in a bad op tree.

PL_lex_repl needs to be localised when a quote-like operator is
parsed.  Since localisation for quote-like operators happens in a sep-
arate yylex call (yylex calls sublex_push, which does it) after the
string delimiters are found, at which point PL_lex_repl has already
been set (clobbering the previous value), we change the delim-
iter-scanning code (scan_{str,trans,subst}) to use the new
PL_sublex_info.repl, which sublex_push now copies into PL_lex_repl
after localising the latter.

diff --git a/perl.h b/perl.h
index d8b4179..14f9083 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -3451,6 +3451,7 @@ struct _sublex_info {
     OP *sub_op;                /* "lex_op" to use */
     char *super_bufptr;        /* PL_parser->bufptr that was */
     char *re_eval_start;/* start of "(?{..." text */
+    SV *repl;          /* replacement of s/// or y/// */
 };
 
 #include "parser.h"

diff --git a/t/base/lex.t b/t/base/lex.t
index d879728..aaa2aeb 100644 (file)
--- a/t/base/lex.t
+++ b/t/base/lex.t
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..62\n";
+print "1..63\n";
 
 $x = 'x';
 
@@ -309,3 +309,7 @@ ok 62 - heredoc in "" in multiline s///e outside eval
 END
 |e;
 print $_ || "not ok 62\n";
+
+$_ = "not ok 63 - s/// in s/// pattern\n";
+s/${s|||;\""}not //;
+print;

diff --git a/toke.c b/toke.c
index 4392e95..4f58a26 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -2459,6 +2459,7 @@ S_sublex_push(pTHX)
     SAVEI32(PL_lex_casemods);
     SAVEI32(PL_lex_starts);
     SAVEI8(PL_lex_state);
+    SAVESPTR(PL_lex_repl);
     SAVEPPTR(PL_sublex_info.re_eval_start);
     SAVEPPTR(PL_sublex_info.super_bufptr);
     SAVEVPTR(PL_lex_inpat);
@@ -2496,7 +2497,9 @@ S_sublex_push(pTHX)
     SvNVX(PL_lex_stuff) = PTR2NV(PL_linestr);
 
     PL_linestr = PL_lex_stuff;
+    PL_lex_repl = PL_sublex_info.repl;
     PL_lex_stuff = NULL;
+    PL_sublex_info.repl = NULL;
     PL_sublex_info.re_eval_start = NULL;
 
     PL_bufend = PL_bufptr = PL_oldbufptr = PL_oldoldbufptr = PL_linestart
@@ -9350,13 +9353,13 @@ S_scan_subst(pTHX_ char *start)
                sv_catpvs(repl, "do ");
        }
        sv_catpvs(repl, "{");
-       sv_catsv(repl, PL_lex_repl);
-       if (strchr(SvPVX(PL_lex_repl), '#'))
+       sv_catsv(repl, PL_sublex_info.repl);
+       if (strchr(SvPVX(PL_sublex_info.repl), '#'))
            sv_catpvs(repl, "\n");
        sv_catpvs(repl, "}");
        SvEVALED_on(repl);
-       SvREFCNT_dec(PL_lex_repl);
-       PL_lex_repl = repl;
+       SvREFCNT_dec(PL_sublex_info.repl);
+       PL_sublex_info.repl = repl;
     }
 
     PL_lex_op = (OP*)pm;
@@ -9441,7 +9444,7 @@ S_scan_trans(pTHX_ char *start)
     o->op_private &= ~OPpTRANS_ALL;
     o->op_private |= del|squash|complement|
       (DO_UTF8(PL_lex_stuff)? OPpTRANS_FROM_UTF : 0)|
-      (DO_UTF8(PL_lex_repl) ? OPpTRANS_TO_UTF   : 0);
+      (DO_UTF8(PL_sublex_info.repl) ? OPpTRANS_TO_UTF   : 0);
 
     PL_lex_op = o;
     pl_yylval.ival = nondestruct ? OP_TRANSR : OP_TRANS;
@@ -10309,7 +10312,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims, int re_reparse)
     */
 
     if (PL_lex_stuff)
-       PL_lex_repl = sv;
+       PL_sublex_info.repl = sv;
     else
        PL_lex_stuff = sv;
     return s;