This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
avoid side-effecting source held in scalar
authorZefram <zefram@fysh.org>
Wed, 13 Oct 2010 20:05:54 +0000 (21:05 +0100)
committerFather Chrysostomos <sprout@cpan.org>
Thu, 21 Oct 2010 12:52:52 +0000 (05:52 -0700)
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].

MANIFEST
ext/XS-APItest/t/stuff_modify_bug.t [new file with mode: 0644]
toke.c

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
@@ -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 =