toke.c: Add internal function to abort parsing

This is to be called to abort the parsing early, before the required
number of errors have been found.  It is used when continuing the parse
would be either fruitless or we could be looking at garbage.

diff --git a/embed.fnc b/embed.fnc
index b7366b6..a384c36 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1877,6 +1877,7 @@ inR       |bool   |should_warn_nl|NN const char *pv
 p      |void   |write_to_stderr|NN SV* msv
 : Used in op.c
 p      |int    |yyerror        |NN const char *const s
+p      |void   |yyquit
 p      |void   |abort_execution|NN const char * const msg|NN const char * const name
 p      |int    |yyerror_pv     |NN const char *const s|U32 flags
 p      |int    |yyerror_pvn    |NULLOK const char *const s|STRLEN len|U32 flags

diff --git a/embed.h b/embed.h
index 89a5fd9..2bbfc64 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -1416,6 +1416,7 @@
 #define yyerror_pv(a,b)                Perl_yyerror_pv(aTHX_ a,b)
 #define yyerror_pvn(a,b,c)     Perl_yyerror_pvn(aTHX_ a,b,c)
 #define yyparse(a)             Perl_yyparse(aTHX_ a)
+#define yyquit()               Perl_yyquit(aTHX)
 #define yyunlex()              Perl_yyunlex(aTHX)
 #  if !(defined(DEBUGGING))
 #    if !defined(NV_PRESERVES_UV)

diff --git a/proto.h b/proto.h
index d914547..8281563 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -3701,6 +3701,7 @@ PERL_CALLCONV int Perl_yyerror_pv(pTHX_ const char *const s, U32 flags);
 PERL_CALLCONV int      Perl_yyerror_pvn(pTHX_ const char *const s, STRLEN len, U32 flags);
 PERL_CALLCONV int      Perl_yylex(pTHX);
 PERL_CALLCONV int      Perl_yyparse(pTHX_ int gramtype);
+PERL_CALLCONV void     Perl_yyquit(pTHX);
 PERL_CALLCONV void     Perl_yyunlex(pTHX);
 #if !(defined(DEBUGGING))
 #  if !defined(NV_PRESERVES_UV)

diff --git a/toke.c b/toke.c
index 5fba4fe..383203a 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -11464,6 +11464,15 @@ Perl_abort_execution(pTHX_ const char * const msg, const char * const name)
     NOT_REACHED; /* NOTREACHED */
 }
 
+void
+Perl_yyquit(pTHX)
+{
+    /* Called, after at least one error has been found, to abort the parse now,
+     * instead of trying to forge ahead */
+
+    yyerror_pvn(NULL, 0, 0);
+}
+
 int
 Perl_yyerror(pTHX_ const char *const s)
 {