Skip to content

Commit 248b96b

Browse files
committed
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().
1 parent 21938ae commit 248b96b

File tree

4 files changed

+44
-41
lines changed

4 files changed

+44
-41
lines changed

pp_ctl.c

Lines changed: 39 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -1656,27 +1656,53 @@ void
16561656
Perl_qerror(pTHX_ SV *err)
16571657
{
16581658
PERL_ARGS_ASSERT_QERROR;
1659-
1660-
if (PL_in_eval) {
1661-
if (PL_in_eval & EVAL_KEEPERR) {
1662-
Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "\t(in cleanup) %" SVf,
1663-
SVfARG(err));
1659+
if (err!=NULL) {
1660+
if (PL_in_eval) {
1661+
if (PL_in_eval & EVAL_KEEPERR) {
1662+
Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "\t(in cleanup) %" SVf,
1663+
SVfARG(err));
1664+
}
1665+
else {
1666+
sv_catsv(ERRSV, err);
1667+
}
16641668
}
1669+
else if (PL_errors)
1670+
sv_catsv(PL_errors, err);
16651671
else
1666-
sv_catsv(ERRSV, err);
1672+
Perl_warn(aTHX_ "%" SVf, SVfARG(err));
1673+
1674+
if (PL_parser) {
1675+
++PL_parser->error_count;
1676+
}
16671677
}
1668-
else if (PL_errors)
1669-
sv_catsv(PL_errors, err);
1670-
else
1671-
Perl_warn(aTHX_ "%" SVf, SVfARG(err));
16721678

1673-
if (PL_parser) {
1674-
++PL_parser->error_count;
1679+
if ( PL_parser && (err == NULL ||
1680+
PL_parser->error_count >= PERL_STOP_PARSING_AFTER_N_ERRORS)
1681+
) {
1682+
const char * const name = OutCopFILE(PL_curcop);
1683+
SV * errsv = NULL;
1684+
U8 raw_error_count = PERL_PARSE_ERROR_COUNT(PL_parser->error_count);
1685+
1686+
if (PL_in_eval) {
1687+
errsv = ERRSV;
1688+
}
1689+
1690+
if (err == NULL) {
1691+
abort_execution(errsv, name);
1692+
}
1693+
else
1694+
if (raw_error_count >= PERL_STOP_PARSING_AFTER_N_ERRORS) {
1695+
if (errsv) {
1696+
Perl_croak(aTHX_ "%" SVf "%s has too many errors.\n",
1697+
SVfARG(errsv), name);
1698+
} else {
1699+
Perl_croak(aTHX_ "%s has too many errors.\n", name);
1700+
}
1701+
}
16751702
}
16761703
}
16771704

16781705

1679-
16801706
/* pop a CXt_EVAL context and in addition, if it was a require then
16811707
* based on action:
16821708
* 0: do nothing extra;

t/lib/feature/bundle

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -109,3 +109,4 @@ print $_||$@;
109109
EXPECT
110110
Number found where operator expected (Do you need to predeclare "evalbytes"?) at (eval 1) line 1, near "evalbytes 12345"
111111
syntax error at (eval 1) line 1, near "evalbytes 12345"
112+
Execution of (eval 1) aborted due to compilation errors.

t/lib/strict/vars

Lines changed: 0 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -213,11 +213,6 @@ Global symbol "$m" requires explicit package name (did you forget to declare "my
213213
Global symbol "$d" requires explicit package name (did you forget to declare "my $d"?) at abc.pm line 6.
214214
Global symbol "$i" requires explicit package name (did you forget to declare "my $i"?) at abc.pm line 6.
215215
Global symbol "$n" requires explicit package name (did you forget to declare "my $n"?) at abc.pm line 6.
216-
Global symbol "$e" requires explicit package name (did you forget to declare "my $e"?) at abc.pm line 7.
217-
Global symbol "$j" requires explicit package name (did you forget to declare "my $j"?) at abc.pm line 7.
218-
Global symbol "$o" requires explicit package name (did you forget to declare "my $o"?) at abc.pm line 7.
219-
Global symbol "$p" requires explicit package name (did you forget to declare "my $p"?) at abc.pm line 8.
220-
Illegal binary digit '2' at abc.pm line 8, at end of line
221216
abc.pm has too many errors.
222217
Compilation failed in require at - line 1.
223218
BEGIN failed--compilation aborted at - line 1.

toke.c

Lines changed: 4 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -12929,30 +12929,11 @@ Perl_yyerror_pvn(pTHX_ const char *const s, STRLEN len, U32 flags)
1292912929
qerror(msg);
1293012930
}
1293112931
}
12932-
if ( s == NULL ||
12933-
PL_error_count >= PERL_STOP_PARSING_AFTER_N_ERRORS
12934-
) {
12935-
const char * const name = OutCopFILE(PL_curcop);
12936-
SV * errsv = NULL;
12937-
U8 raw_error_count = PERL_PARSE_ERROR_COUNT(PL_error_count);
12938-
12939-
if (PL_in_eval) {
12940-
errsv = ERRSV;
12941-
}
12932+
/* if there was no message then this is a yyquit(), which is actualy handled
12933+
* by qerror() with a NULL argument */
12934+
if (s == NULL)
12935+
qerror(NULL);
1294212936

12943-
if (s == NULL) {
12944-
abort_execution(errsv, name);
12945-
}
12946-
else
12947-
if (raw_error_count >= PERL_STOP_PARSING_AFTER_N_ERRORS) {
12948-
if (errsv) {
12949-
Perl_croak(aTHX_ "%" SVf "%s has too many errors.\n",
12950-
SVfARG(errsv), name);
12951-
} else {
12952-
Perl_croak(aTHX_ "%s has too many errors.\n", name);
12953-
}
12954-
}
12955-
}
1295612937
PL_in_my = 0;
1295712938
PL_in_my_stash = NULL;
1295812939
return 0;

0 commit comments

Comments
 (0)