[PATCH] function to parse Perl statement sequence

New API function parse_stmtseq() parses a sequence of statements, up to
closing brace or EOF.

1 files changed, 46 insertions, 0 deletions

diff --git a/toke.c b/toke.c
index d81b968443..9e6a731377 100644
--- a/toke.c
+++ b/toke.c
@@ -14004,6 +14004,52 @@ Perl_parse_fullstmt(pTHX_ U32 flags)
     return fullstmtop;
 }
 
+/*
+=for apidoc Amx|OP *|parse_stmtseq|U32 flags
+
+Parse a sequence of zero or more Perl statements.  These may be normal
+imperative statements, including optional labels, or declarations
+that have compile-time effect, or any mixture thereof.  The statement
+sequence ends when a closing brace or end-of-file is encountered in a
+place where a new statement could have validly started.  It is up to
+the caller to ensure that the dynamic parser state (L</PL_parser> et al)
+is correctly set to reflect the source of the code to be parsed and the
+lexical context for the statements.
+
+The op tree representing the statement sequence is returned.  This may
+be a null pointer if the statements were all null, for example if there
+were no statements or if there were only subroutine definitions (which
+have compile-time side effects).  If not null, it will be a C<lineseq>
+list, normally including C<nextstate> or equivalent ops.
+
+If an error occurs in parsing or compilation, in most cases a valid op
+tree is returned anyway.  The error is reflected in the parser state,
+normally resulting in a single exception at the top level of parsing
+which covers all the compilation errors that occurred.  Some compilation
+errors, however, will throw an exception immediately.
+
+The I<flags> parameter is reserved for future use, and must always
+be zero.
+
+=cut
+*/
+
+OP *
+Perl_parse_stmtseq(pTHX_ U32 flags)
+{
+    OP *stmtseqop;
+    if (flags)
+	Perl_croak(aTHX_ "Parsing code internal error (%s)", "parse_fullstmt");
+    ENTER;
+    SAVEVPTR(PL_eval_root);
+    PL_eval_root = NULL;
+    if(yyparse(GRAMSTMTSEQ) && !PL_parser->error_count)
+	qerror(Perl_mess(aTHX_ "Parse error"));
+    stmtseqop = PL_eval_root;
+    LEAVE;
+    return stmtseqop;
+}
+
 void
 Perl_munge_qwlist_to_paren_list(pTHX_ OP *qwlist)
 {