[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 (file)
--- 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 (file)
--- 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 (file)
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 (file)
--- 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);
        }