From: Zefram <zefram@fysh.org>
Date: Wed, 14 Apr 2010 07:29:15 +0000 (+0200)
Subject: [perl #74006] 5.12.0-RC stuffing bug
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=255fdf19250671082618dae106a246f12379dbe6;p=p5sagit%2Fp5-mst-13.2.git

[perl #74006] 5.12.0-RC stuffing bug

There's a small bug in lex_stuff_pvn() that causes spurious syntax errors
in an obscure situation.  It happens if stuffing is performed on the
last line of a file, and the line ends with a statement that lacks its
terminating semicolon.  Attached patch fixes and adds test.
---

diff --git a/MANIFEST b/MANIFEST
index 6363cc8..da0c1f3 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -3218,6 +3218,7 @@ ext/XS-APItest-KeywordRPN/Makefile.PL	XS::APItest::KeywordRPN extension
 ext/XS-APItest-KeywordRPN/README	XS::APItest::KeywordRPN extension
 ext/XS-APItest-KeywordRPN/t/keyword_plugin.t	test keyword plugin mechanism
 ext/XS-APItest-KeywordRPN/t/multiline.t	test plugin parsing across lines
+ext/XS-APItest-KeywordRPN/t/stuff_svcur_bug.t	test for a bug in lex_stuff_pvn
 ext/XS-APItest/Makefile.PL	XS::APItest extension
 ext/XS-APItest/MANIFEST		XS::APItest extension
 ext/XS-APItest/notcore.c	Test API functions when PERL_CORE is not defined
diff --git a/ext/XS-APItest-KeywordRPN/KeywordRPN.xs b/ext/XS-APItest-KeywordRPN/KeywordRPN.xs
index e205eea..adb7e6b 100644
--- a/ext/XS-APItest-KeywordRPN/KeywordRPN.xs
+++ b/ext/XS-APItest-KeywordRPN/KeywordRPN.xs
@@ -8,7 +8,7 @@
 	(!sv_is_glob(sv) && !sv_is_regexp(sv) && \
 	 (SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK|SVp_IOK|SVp_NOK|SVp_POK)))
 
-static SV *hintkey_rpn_sv, *hintkey_calcrpn_sv;
+static SV *hintkey_rpn_sv, *hintkey_calcrpn_sv, *hintkey_stufftest_sv;
 static int (*next_keyword_plugin)(pTHX_ char *, STRLEN, OP **);
 
 /* low-level parser helpers */
@@ -150,6 +150,27 @@ static OP *THX_parse_keyword_calcrpn(pTHX)
 }
 #define parse_keyword_calcrpn() THX_parse_keyword_calcrpn(aTHX)
 
+static OP *THX_parse_keyword_stufftest(pTHX)
+{
+	I32 c;
+	bool do_stuff;
+	lex_read_space(0);
+	do_stuff = lex_peek_unichar(0) == '+';
+	if(do_stuff) {
+		lex_read_unichar(0);
+		lex_read_space(0);
+	}
+	c = lex_peek_unichar(0);
+	if(c == ';') {
+		lex_read_unichar(0);
+	} else if(c != /*{*/'}') {
+		croak("syntax error");
+	}
+	if(do_stuff) lex_stuff_pvn(" ", 1, 0);
+	return newOP(OP_NULL, 0);
+}
+#define parse_keyword_stufftest() THX_parse_keyword_stufftest(aTHX)
+
 /* plugin glue */
 
 static int THX_keyword_active(pTHX_ SV *hintkey_sv)
@@ -200,6 +221,10 @@ static int my_keyword_plugin(pTHX_
 			keyword_active(hintkey_calcrpn_sv)) {
 		*op_ptr = parse_keyword_calcrpn();
 		return KEYWORD_PLUGIN_STMT;
+	} else if(keyword_len == 9 && strnEQ(keyword_ptr, "stufftest", 9) &&
+			keyword_active(hintkey_stufftest_sv)) {
+		*op_ptr = parse_keyword_stufftest();
+		return KEYWORD_PLUGIN_STMT;
 	} else {
 		return next_keyword_plugin(aTHX_
 				keyword_ptr, keyword_len, op_ptr);
@@ -211,6 +236,8 @@ MODULE = XS::APItest::KeywordRPN PACKAGE = XS::APItest::KeywordRPN
 BOOT:
 	hintkey_rpn_sv = newSVpvs_share("XS::APItest::KeywordRPN/rpn");
 	hintkey_calcrpn_sv = newSVpvs_share("XS::APItest::KeywordRPN/calcrpn");
+	hintkey_stufftest_sv =
+		newSVpvs_share("XS::APItest::KeywordRPN/stufftest");
 	next_keyword_plugin = PL_keyword_plugin;
 	PL_keyword_plugin = my_keyword_plugin;
 
@@ -225,6 +252,9 @@ PPCODE:
 			keyword_enable(hintkey_rpn_sv);
 		} else if(sv_is_string(item) && strEQ(SvPVX(item), "calcrpn")) {
 			keyword_enable(hintkey_calcrpn_sv);
+		} else if(sv_is_string(item) &&
+				strEQ(SvPVX(item), "stufftest")) {
+			keyword_enable(hintkey_stufftest_sv);
 		} else {
 			croak("\"%s\" is not exported by the %s module",
 				SvPV_nolen(item), SvPV_nolen(ST(0)));
@@ -242,6 +272,9 @@ PPCODE:
 			keyword_disable(hintkey_rpn_sv);
 		} else if(sv_is_string(item) && strEQ(SvPVX(item), "calcrpn")) {
 			keyword_disable(hintkey_calcrpn_sv);
+		} else if(sv_is_string(item) &&
+				strEQ(SvPVX(item), "stufftest")) {
+			keyword_disable(hintkey_stufftest_sv);
 		} else {
 			croak("\"%s\" is not exported by the %s module",
 				SvPV_nolen(item), SvPV_nolen(ST(0)));
diff --git a/ext/XS-APItest-KeywordRPN/t/stuff_svcur_bug.t b/ext/XS-APItest-KeywordRPN/t/stuff_svcur_bug.t
new file mode 100644
index 0000000..4fd6e11
--- /dev/null
+++ b/ext/XS-APItest-KeywordRPN/t/stuff_svcur_bug.t
@@ -0,0 +1,12 @@
+use warnings;
+use strict;
+
+use Test::More tests => 1;
+ok 1;
+
+use XS::APItest::KeywordRPN qw(stufftest);
+
+# In the buggy case, a syntax error occurs at EOF.
+# Adding a semicolon, any following statements, or anything else
+# causes the bug not to show itself.
+stufftest+;()
diff --git a/toke.c b/toke.c
index 19fce67..b6735cf 100644
--- a/toke.c
+++ b/toke.c
@@ -956,6 +956,8 @@ Perl_lex_stuff_pvn(pTHX_ char *pv, STRLEN len, U32 flags)
 	    lex_grow_linestr(SvCUR(PL_parser->linestr)+1+len+highhalf);
 	    bufptr = PL_parser->bufptr;
 	    Move(bufptr, bufptr+len+highhalf, PL_parser->bufend+1-bufptr, char);
+	    SvCUR_set(PL_parser->linestr,
+	    	SvCUR(PL_parser->linestr) + len+highhalf);
 	    PL_parser->bufend += len+highhalf;
 	    for (p = pv; p != e; p++) {
 		U8 c = (U8)*p;
@@ -994,6 +996,8 @@ Perl_lex_stuff_pvn(pTHX_ char *pv, STRLEN len, U32 flags)
 	    lex_grow_linestr(SvCUR(PL_parser->linestr)+1+len-highhalf);
 	    bufptr = PL_parser->bufptr;
 	    Move(bufptr, bufptr+len-highhalf, PL_parser->bufend+1-bufptr, char);
+	    SvCUR_set(PL_parser->linestr,
+	    	SvCUR(PL_parser->linestr) + len-highhalf);
 	    PL_parser->bufend += len-highhalf;
 	    for (p = pv; p != e; p++) {
 		U8 c = (U8)*p;
@@ -1009,6 +1013,7 @@ Perl_lex_stuff_pvn(pTHX_ char *pv, STRLEN len, U32 flags)
 	    lex_grow_linestr(SvCUR(PL_parser->linestr)+1+len);
 	    bufptr = PL_parser->bufptr;
 	    Move(bufptr, bufptr+len, PL_parser->bufend+1-bufptr, char);
+	    SvCUR_set(PL_parser->linestr, SvCUR(PL_parser->linestr) + len);
 	    PL_parser->bufend += len;
 	    Copy(pv, bufptr, len, char);
 	}