function interface to parse Perl statement

yyparse() becomes reentrant.  The yacc stack and related resources
are allocated in yyparse(), rather than in lex_start(), and they are
localised to yyparse(), preserving their values from any outer parser.

yyparse() now takes a parameter which determines which production it
will parse at the top level.  New API function parse_fullstmt() uses this
facility to parse just a single statement.  The top-level single-statement
production that is used for this then messes with the parser's head so
that the parsing stops without seeing EOF, and any lookahead token seen
after the statement is pushed back to the lexer.

2 files changed, 184 insertions, 0 deletions

diff --git a/ext/XS-APItest-KeywordRPN/KeywordRPN.xs b/ext/XS-APItest-KeywordRPN/KeywordRPN.xs
index a5dfcd9adc..6c622564ff 100644
--- a/ext/XS-APItest-KeywordRPN/KeywordRPN.xs
+++ b/ext/XS-APItest-KeywordRPN/KeywordRPN.xs
@@ -9,6 +9,7 @@
 	 (SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK|SVp_IOK|SVp_NOK|SVp_POK)))
 
 static SV *hintkey_rpn_sv, *hintkey_calcrpn_sv, *hintkey_stufftest_sv;
+static SV *hintkey_swaptwostmts_sv;
 static int (*next_keyword_plugin)(pTHX_ char *, STRLEN, OP **);
 
 /* low-level parser helpers */
@@ -171,6 +172,18 @@ static OP *THX_parse_keyword_stufftest(pTHX)
 }
 #define parse_keyword_stufftest() THX_parse_keyword_stufftest(aTHX)
 
+static OP *THX_parse_keyword_swaptwostmts(pTHX)
+{
+	OP *a, *b;
+	a = parse_fullstmt(0);
+	b = parse_fullstmt(0);
+	if(a && b)
+		PL_hints |= HINT_BLOCK_SCOPE;
+	/* should use append_list(), but that's not part of the public API */
+	return !a ? b : !b ? a : newLISTOP(OP_LINESEQ, 0, b, a);
+}
+#define parse_keyword_swaptwostmts() THX_parse_keyword_swaptwostmts(aTHX)
+
 /* plugin glue */
 
 static int THX_keyword_active(pTHX_ SV *hintkey_sv)
@@ -225,6 +238,11 @@ static int my_keyword_plugin(pTHX_
 			keyword_active(hintkey_stufftest_sv)) {
 		*op_ptr = parse_keyword_stufftest();
 		return KEYWORD_PLUGIN_STMT;
+	} else if(keyword_len == 12 &&
+			strnEQ(keyword_ptr, "swaptwostmts", 12) &&
+			keyword_active(hintkey_swaptwostmts_sv)) {
+		*op_ptr = parse_keyword_swaptwostmts();
+		return KEYWORD_PLUGIN_STMT;
 	} else {
 		return next_keyword_plugin(aTHX_
 				keyword_ptr, keyword_len, op_ptr);
@@ -238,6 +256,8 @@ BOOT:
 	hintkey_calcrpn_sv = newSVpvs_share("XS::APItest::KeywordRPN/calcrpn");
 	hintkey_stufftest_sv =
 		newSVpvs_share("XS::APItest::KeywordRPN/stufftest");
+	hintkey_swaptwostmts_sv =
+		newSVpvs_share("XS::APItest::KeywordRPN/swaptwostmts");
 	next_keyword_plugin = PL_keyword_plugin;
 	PL_keyword_plugin = my_keyword_plugin;
 
@@ -255,6 +275,9 @@ PPCODE:
 		} else if(sv_is_string(item) &&
 				strEQ(SvPVX(item), "stufftest")) {
 			keyword_enable(hintkey_stufftest_sv);
+		} else if(sv_is_string(item) &&
+				strEQ(SvPVX(item), "swaptwostmts")) {
+			keyword_enable(hintkey_swaptwostmts_sv);
 		} else {
 			croak("\"%s\" is not exported by the %s module",
 				SvPV_nolen(item), SvPV_nolen(ST(0)));
@@ -275,6 +298,9 @@ PPCODE:
 		} else if(sv_is_string(item) &&
 				strEQ(SvPVX(item), "stufftest")) {
 			keyword_disable(hintkey_stufftest_sv);
+		} else if(sv_is_string(item) &&
+				strEQ(SvPVX(item), "swaptwostmts")) {
+			keyword_disable(hintkey_swaptwostmts_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/swaptwostmts.t b/ext/XS-APItest-KeywordRPN/t/swaptwostmts.t
new file mode 100644
index 0000000000..44e9e7aaae
--- /dev/null
+++ b/ext/XS-APItest-KeywordRPN/t/swaptwostmts.t
@@ -0,0 +1,158 @@
+use warnings;
+use strict;
+
+use Test::More tests => 22;
+
+BEGIN { $^H |= 0x20000; }
+
+my $t;
+
+$t = "";
+eval q{
+	use XS::APItest::KeywordRPN ();
+	$t .= "a";
+	swaptwostmts
+	$t .= "b";
+	$t .= "c";
+	$t .= "d";
+};
+isnt $@, "";
+
+$t = "";
+eval q{
+	use XS::APItest::KeywordRPN qw(swaptwostmts);
+	$t .= "a";
+	swaptwostmts
+	$t .= "b";
+	$t .= "c";
+	$t .= "d";
+};
+is $@, "";
+is $t, "acbd";
+
+$t = "";
+eval q{
+	use XS::APItest::KeywordRPN qw(swaptwostmts);
+	$t .= "a";
+	swaptwostmts
+	if(1) { $t .= "b"; }
+	$t .= "c";
+	$t .= "d";
+};
+is $@, "";
+is $t, "acbd";
+
+$t = "";
+eval q{
+	use XS::APItest::KeywordRPN qw(swaptwostmts);
+	$t .= "a";
+	swaptwostmts
+	$t .= "b";
+	if(1) { $t .= "c"; }
+	$t .= "d";
+};
+is $@, "";
+is $t, "acbd";
+
+$t = "";
+eval q{
+	use XS::APItest::KeywordRPN qw(swaptwostmts);
+	$t .= "a";
+	swaptwostmts
+	$t .= "b";
+	foreach(1..3) {
+		$t .= "c";
+		swaptwostmts
+		$t .= "d";
+		$t .= "e";
+		$t .= "f";
+	}
+	$t .= "g";
+};
+is $@, "";
+is $t, "acedfcedfcedfbg";
+
+$t = "";
+eval q{
+	use XS::APItest::KeywordRPN qw(swaptwostmts);
+	$t .= "a";
+	swaptwostmts
+	$t .= "b";
+	$t .= "c";
+};
+is $@, "";
+is $t, "acb";
+
+$t = "";
+eval q{
+	use XS::APItest::KeywordRPN qw(swaptwostmts);
+	$t .= "a";
+	swaptwostmts
+	$t .= "b";
+	$t .= "c"
+};
+is $@, "";
+is $t, "acb";
+
+$t = "";
+eval q{
+	use XS::APItest::KeywordRPN qw(swaptwostmts);
+	$t .= "a";
+	swaptwostmts
+	$t .= "b"
+};
+isnt $@, "";
+
+$t = "";
+eval q{
+	use XS::APItest::KeywordRPN qw(swaptwostmts);
+	$_ = $t;
+	$_ .= "a";
+	swaptwostmts
+	if(1) { $_ .= "b"; }
+	tr/a-z/A-Z/;
+	$_ .= "d";
+	$t = $_;
+};
+is $@, "";
+is $t, "Abd";
+
+$t = "";
+eval q{
+	use XS::APItest::KeywordRPN qw(swaptwostmts);
+	sub add_to_t { $t .= $_[0]; }
+	add_to_t "a";
+	swaptwostmts
+	if(1) { add_to_t "b"; }
+	add_to_t "c";
+	add_to_t "d";
+};
+is $@, "";
+is $t, "acbd";
+
+$t = "";
+eval q{
+	use XS::APItest::KeywordRPN qw(swaptwostmts);
+	{ $t .= "a"; }
+	swaptwostmts
+	if(1) { { $t .= "b"; } }
+	{ $t .= "c"; }
+	{ $t .= "d"; }
+};
+is $@, "";
+is $t, "acbd";
+
+$t = "";
+eval q{
+	use XS::APItest::KeywordRPN qw(swaptwostmts);
+	no warnings "void";
+	"@{[ $t .= 'a' ]}";
+	swaptwostmts
+	if(1) { "@{[ $t .= 'b' ]}"; }
+	"@{[ $t .= 'c' ]}";
+	"@{[ $t .= 'd' ]}";
+};
+is $@, "";
+is $t, "acbd";
+
+1;