(perl #125351) abort parsing if parse errors happen in a sub lex

We've had a few reports of segmentation faults and other misbehaviour
when sub-parsing, such as within interpolated expressions, fails.

This change aborts compilation if anything complex enough to not be
parsed by the lexer is compiled in a sub-parse *and* an error
occurs within the sub-parse.

An earlier version of this patch failed on simpler expressions,
which caused many test failures, which this version doesn't (which may
just mean we need more tests...)

(cherry picked from commit bb4e4c3869d9fb6ee5bddd820c2a373601ecc310)

Modified for maint by cherry-picker: New parser struct members moved to
end of struct to preserve backwards-compatibility.

3 files changed, 31 insertions, 1 deletions

diff --git a/parser.h b/parser.h
index 4187e0a93d..1241f67c24 100644
--- a/parser.h
+++ b/parser.h
@@ -121,6 +121,9 @@ typedef struct yy_parser {
     PERL_BITFIELD16	filtered:1;    /* source filters in evalbytes */
     PERL_BITFIELD16	saw_infix_sigil:1; /* saw & or * or % operator */
     PERL_BITFIELD16	parsed_sub:1;  /* last thing parsed was a sub */
+
+    bool        sub_no_recover; /* can't recover from a sublex error */
+    U8		sub_error_count; /* the number of errors before sublexing */
 } yy_parser;
 
 /* flags for lexer API */
diff --git a/t/base/lex.t b/t/base/lex.t
index e154aca801..99fd3bba93 100644
--- a/t/base/lex.t
+++ b/t/base/lex.t
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..109\n";
+print "1..112\n";
 
 $x = 'x';
 
@@ -528,6 +528,15 @@ eval q|s##[}#e|;
  eval ('/@0{0*->@*/*]');
  print "ok $test - 128171\n"; $test++;
 }
+{
+  # various sub-parse recovery issues that crashed perl
+  eval 's//${sub{b{]]]{}#$/ sub{}';
+  print "ok $test - 132640\n"; $test++;
+  eval 'qq{@{sub{]]}}}};shift';
+  print "ok $test - 125351\n"; $test++;
+  eval 'qq{@{sub{]]}}}}-shift';
+  print "ok $test - 126192\n"; $test++;
+}
 
 $foo = "WRONG"; $foo:: = "bar"; $bar = "baz";
 print "not " unless "$foo::$bar" eq "barbaz";
diff --git a/toke.c b/toke.c
index e8a599ab42..ee9c464977 100644
--- a/toke.c
+++ b/toke.c
@@ -2388,6 +2388,8 @@ S_sublex_start(pTHX)
     PL_parser->lex_super_state = PL_lex_state;
     PL_parser->lex_sub_inwhat = (U16)op_type;
     PL_parser->lex_sub_op = PL_lex_op;
+    PL_parser->sub_no_recover = FALSE;
+    PL_parser->sub_error_count = PL_error_count;
     PL_lex_state = LEX_INTERPPUSH;
 
     PL_expect = XTERM;
@@ -2567,6 +2569,20 @@ S_sublex_done(pTHX)
     else {
 	const line_t l = CopLINE(PL_curcop);
 	LEAVE;
+        if (PL_parser->sub_error_count != PL_error_count) {
+            const char * const name = OutCopFILE(PL_curcop);
+            if (PL_parser->sub_no_recover) {
+                const char * msg = "";
+                if (PL_in_eval) {
+                    SV *errsv = ERRSV;
+                    if (SvCUR(ERRSV)) {
+                        msg = Perl_form(aTHX_ "%" SVf, SVfARG(errsv));
+                    }
+                }
+                abort_execution(msg, name);
+                NOT_REACHED;
+            }
+        }
 	if (PL_multi_close == '<')
 	    PL_parser->herelines += l - PL_multi_end;
 	PL_bufend = SvPVX(PL_linestr);
@@ -4141,6 +4157,7 @@ S_intuit_more(pTHX_ char *s)
 	return TRUE;
     if (*s != '{' && *s != '[')
 	return FALSE;
+    PL_parser->sub_no_recover = TRUE;
     if (!PL_lex_inpat)
 	return TRUE;
 
@@ -9494,6 +9511,7 @@ S_scan_ident(pTHX_ char *s, char *dest, STRLEN destlen, I32 ck_uni)
             CopLINE_set(PL_curcop, orig_copline);
             PL_parser->herelines = herelines;
 	    *dest = '\0';
+            PL_parser->sub_no_recover = TRUE;
 	}
     }
     else if (PL_lex_state == LEX_INTERPNORMAL && !PL_lex_brackets && !intuit_more(s))