In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/794826f458d760d13e8727e0e0a3fd7fe79faabd?hp=d3bd3509f493e2e5b7dce62da1588008db56b899>
- Log ----------------------------------------------------------------- commit 794826f458d760d13e8727e0e0a3fd7fe79faabd Author: Yves Orton <[email protected]> Date: Tue Oct 18 13:11:49 2016 +0200 regexec.c: fix #129903: forbid empty pattern in regex code block PL_curpm provides access to the data needed to implement the regex magic vars like $1 and $&. These vars are defined to reference the last successfully matched pattern, or when in regex code blocks (?{ ... }) and (??{ ... }), they should refer to the currently executing pattern. Unfortunately this collides with its use to implement the empty pattern special behavior, which requires /just/ "the last successfully matched pattern" everwhere. This meant that a pattern match like /(?{ s!!! })/ will infinitely recurse. Fixing this would be difficult, on the other hand detecting it is not, so we can convert the infinite recursion/stack overflow into a normal exception. M pod/perldiag.pod M pp_ctl.c M pp_hot.c commit acfafe8c681b05c76e0a74ef6663970c491cbf50 Author: Yves Orton <[email protected]> Date: Mon Oct 17 23:13:44 2016 +0200 regexec.c: add comment and add a test The test is from the existing comment. M regexec.c M t/re/re_tests commit 2c27f131241beb434fcd2e4d3c6e9314506513c0 Author: Yves Orton <[email protected]> Date: Mon Oct 17 23:13:16 2016 +0200 regexec.c: fixup annoying unbalanced whitespace M regexec.c commit 2b1a3689744d136137615e54657eec1b16f71afa Author: Yves Orton <[email protected]> Date: Mon Oct 17 23:12:24 2016 +0200 regexec.c: in debug fixup indents and TRIE/BUFFER debug output M embed.fnc M embed.h M proto.h M regexec.c commit c2867e745ca7be5bd833a75556aa8a6e49cdc0a6 Author: Yves Orton <[email protected]> Date: Mon Oct 17 23:10:10 2016 +0200 regexec.c: in debug show whether TRIE nodes have a jump table M regcomp.c commit cfe04db5962490c8d6f96481316bdee1490fe678 Author: Yves Orton <[email protected]> Date: Mon Oct 17 23:09:11 2016 +0200 regexec.c: fix perl #129897: trie short circuit breaks capture buffers There is an optimisation when a trie matches only one thing which causes it to fall through to the following code without setting up a stack unwind frame. This breaks if we are using a trie jump table where we might change state that will need to be unwound on failure. M regexec.c M t/re/re_tests ----------------------------------------------------------------------- Summary of changes: embed.fnc | 4 +- embed.h | 4 +- pod/perldiag.pod | 7 ++++ pp_ctl.c | 7 +++- pp_hot.c | 13 ++++-- proto.h | 4 +- regcomp.c | 7 ++-- regexec.c | 121 ++++++++++++++++++++++++++++++++----------------------- t/re/re_tests | 2 + 9 files changed, 105 insertions(+), 64 deletions(-) diff --git a/embed.fnc b/embed.fnc index 3e0e844..1c9f584 100644 --- a/embed.fnc +++ b/embed.fnc @@ -2408,9 +2408,9 @@ ERs |bool |reginclass |NULLOK regexp * const prog \ |NN const U8 * const p_end \ |bool const utf8_target Es |CHECKPOINT|regcppush |NN const regexp *rex|I32 parenfloor\ - |U32 maxopenparen + |U32 maxopenparen|int depth Es |void |regcppop |NN regexp *rex\ - |NN U32 *maxopenparen_p + |NN U32 *maxopenparen_p|int depth ERsn |U8* |reghop3 |NN U8 *s|SSize_t off|NN const U8 *lim ERsn |U8* |reghop4 |NN U8 *s|SSize_t off|NN const U8 *llim \ |NN const U8 *rlim diff --git a/embed.h b/embed.h index 7ccf06f..1ce8173 100644 --- a/embed.h +++ b/embed.h @@ -1131,8 +1131,8 @@ #define isSB(a,b,c,d,e,f) S_isSB(aTHX_ a,b,c,d,e,f) #define isWB(a,b,c,d,e,f,g) S_isWB(aTHX_ a,b,c,d,e,f,g) #define reg_check_named_buff_matched S_reg_check_named_buff_matched -#define regcppop(a,b) S_regcppop(aTHX_ a,b) -#define regcppush(a,b,c) S_regcppush(aTHX_ a,b,c) +#define regcppop(a,b,c) S_regcppop(aTHX_ a,b,c) +#define regcppush(a,b,c,d) S_regcppush(aTHX_ a,b,c,d) #define reghop3 S_reghop3 #define reghop4 S_reghop4 #define reghopmaybe3 S_reghopmaybe3 diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 6b42a00..2e3496f 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -6916,6 +6916,13 @@ separated by commas, not just aligned on a line. it may skip items, or visit items more than once. Consider using C<keys()> instead of C<each()>. +=item Use of the empty pattern inside of a regex code block is forbidden + +(F) You tried to use the empty pattern inside of a regex code block, +for instance C</(?{ s!!! })/>. Currently for implementation reasons +this is forbidden. Generally you can rewrite code that uses the empty +pattern with the appropriate use of C<qr//>. + =item Use of := for an empty attribute list is not allowed (F) The construction C<my $x := 42> used to parse as equivalent to diff --git a/pp_ctl.c b/pp_ctl.c index 87c669d..b84588c 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -162,8 +162,13 @@ PP(pp_regcomp) #if !defined(USE_ITHREADS) /* can't change the optree at runtime either */ /* PMf_KEEP is handled differently under threads to avoid these problems */ - if (!RX_PRELEN(PM_GETRE(pm)) && PL_curpm) + /* Handle empty pattern */ + if (!RX_PRELEN(PM_GETRE(pm)) && PL_curpm) { + if (PL_curpm == PL_reg_curpm) + croak("Use of the empty pattern inside of " + "a regex code block is forbidden"); pm = PL_curpm; + } if (pm->op_pmflags & PMf_KEEP) { pm->op_private &= ~OPpRUNTIME; /* no point compiling again */ cLOGOP->op_first->op_next = PL_op->op_next; diff --git a/pp_hot.c b/pp_hot.c index ab59096..ea264cc 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -1763,8 +1763,10 @@ PP(pp_match) /* empty pattern special-cased to use last successful pattern if possible, except for qr// */ - if (!ReANY(rx)->mother_re && !RX_PRELEN(rx) - && PL_curpm) { + if (!ReANY(rx)->mother_re && !RX_PRELEN(rx) && PL_curpm) { + if (PL_curpm == PL_reg_curpm) + croak("Use of the empty pattern inside of " + "a regex code block is forbidden"); pm = PL_curpm; rx = PM_GETRE(pm); } @@ -2960,8 +2962,11 @@ PP(pp_subst) position, once with zero-length, second time with non-zero. */ - if (!RX_PRELEN(rx) && PL_curpm - && !ReANY(rx)->mother_re) { + /* handle the empty pattern */ + if (!RX_PRELEN(rx) && PL_curpm && !ReANY(rx)->mother_re) { + if (PL_curpm == PL_reg_curpm) + croak("Use of the empty pattern inside of " + "a regex code block is forbidden"); pm = PL_curpm; rx = PM_GETRE(pm); } diff --git a/proto.h b/proto.h index 228e84e..efe02e5 100644 --- a/proto.h +++ b/proto.h @@ -5277,10 +5277,10 @@ STATIC I32 S_reg_check_named_buff_matched(const regexp *rex, const regnode *scan #define PERL_ARGS_ASSERT_REG_CHECK_NAMED_BUFF_MATCHED \ assert(rex); assert(scan) -STATIC void S_regcppop(pTHX_ regexp *rex, U32 *maxopenparen_p); +STATIC void S_regcppop(pTHX_ regexp *rex, U32 *maxopenparen_p, int depth); #define PERL_ARGS_ASSERT_REGCPPOP \ assert(rex); assert(maxopenparen_p) -STATIC CHECKPOINT S_regcppush(pTHX_ const regexp *rex, I32 parenfloor, U32 maxopenparen); +STATIC CHECKPOINT S_regcppush(pTHX_ const regexp *rex, I32 parenfloor, U32 maxopenparen, int depth); #define PERL_ARGS_ASSERT_REGCPPUSH \ assert(rex) STATIC U8* S_reghop3(U8 *s, SSize_t off, const U8 *lim) diff --git a/regcomp.c b/regcomp.c index 68417ff..97f601e 100644 --- a/regcomp.c +++ b/regcomp.c @@ -18929,7 +18929,9 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o, const regmatch_ = (reg_trie_data*)progi->data->data[!IS_TRIE_AC(op) ? n : ac->trie]; Perl_sv_catpvf(aTHX_ sv, "-%s",PL_reg_name[o->flags]); - DEBUG_TRIE_COMPILE_r( + DEBUG_TRIE_COMPILE_r({ + if (trie->jump) + sv_catpvs(aTHX_ sv, "(JUMP)"); Perl_sv_catpvf(aTHX_ sv, "<S:%"UVuf"/%"IVdf" W:%"UVuf" L:%"UVuf"/%"UVuf" C:%"UVuf"/%"UVuf">", (UV)trie->startstate, @@ -18940,7 +18942,7 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o, const regmatch_ (UV)TRIE_CHARCOUNT(trie), (UV)trie->uniquecharcount ); - ); + }); if ( IS_ANYOF_TRIE(op) || trie->bitmap ) { sv_catpvs(sv, "["); (void) put_charclass_bitmap_innards(sv, @@ -18954,7 +18956,6 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o, const regmatch_ ); sv_catpvs(sv, "]"); } - } else if (k == CURLY) { U32 lo = ARG1(o), hi = ARG2(o); if (OP(o) == CURLYM || OP(o) == CURLYN || OP(o) == CURLYX) diff --git a/regexec.c b/regexec.c index e9e23f2..0da34af 100644 --- a/regexec.c +++ b/regexec.c @@ -272,7 +272,7 @@ static regmatch_state * S_push_slab(pTHX); * are needed for the regexp context stack bookkeeping. */ STATIC CHECKPOINT -S_regcppush(pTHX_ const regexp *rex, I32 parenfloor, U32 maxopenparen) +S_regcppush(pTHX_ const regexp *rex, I32 parenfloor, U32 maxopenparen, int depth) { const int retval = PL_savestack_ix; const int paren_elems_to_push = @@ -300,9 +300,10 @@ S_regcppush(pTHX_ const regexp *rex, I32 parenfloor, U32 maxopenparen) DEBUG_BUFFERS_r( if ((int)maxopenparen > (int)parenfloor) - Perl_re_printf( aTHX_ + Perl_re_exec_indentf( aTHX_ "rex=0x%"UVxf" offs=0x%"UVxf": saving capture indices:\n", - PTR2UV(rex), + depth, + PTR2UV(rex), PTR2UV(rex->offs) ); ); @@ -311,9 +312,10 @@ S_regcppush(pTHX_ const regexp *rex, I32 parenfloor, U32 maxopenparen) SSPUSHIV(rex->offs[p].end); SSPUSHIV(rex->offs[p].start); SSPUSHINT(rex->offs[p].start_tmp); - DEBUG_BUFFERS_r(Perl_re_printf( aTHX_ + DEBUG_BUFFERS_r(Perl_re_exec_indentf( aTHX_ " \\%"UVuf": %"IVdf"(%"IVdf")..%"IVdf"\n", - (UV)p, + depth, + (UV)p, (IV)rex->offs[p].start, (IV)rex->offs[p].start_tmp, (IV)rex->offs[p].end @@ -356,7 +358,7 @@ S_regcppush(pTHX_ const regexp *rex, I32 parenfloor, U32 maxopenparen) STATIC void -S_regcppop(pTHX_ regexp *rex, U32 *maxopenparen_p) +S_regcppop(pTHX_ regexp *rex, U32 *maxopenparen_p, int depth) { UV i; U32 paren; @@ -376,9 +378,10 @@ S_regcppop(pTHX_ regexp *rex, U32 *maxopenparen_p) /* Now restore the parentheses context. */ DEBUG_BUFFERS_r( if (i || rex->lastparen + 1 <= rex->nparens) - Perl_re_printf( aTHX_ + Perl_re_exec_indentf( aTHX_ "rex=0x%"UVxf" offs=0x%"UVxf": restoring capture indices to:\n", - PTR2UV(rex), + depth, + PTR2UV(rex), PTR2UV(rex->offs) ); ); @@ -390,9 +393,10 @@ S_regcppop(pTHX_ regexp *rex, U32 *maxopenparen_p) tmps = SSPOPIV; if (paren <= rex->lastparen) rex->offs[paren].end = tmps; - DEBUG_BUFFERS_r( Perl_re_printf( aTHX_ + DEBUG_BUFFERS_r( Perl_re_exec_indentf( aTHX_ " \\%"UVuf": %"IVdf"(%"IVdf")..%"IVdf"%s\n", - (UV)paren, + depth, + (UV)paren, (IV)rex->offs[paren].start, (IV)rex->offs[paren].start_tmp, (IV)rex->offs[paren].end, @@ -414,9 +418,10 @@ S_regcppop(pTHX_ regexp *rex, U32 *maxopenparen_p) if (i > *maxopenparen_p) rex->offs[i].start = -1; rex->offs[i].end = -1; - DEBUG_BUFFERS_r( Perl_re_printf( aTHX_ + DEBUG_BUFFERS_r( Perl_re_exec_indentf( aTHX_ " \\%"UVuf": %s ..-1 undeffing\n", - (UV)i, + depth, + (UV)i, (i > *maxopenparen_p) ? "-1" : " " )); } @@ -427,11 +432,11 @@ S_regcppop(pTHX_ regexp *rex, U32 *maxopenparen_p) * but without popping the stack */ STATIC void -S_regcp_restore(pTHX_ regexp *rex, I32 ix, U32 *maxopenparen_p) +S_regcp_restore(pTHX_ regexp *rex, I32 ix, U32 *maxopenparen_p, int depth) { I32 tmpix = PL_savestack_ix; PL_savestack_ix = ix; - regcppop(rex, maxopenparen_p); + S_regcppop(aTHX_ rex, maxopenparen_p, depth); PL_savestack_ix = tmpix; } @@ -3126,9 +3131,10 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, char *strend, swap = prog->offs; /* do we need a save destructor here for eval dies? */ Newxz(prog->offs, (prog->nparens + 1), regexp_paren_pair); - DEBUG_BUFFERS_r(Perl_re_printf( aTHX_ + DEBUG_BUFFERS_r(Perl_re_exec_indentf( aTHX_ "rex=0x%"UVxf" saving offs: orig=0x%"UVxf" new=0x%"UVxf"\n", - PTR2UV(prog), + 0, + PTR2UV(prog), PTR2UV(swap), PTR2UV(prog->offs) )); @@ -3510,9 +3516,10 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, char *strend, DEBUG_BUFFERS_r( if (swap) - Perl_re_printf( aTHX_ + Perl_re_exec_indentf( aTHX_ "rex=0x%"UVxf" freeing offs: 0x%"UVxf"\n", - PTR2UV(prog), + 0, + PTR2UV(prog), PTR2UV(swap) ); ); @@ -3547,9 +3554,10 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, char *strend, if (swap) { /* we failed :-( roll it back */ - DEBUG_BUFFERS_r(Perl_re_printf( aTHX_ + DEBUG_BUFFERS_r(Perl_re_exec_indentf( aTHX_ "rex=0x%"UVxf" rolling back offs: freeing=0x%"UVxf" restoring=0x%"UVxf"\n", - PTR2UV(prog), + 0, + PTR2UV(prog), PTR2UV(prog->offs), PTR2UV(swap) )); @@ -3607,6 +3615,14 @@ S_regtry(pTHX_ regmatch_info *reginfo, char **startposp) * above-mentioned test suite tests to succeed. The common theme * on those tests seems to be returning null fields from matches. * --jhi updated by dapm */ + + /* After encountering a variant of the issue mentioned above I think + * the point Ilya was making is that if we properly unwind whenever + * we set lastparen to a smaller value then we should not need to do + * this every time, only when needed. So if we have tests that fail if + * we remove this, then it suggests somewhere else we are improperly + * unwinding the lastparen/paren buffers. See UNWIND_PARENS() and + * places it is called, and related regcp() routines. - Yves */ #if 1 if (prog->nparens) { regexp_paren_pair *pp = prog->offs; @@ -5400,15 +5416,17 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) PERL_ARGS_ASSERT_REGMATCH; - DEBUG_OPTIMISE_r( DEBUG_EXECUTE_r({ - Perl_re_printf( aTHX_ "regmatch start\n"); - })); - st = PL_regmatch_state; /* Note that nextchr is a byte even in UTF */ SET_nextchr; scan = prog; + + DEBUG_OPTIMISE_r( DEBUG_EXECUTE_r({ + DUMP_EXEC_POS( locinput, scan, utf8_target, depth ); + Perl_re_printf( aTHX_ "regmatch start\n" ); + })); + while (scan != NULL) { @@ -5649,9 +5667,10 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) DEBUG_TRIE_EXECUTE_r({ DUMP_EXEC_POS( (char *)uc, scan, utf8_target, depth ); - Perl_re_exec_indentf( aTHX_ - "%sState: %4"UVxf" Accepted: %c ", - depth, PL_colors[4], + /* HERE */ + PerlIO_printf( aTHX_ Perl_debug_log, + "%*s%sState: %4"UVxf" Accepted: %c ", + INDENT_CHARS(depth), "", PL_colors[4], (UV)state, (accepted ? 'Y' : 'N')); }); @@ -5714,7 +5733,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) case TRIE_next_fail: /* we failed - try next alternative */ { U8 *uc; - if ( ST.jump) { + if ( ST.jump ) { REGCP_UNWIND(ST.cp); UNWIND_PAREN(ST.lastparen, ST.lastcloseparen); } @@ -5748,7 +5767,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) no_final = 0; } - if ( ST.jump) { + if ( ST.jump ) { ST.lastparen = rex->lastparen; ST.lastcloseparen = rex->lastcloseparen; REGCP_SET(ST.cp); @@ -5819,7 +5838,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) ); }); - if (ST.accepted > 1 || has_cutgroup) { + if ( ST.accepted > 1 || has_cutgroup || ST.jump ) { PUSH_STATE_GOTO(TRIE_next, scan, (char*)uc); NOT_REACHED; /* NOTREACHED */ } @@ -6749,7 +6768,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) } /* Save all the positions seen so far. */ - ST.cp = regcppush(rex, 0, maxopenparen); + ST.cp = S_regcppush(aTHX_ rex, 0, maxopenparen, depth); REGCP_SET(ST.lastcp); /* and then jump to the code we share with EVAL */ @@ -6774,7 +6793,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) CV *newcv; /* save *all* paren positions */ - regcppush(rex, 0, maxopenparen); + S_regcppush(aTHX_ rex, 0, maxopenparen, depth); REGCP_SET(runops_cp); if (!caller_cv) @@ -6940,7 +6959,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) * in the regexp code uses the pad ! */ PL_op = oop; PL_curcop = ocurcop; - S_regcp_restore(aTHX_ rex, runops_cp, &maxopenparen); + S_regcp_restore(aTHX_ rex, runops_cp, &maxopenparen, depth); PL_curpm = PL_reg_curpm; if (logical != 2) @@ -7008,7 +7027,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) * close_paren only for GOSUB */ ST.prev_recurse_locinput= NULL; /* only used for GOSUB */ /* Save all the seen positions so far. */ - ST.cp = regcppush(rex, 0, maxopenparen); + ST.cp = S_regcppush(aTHX_ rex, 0, maxopenparen, depth); REGCP_SET(ST.lastcp); /* and set maxopenparen to 0, since we are starting a "fresh" match */ maxopenparen = 0; @@ -7108,7 +7127,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) rexi = RXi_GET(rex); REGCP_UNWIND(ST.lastcp); - regcppop(rex, &maxopenparen); + S_regcppop(aTHX_ rex, &maxopenparen, depth); cur_eval = ST.prev_eval; cur_curlyx = ST.prev_curlyx; @@ -7126,8 +7145,9 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) rex->offs[n].start_tmp = locinput - reginfo->strbeg; if (n > maxopenparen) maxopenparen = n; - DEBUG_BUFFERS_r(Perl_re_printf( aTHX_ + DEBUG_BUFFERS_r(Perl_re_exec_indentf( aTHX_ "rex=0x%"UVxf" offs=0x%"UVxf": \\%"UVuf": set %"IVdf" tmp; maxopenparen=%"UVuf"\n", + depth, PTR2UV(rex), PTR2UV(rex->offs), (UV)n, @@ -7141,8 +7161,9 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) #define CLOSE_CAPTURE \ rex->offs[n].start = rex->offs[n].start_tmp; \ rex->offs[n].end = locinput - reginfo->strbeg; \ - DEBUG_BUFFERS_r(Perl_re_printf( aTHX_ \ + DEBUG_BUFFERS_r(Perl_re_exec_indentf( aTHX_ \ "rex=0x%"UVxf" offs=0x%"UVxf": \\%"UVuf": set %"IVdf"..%"IVdf"\n", \ + depth, \ PTR2UV(rex), \ PTR2UV(rex->offs), \ (UV)n, \ @@ -7379,8 +7400,8 @@ NULL /* First just match a string of min A's. */ if (n < min) { - ST.cp = regcppush(rex, cur_curlyx->u.curlyx.parenfloor, - maxopenparen); + ST.cp = S_regcppush(aTHX_ rex, cur_curlyx->u.curlyx.parenfloor, + maxopenparen, depth); cur_curlyx->u.curlyx.lastloc = locinput; REGCP_SET(ST.lastcp); @@ -7490,8 +7511,8 @@ NULL if (cur_curlyx->u.curlyx.minmod) { ST.save_curlyx = cur_curlyx; cur_curlyx = cur_curlyx->u.curlyx.prev_curlyx; - ST.cp = regcppush(rex, ST.save_curlyx->u.curlyx.parenfloor, - maxopenparen); + ST.cp = S_regcppush(aTHX_ rex, ST.save_curlyx->u.curlyx.parenfloor, + maxopenparen, depth); REGCP_SET(ST.lastcp); PUSH_YES_STATE_GOTO(WHILEM_B_min, ST.save_curlyx->u.curlyx.B, locinput); @@ -7501,8 +7522,8 @@ NULL /* Prefer A over B for maximal matching. */ if (n < max) { /* More greed allowed? */ - ST.cp = regcppush(rex, cur_curlyx->u.curlyx.parenfloor, - maxopenparen); + ST.cp = S_regcppush(aTHX_ rex, cur_curlyx->u.curlyx.parenfloor, + maxopenparen, depth); cur_curlyx->u.curlyx.lastloc = locinput; REGCP_SET(ST.lastcp); PUSH_STATE_GOTO(WHILEM_A_max, A, locinput); @@ -7529,7 +7550,7 @@ NULL /* FALLTHROUGH */ case WHILEM_A_pre_fail: /* just failed to match even minimal A */ REGCP_UNWIND(ST.lastcp); - regcppop(rex, &maxopenparen); + S_regcppop(aTHX_ rex, &maxopenparen, depth); cur_curlyx->u.curlyx.lastloc = ST.save_lastloc; cur_curlyx->u.curlyx.count--; CACHEsayNO; @@ -7537,7 +7558,7 @@ NULL case WHILEM_A_max_fail: /* just failed to match A in a maximal match */ REGCP_UNWIND(ST.lastcp); - regcppop(rex, &maxopenparen); /* Restore some previous $<digit>s? */ + S_regcppop(aTHX_ rex, &maxopenparen, depth); /* Restore some previous $<digit>s? */ DEBUG_EXECUTE_r(Perl_re_exec_indentf( aTHX_ "whilem: failed, trying continuation...\n", depth) ); @@ -7563,7 +7584,7 @@ NULL case WHILEM_B_min_fail: /* just failed to match B in a minimal match */ cur_curlyx = ST.save_curlyx; REGCP_UNWIND(ST.lastcp); - regcppop(rex, &maxopenparen); + S_regcppop(aTHX_ rex, &maxopenparen, depth); if (cur_curlyx->u.curlyx.count >= /*max*/ARG2(cur_curlyx->u.curlyx.me)) { /* Maximum greed exceeded */ @@ -7585,8 +7606,8 @@ NULL ); /* Try grabbing another A and see if it helps. */ cur_curlyx->u.curlyx.lastloc = locinput; - ST.cp = regcppush(rex, cur_curlyx->u.curlyx.parenfloor, - maxopenparen); + ST.cp = S_regcppush(aTHX_ rex, cur_curlyx->u.curlyx.parenfloor, + maxopenparen, depth); REGCP_SET(ST.lastcp); PUSH_STATE_GOTO(WHILEM_A_min, /*A*/ NEXTOPER(ST.save_curlyx->u.curlyx.me) + EXTRA_STEP_2ARGS, @@ -8166,7 +8187,7 @@ NULL st->u.eval.prev_rex = rex_sv; /* inner */ /* Save *all* the positions. */ - st->u.eval.cp = regcppush(rex, 0, maxopenparen); + st->u.eval.cp = S_regcppush(aTHX_ rex, 0, maxopenparen, depth); rex_sv = CUR_EVAL.prev_rex; is_utf8_pat = reginfo->is_utf8_pat = cBOOL(RX_UTF8(rex_sv)); SET_reg_curpm(rex_sv); @@ -8181,7 +8202,7 @@ NULL /* Restore parens of the outer rex without popping the * savestack */ S_regcp_restore(aTHX_ rex, CUR_EVAL.lastcp, - &maxopenparen); + &maxopenparen, depth); st->u.eval.prev_eval = cur_eval; cur_eval = CUR_EVAL.prev_eval; diff --git a/t/re/re_tests b/t/re/re_tests index 046628c..d6f8436 100644 --- a/t/re/re_tests +++ b/t/re/re_tests @@ -1970,6 +1970,8 @@ aa$|a(?R)a|a aaa y $& aaa # [perl 128420] recursive matches (?:\1|a)([bcd])\1(?:(?R)|e)\1 abbaccaddedcb y $& abbaccaddedcb # [perl 128420] recursive match with backreferences AB\s+\x{100} AB \x{100}X y - - \b\z0*\x{100} .\x{100} n - - # [perl #129350] crashed in intuit_start +(.*(a(a)|i(i))n) riiaan y $2-$3-$4-$1 aa-a--riiaan # Jump trie capture buffer issue [perl #129897] +(^(?:(\d)x)?\d$) 1 y [$1-$2] [1-] # make sure that we reset capture buffers properly (from regtry) # Keep these lines at the end of the file # vim: softtabstop=0 noexpandtab -- Perl5 Master Repository
