avoid side-effecting source held in scalar

Syntax plugins can modify the source being parsed.  It's fine for
them to modify the lexer buffer, but this must not be the same scalar
that was supplied to lex_start() and may be in use outside.  Therefore
always copy the scalar in lex_start() rather than just referencing it.
Fixes [perl #78358].

diff --git a/MANIFEST b/MANIFEST
index 36108d0..4efbbae 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -3413,6 +3413,7 @@ ext/XS-APItest/t/push.t           XS::APItest extension
 ext/XS-APItest/t/rmagical.t    XS::APItest extension
 ext/XS-APItest/t/rv2cv_op_cv.t test rv2cv_op_cv() API
 ext/XS-APItest/t/savehints.t   test SAVEHINTS() API
+ext/XS-APItest/t/stuff_modify_bug.t    test for eval side-effecting source string
 ext/XS-APItest/t/stuff_svcur_bug.t     test for a bug in lex_stuff_pvn
 ext/XS-APItest/t/svpeek.t      XS::APItest extension
 ext/XS-APItest/t/svsetsv.t     Test behaviour of sv_setsv with/without PERL_CORE

diff --git a/ext/XS-APItest/t/stuff_modify_bug.t b/ext/XS-APItest/t/stuff_modify_bug.t
new file mode 100644 (file)
index 0000000..10dec43
--- /dev/null
+++ b/ext/XS-APItest/t/stuff_modify_bug.t
@@ -0,0 +1,12 @@
+use warnings;
+use strict;
+
+use Test::More tests => 1;
+
+use XS::APItest qw(stufftest);
+
+my $a = "stufftest+;();";
+eval $a;
+is $a, "stufftest+;();";
+
+1;

diff --git a/toke.c b/toke.c
index fa1882d..99aae57 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -704,15 +704,10 @@ Perl_lex_start(pTHX_ SV *line, PerlIO *rsfp)
 
     if (!len) {
        parser->linestr = newSVpvs("\n;");
-    } else if (SvREADONLY(line) || s[len-1] != ';' || !SvPOK(line)) {
-       /* avoid tie/overload weirdness */
+    } else {
        parser->linestr = newSVpvn_flags(s, len, SvUTF8(line));
        if (s[len-1] != ';')
            sv_catpvs(parser->linestr, "\n;");
-    } else {
-       SvTEMP_off(line);
-       SvREFCNT_inc_simple_void_NN(line);
-       parser->linestr = line;
     }
     parser->oldoldbufptr =
        parser->oldbufptr =