diff options
author | Steve Hay <steve.m.hay@googlemail.com> | 2018-03-19 17:58:30 +0000 |
---|---|---|
committer | Steve Hay <steve.m.hay@googlemail.com> | 2018-03-19 17:58:30 +0000 |
commit | 2794843b3d01dc8a428194bae1b35e579cd139d7 (patch) | |
tree | 0461125f299645d0ab136350a4e1b8d495e7d390 | |
parent | ff3df6adb6102980a36f8991362c849287edb06c (diff) | |
download | perl-2794843b3d01dc8a428194bae1b35e579cd139d7.tar.gz |
(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.
-rw-r--r-- | parser.h | 3 | ||||
-rw-r--r-- | t/base/lex.t | 11 | ||||
-rw-r--r-- | toke.c | 18 |
3 files changed, 31 insertions, 1 deletions
@@ -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"; @@ -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)) |