@@ -3126,6 +3126,9 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, char *strend,
3126 3126
));
3127 3127
}
3128 3128 3129 +
if (prog->recurse_locinput)
3130 +
Zero(prog->recurse_locinput,prog->nparens + 1, char *);
3131 + 3129 3132
/* Simplest case: anchored match need be tried only once, or with
3130 3133
* MBOL, only at the beginning of each line.
3131 3134
*
@@ -5184,7 +5187,6 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
5184 5187
bool is_utf8_pat = reginfo->is_utf8_pat;
5185 5188
bool match = FALSE;
5186 5189 5187 - 5188 5190
#ifdef DEBUGGING
5189 5191
GET_RE_DEBUG_FLAGS_DECL;
5190 5192
#endif
@@ -6494,11 +6496,11 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
6494 6496
regexp *re;
6495 6497
regexp_internal *rei;
6496 6498
regnode *startpoint;
6499 +
U32 arg;
6497 6500 6498 6501
case GOSUB: /* /(...(?1))/ /(...(?&foo))/ */
6499 -
if (cur_eval && cur_eval->locinput==locinput) {
6500 -
if ( EVAL_CLOSE_PAREN_IS( cur_eval, (U32)ARG(scan) ) )
6501 -
Perl_croak(aTHX_ "Infinite recursion in regex");
6502 +
arg= (U32)ARG(scan);
6503 +
if (cur_eval && cur_eval->locinput == locinput) {
6502 6504
if ( ++nochange_depth > max_nochange_depth )
6503 6505
Perl_croak(aTHX_
6504 6506
"Pattern subroutine nesting without pos change"
@@ -6510,7 +6512,32 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
6510 6512
re = rex;
6511 6513
rei = rexi;
6512 6514
startpoint = scan + ARG2L(scan);
6513 -
EVAL_CLOSE_PAREN_SET( st, ARG(scan) ); /* ST.close_paren = 1 + ARG(scan) */
6515 +
EVAL_CLOSE_PAREN_SET( st, arg ); /* ST.close_paren = 1 + ARG(scan) */
6516 +
/* Detect infinite recursion
6517 +
*
6518 +
* A pattern like /(?R)foo/ or /(?<x>(?&y)foo)(?<y>(?&x)bar)/
6519 +
* or "a"=~/(.(?2))((?<=(?=(?1)).))/ could recurse forever.
6520 +
* So we track the position in the string we are at each time
6521 +
* we recurse and if we try to enter the same routine twice from
6522 +
* the same position we fail. This means that a pattern like
6523 +
* "aaabbb"=~/a(?R)?b/ works as expected and does not throw an
6524 +
* error.
6525 +
*/
6526 +
if ( rex->recurse_locinput[arg] == locinput ) {
6527 +
DEBUG_r({
6528 +
GET_RE_DEBUG_FLAGS_DECL;
6529 +
DEBUG_EXECUTE_r({
6530 +
PerlIO_printf(Perl_debug_log,
6531 +
"%*s pattern left-recursion without consuming input always fails...\n",
6532 +
REPORT_CODE_OFF + depth*2, "");
6533 +
});
6534 +
});
6535 +
/* this would be infinite recursion, so we fail */
6536 +
sayNO;
6537 +
} else {
6538 +
ST.prev_recurse_locinput= rex->recurse_locinput[arg];
6539 +
rex->recurse_locinput[arg]= locinput;
6540 +
}
6514 6541 6515 6542
/* Save all the positions seen so far. */
6516 6543
ST.cp = regcppush(rex, 0, maxopenparen);
@@ -6547,10 +6574,9 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
6547 6574
n = ARG(scan);
6548 6575 6549 6576
if (rexi->data->what[n] == 'r') { /* code from an external qr */
6550 -
newcv = (ReANY(
6551 -
(REGEXP*)(rexi->data->data[n])
6552 -
))->qr_anoncv
6553 -
;
6577 +
newcv = (ReANY(
6578 +
(REGEXP*)(rexi->data->data[n])
6579 +
))->qr_anoncv;
6554 6580
nop = (OP*)rexi->data->data[n+1];
6555 6581
}
6556 6582
else if (rexi->data->what[n] == 'l') { /* literal code */
@@ -6771,6 +6797,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
6771 6797
startpoint = rei->program + 1;
6772 6798
EVAL_CLOSE_PAREN_CLEAR(st); /* ST.close_paren = 0;
6773 6799
* close_paren only for GOSUB */
6800 +
ST.prev_recurse_locinput= NULL; /* only used for GOSUB */
6774 6801
/* Save all the seen positions so far. */
6775 6802
ST.cp = regcppush(rex, 0, maxopenparen);
6776 6803
REGCP_SET(ST.lastcp);
@@ -6812,6 +6839,9 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
6812 6839 6813 6840
case EVAL_AB: /* cleanup after a successful (??{A})B */
6814 6841
/* note: this is called twice; first after popping B, then A */
6842 +
if ( cur_eval && cur_eval->u.eval.close_paren )
6843 +
rex->recurse_locinput[cur_eval->u.eval.close_paren - 1] = cur_eval->u.eval.prev_recurse_locinput;
6844 + 6815 6845
rex_sv = ST.prev_rex;
6816 6846
is_utf8_pat = reginfo->is_utf8_pat = cBOOL(RX_UTF8(rex_sv));
6817 6847
SET_reg_curpm(rex_sv);
@@ -6837,6 +6867,9 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
6837 6867 6838 6868
case EVAL_AB_fail: /* unsuccessfully ran A or B in (??{A})B */
6839 6869
/* note: this is called twice; first after popping B, then A */
6870 +
if ( cur_eval && cur_eval->u.eval.close_paren )
6871 +
rex->recurse_locinput[cur_eval->u.eval.close_paren - 1] = cur_eval->u.eval.prev_recurse_locinput;
6872 + 6840 6873
rex_sv = ST.prev_rex;
6841 6874
is_utf8_pat = reginfo->is_utf8_pat = cBOOL(RX_UTF8(rex_sv));
6842 6875
SET_reg_curpm(rex_sv);
@@ -7905,6 +7938,8 @@ NULL
7905 7938
fake_end:
7906 7939
if (cur_eval) {
7907 7940
/* we've just finished A in /(??{A})B/; now continue with B */
7941 +
if ( cur_eval->u.eval.close_paren )
7942 +
rex->recurse_locinput[cur_eval->u.eval.close_paren - 1] = cur_eval->u.eval.prev_recurse_locinput;
7908 7943 7909 7944
st->u.eval.prev_rex = rex_sv; /* inner */
7910 7945 RetroSearch is an open source project built by @garambo | Open a GitHub Issue
Search and Browse the WWW like it's 1997 | Search results from DuckDuckGo
HTML:
3.2
| Encoding:
UTF-8
| Version:
0.7.4