pp_ctl.c - Consistently exit after 10 errors

Currently we only check the error count when we report an error via
yyerror(), even though we say we will stop processing after 10 errors.
Errors reported directly to qerror() bypass the check.

This fixes this so that we check the number of errors reported in
qerror() itself. We also change qerror() so that qerror(NULL) triggers
the exception, this way we can move the logic out of yyerror and into
qerror().

Author: demerphq

embed.fnc

@@ -1395,7 +1395,7 @@ Apd	|SV*	|mess_sv	|NN SV* basemsg|bool consume
 Apd	|SV*	|vmess		|NN const char* pat|NULLOK va_list* args
 : FIXME - either make it public, or stop exporting it. (Data::Alias uses this)
 : Used in gv.c, op.c, toke.c
-EXp	|void	|qerror		|NN SV* err
+EXp	|void	|qerror		|NULLOK SV* err
 Apd	|void	|sortsv		|NULLOK SV** array|size_t num_elts|NN SVCOMPARE_t cmp
 Apd	|void	|sortsv_flags	|NULLOK SV** array|size_t num_elts|NN SVCOMPARE_t cmp|U32 flags
 Apd	|int	|mg_clear	|NN SV* sv

pp_ctl.c

@@ -1656,27 +1656,53 @@ void
 Perl_qerror(pTHX_ SV *err)
 {
     PERL_ARGS_ASSERT_QERROR;
-
-    if (PL_in_eval) {
-        if (PL_in_eval & EVAL_KEEPERR) {
-                Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "\t(in cleanup) %" SVf,
-                                                    SVfARG(err));
+    if (err!=NULL) {
+        if (PL_in_eval) {
+            if (PL_in_eval & EVAL_KEEPERR) {
+                    Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "\t(in cleanup) %" SVf,
+                                                        SVfARG(err));
+            }
+            else {
+                sv_catsv(ERRSV, err);
+            }
         }
+        else if (PL_errors)
+            sv_catsv(PL_errors, err);
         else
-            sv_catsv(ERRSV, err);
+            Perl_warn(aTHX_ "%" SVf, SVfARG(err));
+
+        if (PL_parser) {
+            ++PL_parser->error_count;
+        }
     }
-    else if (PL_errors)
-        sv_catsv(PL_errors, err);
-    else
-        Perl_warn(aTHX_ "%" SVf, SVfARG(err));
 
-    if (PL_parser) {
-        ++PL_parser->error_count;
+    if ( PL_parser && (err == NULL ||
+         PL_parser->error_count >= PERL_STOP_PARSING_AFTER_N_ERRORS)
+    ) {
+        const char * const name = OutCopFILE(PL_curcop);
+        SV * errsv = NULL;
+        U8 raw_error_count = PERL_PARSE_ERROR_COUNT(PL_parser->error_count);
+
+        if (PL_in_eval) {
+            errsv = ERRSV;
+        }
+
+        if (err == NULL) {
+            abort_execution(errsv, name);
+        }
+        else
+        if (raw_error_count >= PERL_STOP_PARSING_AFTER_N_ERRORS) {
+            if (errsv) {
+                Perl_croak(aTHX_ "%" SVf "%s has too many errors.\n",
+                    SVfARG(errsv), name);
+            } else {
+                Perl_croak(aTHX_ "%s has too many errors.\n", name);
+            }
+        }
     }
 }
 
 
-
 /* pop a CXt_EVAL context and in addition, if it was a require then
  * based on action:
  *     0: do nothing extra;

proto.h

@@ -3258,8 +3258,7 @@ PERL_CALLCONV char*	Perl_pv_uni_display(pTHX_ SV *dsv, const U8 *spv, STRLEN len
 #define PERL_ARGS_ASSERT_PV_UNI_DISPLAY	\
 	assert(dsv); assert(spv)
 PERL_CALLCONV void	Perl_qerror(pTHX_ SV* err);
-#define PERL_ARGS_ASSERT_QERROR	\
-	assert(err)
+#define PERL_ARGS_ASSERT_QERROR
 PERL_CALLCONV REGEXP*	Perl_re_compile(pTHX_ SV * const pattern, U32 orig_rx_flags);
 #define PERL_ARGS_ASSERT_RE_COMPILE	\
 	assert(pattern)

t/lib/feature/bundle

@@ -110,3 +110,4 @@ EXPECT
 Number found where operator expected at (eval 1) line 1, near "evalbytes 12345"
 	(Do you need to predeclare evalbytes?)
 syntax error at (eval 1) line 1, near "evalbytes 12345"
+Execution of (eval 1) aborted due to compilation errors.

t/lib/strict/vars

@@ -213,11 +213,6 @@ Global symbol "$m" requires explicit package name (did you forget to declare "my
 Global symbol "$d" requires explicit package name (did you forget to declare "my $d"?) at abc.pm line 6.
 Global symbol "$i" requires explicit package name (did you forget to declare "my $i"?) at abc.pm line 6.
 Global symbol "$n" requires explicit package name (did you forget to declare "my $n"?) at abc.pm line 6.
-Global symbol "$e" requires explicit package name (did you forget to declare "my $e"?) at abc.pm line 7.
-Global symbol "$j" requires explicit package name (did you forget to declare "my $j"?) at abc.pm line 7.
-Global symbol "$o" requires explicit package name (did you forget to declare "my $o"?) at abc.pm line 7.
-Global symbol "$p" requires explicit package name (did you forget to declare "my $p"?) at abc.pm line 8.
-Illegal binary digit '2' at abc.pm line 8, at end of line
 abc.pm has too many errors.
 Compilation failed in require at - line 1.
 BEGIN failed--compilation aborted at - line 1.

toke.c

@@ -12654,30 +12654,11 @@ Perl_yyerror_pvn(pTHX_ const char *const s, STRLEN len, U32 flags)
             qerror(msg);
         }
     }
-    if ( s == NULL ||
-         PL_error_count >= PERL_STOP_PARSING_AFTER_N_ERRORS
-    ) {
-        const char * const name = OutCopFILE(PL_curcop);
-        SV * errsv = NULL;
-        U8 raw_error_count = PERL_PARSE_ERROR_COUNT(PL_error_count);
-
-        if (PL_in_eval) {
-            errsv = ERRSV;
-        }
+    /* if there was no message then this is a yyquit(), which is actualy handled
+     * by qerror() with a NULL argument */
+    if (s == NULL)
+        qerror(NULL);
 
-        if (s == NULL) {
-            abort_execution(errsv, name);
-        }
-        else
-        if (raw_error_count >= PERL_STOP_PARSING_AFTER_N_ERRORS) {
-            if (errsv) {
-                Perl_croak(aTHX_ "%" SVf "%s has too many errors.\n",
-                    SVfARG(errsv), name);
-            } else {
-                Perl_croak(aTHX_ "%s has too many errors.\n", name);
-            }
-        }
-    }
     PL_in_my = 0;
     PL_in_my_stash = NULL;
     return 0;