fix and test PL_expect in recdescent parsing

Set PL_expect at the start of parse_fullstmt() as well as at the start
of parse_stmtseq().  Test both.

4 files changed, 152 insertions, 1 deletions

diff --git a/ext/XS-APItest/APItest.pm b/ext/XS-APItest/APItest.pm
index d4365cf827..21807a7ced 100644
--- a/ext/XS-APItest/APItest.pm
+++ b/ext/XS-APItest/APItest.pm
@@ -36,7 +36,7 @@ sub import {
 	}
     }
     foreach (keys %{$exports||{}}) {
-	next unless /\A(?:rpn|calcrpn|stufftest|swaptwostmts|looprest|scopelessblock)\z/;
+	next unless /\A(?:rpn|calcrpn|stufftest|swaptwostmts|looprest|scopelessblock|stmtasexpr|stmtsasexpr)\z/;
 	$^H{"XS::APItest/$_"} = 1;
 	delete $exports->{$_};
     }
diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index f93f20a539..4aad258b95 100644
--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@@ -519,6 +519,7 @@ test_op_linklist_describe(OP *start)
 static SV *hintkey_rpn_sv, *hintkey_calcrpn_sv, *hintkey_stufftest_sv;
 static SV *hintkey_swaptwostmts_sv, *hintkey_looprest_sv;
 static SV *hintkey_scopelessblock_sv;
+static SV *hintkey_stmtasexpr_sv,  *hintkey_stmtsasexpr_sv;
 static int (*next_keyword_plugin)(pTHX_ char *, STRLEN, OP **);
 
 /* low-level parser helpers */
@@ -715,6 +716,33 @@ static OP *THX_parse_keyword_scopelessblock(pTHX)
     return body;
 }
 
+#define parse_keyword_stmtasexpr() THX_parse_keyword_stmtasexpr(aTHX)
+static OP *THX_parse_keyword_stmtasexpr(pTHX)
+{
+    OP *o = parse_fullstmt(0);
+    o = op_prepend_elem(OP_LINESEQ, newOP(OP_ENTER, 0), o);
+    o->op_type = OP_LEAVE;
+    o->op_ppaddr = PL_ppaddr[OP_LEAVE];
+    return o;
+}
+
+#define parse_keyword_stmtsasexpr() THX_parse_keyword_stmtsasexpr(aTHX)
+static OP *THX_parse_keyword_stmtsasexpr(pTHX)
+{
+    OP *o;
+    lex_read_space(0);
+    if(lex_peek_unichar(0) != '{'/*}*/) croak("syntax error");
+    lex_read_unichar(0);
+    o = parse_stmtseq(0);
+    lex_read_space(0);
+    if(lex_peek_unichar(0) != /*{*/'}') croak("syntax error");
+    lex_read_unichar(0);
+    o = op_prepend_elem(OP_LINESEQ, newOP(OP_ENTER, 0), o);
+    o->op_type = OP_LEAVE;
+    o->op_ppaddr = PL_ppaddr[OP_LEAVE];
+    return o;
+}
+
 /* plugin glue */
 
 #define keyword_active(hintkey_sv) THX_keyword_active(aTHX_ hintkey_sv)
@@ -755,6 +783,14 @@ static int my_keyword_plugin(pTHX_
 		    keyword_active(hintkey_scopelessblock_sv)) {
 	*op_ptr = parse_keyword_scopelessblock();
 	return KEYWORD_PLUGIN_STMT;
+    } else if(keyword_len == 10 && strnEQ(keyword_ptr, "stmtasexpr", 10) &&
+		    keyword_active(hintkey_stmtasexpr_sv)) {
+	*op_ptr = parse_keyword_stmtasexpr();
+	return KEYWORD_PLUGIN_EXPR;
+    } else if(keyword_len == 11 && strnEQ(keyword_ptr, "stmtsasexpr", 11) &&
+		    keyword_active(hintkey_stmtsasexpr_sv)) {
+	*op_ptr = parse_keyword_stmtsasexpr();
+	return KEYWORD_PLUGIN_EXPR;
     } else {
 	return next_keyword_plugin(aTHX_ keyword_ptr, keyword_len, op_ptr);
     }
@@ -2163,6 +2199,8 @@ BOOT:
     hintkey_swaptwostmts_sv = newSVpvs_share("XS::APItest/swaptwostmts");
     hintkey_looprest_sv = newSVpvs_share("XS::APItest/looprest");
     hintkey_scopelessblock_sv = newSVpvs_share("XS::APItest/scopelessblock");
+    hintkey_stmtasexpr_sv = newSVpvs_share("XS::APItest/stmtasexpr");
+    hintkey_stmtsasexpr_sv = newSVpvs_share("XS::APItest/stmtsasexpr");
     next_keyword_plugin = PL_keyword_plugin;
     PL_keyword_plugin = my_keyword_plugin;
 }
diff --git a/ext/XS-APItest/t/stmtasexpr.t b/ext/XS-APItest/t/stmtasexpr.t
new file mode 100644
index 0000000000..44aae8a271
--- /dev/null
+++ b/ext/XS-APItest/t/stmtasexpr.t
@@ -0,0 +1,51 @@
+use warnings;
+use strict;
+
+use Test::More tests => 8;
+
+BEGIN { $^H |= 0x20000; }
+
+my $t;
+
+$t = "";
+eval q{
+	use XS::APItest qw(stmtasexpr);
+	$t .= "a";
+	$t .= "b" . stmtasexpr "c"; . "d";
+	$t .= "e";
+};
+is $@, "";
+is $t, "abcde";
+
+$t = "";
+eval q{
+	use XS::APItest qw(stmtasexpr);
+	$t .= "a";
+	$t .= "b" . stmtasexpr if($t eq "a") { "c"; } else { "d"; } . "e";
+	$t .= "f";
+};
+is $@, "";
+is $t, "abcef";
+
+$t = "";
+eval q{
+	use XS::APItest qw(stmtasexpr);
+	$t .= "a";
+	$t .= "b" . stmtasexpr if($t eq "z") { "c"; } else { "d"; } . "e";
+	$t .= "f";
+};
+is $@, "";
+is $t, "abdef";
+
+$t = "";
+eval q{
+	use XS::APItest qw(stmtasexpr);
+	no warnings "void";
+	$t .= "a";
+	$t .= "b" . stmtasexpr { "z"; "c"; } . "d";
+	$t .= "e";
+};
+is $@, "";
+is $t, "abcde";
+
+1;
diff --git a/ext/XS-APItest/t/stmtsasexpr.t b/ext/XS-APItest/t/stmtsasexpr.t
new file mode 100644
index 0000000000..5e3391cdee
--- /dev/null
+++ b/ext/XS-APItest/t/stmtsasexpr.t
@@ -0,0 +1,62 @@
+use warnings;
+use strict;
+
+use Test::More tests => 10;
+
+BEGIN { $^H |= 0x20000; }
+
+my $t;
+
+$t = "";
+eval q{
+	use XS::APItest qw(stmtsasexpr);
+	$t .= "a";
+	$t .= "b" . stmtsasexpr { "c"; } . "d";
+	$t .= "e";
+};
+is $@, "";
+is $t, "abcde";
+
+$t = "";
+eval q{
+	use XS::APItest qw(stmtsasexpr);
+	no warnings "void";
+	$t .= "a";
+	$t .= "b" . stmtsasexpr { "z"; "c"; } . "d";
+	$t .= "e";
+};
+is $@, "";
+is $t, "abcde";
+
+$t = "";
+eval q{
+	use XS::APItest qw(stmtsasexpr);
+	$t .= "a";
+	$t .= "b" . stmtsasexpr { if($t eq "a") { "c"; } else { "d"; } } . "e";
+	$t .= "f";
+};
+is $@, "";
+is $t, "abcef";
+
+$t = "";
+eval q{
+	use XS::APItest qw(stmtsasexpr);
+	$t .= "a";
+	$t .= "b" . stmtsasexpr { if($t eq "z") { "c"; } else { "d"; } } . "e";
+	$t .= "f";
+};
+is $@, "";
+is $t, "abdef";
+
+$t = "";
+eval q{
+	use XS::APItest qw(stmtsasexpr);
+	no warnings "void";
+	$t .= "a";
+	$t .= "b" . stmtsasexpr { { "z"; "c"; } } . "d";
+	$t .= "e";
+};
+is $@, "";
+is $t, "abcde";
+
+1;