*/
#define CHR_SVLEN(sv) (utf8_target ? sv_len_utf8(sv) : SvCUR(sv))
-#define CHR_DIST(a,b) (reginfo->is_utf8_target ? utf8_distance(a,b) : a - b)
#define HOPc(pos,off) \
(char *)(reginfo->is_utf8_target \
(U8*)(off >= 0 ? reginfo->strend : reginfo->strbeg)) \
: (U8*)(pos + off))
-#define HOPBACKc(pos, off) \
- (char*)(reginfo->is_utf8_target \
- ? reghopmaybe3((U8*)pos, (SSize_t)0-off, (U8*)(reginfo->strbeg)) \
- : (pos - off >= reginfo->strbeg) \
- ? (U8*)pos - off \
+/* like HOPMAYBE3 but backwards. lim must be +ve. Returns NULL on overshoot */
+#define HOPBACK3(pos, off, lim) \
+ (reginfo->is_utf8_target \
+ ? reghopmaybe3((U8*)pos, (SSize_t)0-off, (U8*)(lim)) \
+ : (pos - off >= lim) \
+ ? (U8*)pos - off \
: NULL)
+#define HOPBACKc(pos, off) ((char*)HOPBACK3(pos, off, reginfo->strbeg))
+
#define HOP3(pos,off,lim) (reginfo->is_utf8_target ? reghop3((U8*)(pos), off, (U8*)(lim)) : (U8*)(pos + off))
#define HOP3c(pos,off,lim) ((char*)HOP3(pos,off,lim))
#define HOP3lim(pos,off,lim) (reginfo->is_utf8_target \
? reghop3((U8*)(pos), off, (U8*)(lim)) \
: (U8*)((pos + off) > lim ? lim : (pos + off)))
+#define HOP3clim(pos,off,lim) ((char*)HOP3lim(pos,off,lim))
#define HOP4(pos,off,llim, rlim) (reginfo->is_utf8_target \
? reghop4((U8*)(pos), off, (U8*)(llim), (U8*)(rlim)) \
#define regcpblow(cp) LEAVE_SCOPE(cp) /* Ignores regcppush()ed data. */
+#ifndef PERL_IN_XSUB_RE
+
bool
Perl_isFOO_lc(pTHX_ const U8 classnum, const U8 character)
{
return FALSE;
}
+#endif
+
STATIC bool
S_isFOO_utf8_lc(pTHX_ const U8 classnum, const U8* character)
{
* /\d+abc/: "abc" is anchored to neither the pattern nor the string;
* /^\d+abc/: "abc" is anchored to neither the pattern nor the string,
* but the pattern is anchored to the string.
+ *
+ * Note the variables names suffixed with _c represent character counts
+ * while _b represent byte counts
*/
char *
re_scream_pos_data *data)
{
struct regexp *const prog = ReANY(rx);
- SSize_t start_shift = prog->check_offset_min;
- /* Should be nonnegative! */
- SSize_t end_shift = 0;
+
+ /* Minimum number of chars which *must* precede the check substring to
+ * be capable of matching, e.g. 2 in /[ab]cd?substring/. */
+ SSize_t check_min_offset_c = prog->check_offset_min;
+
+ /* Minimum number of chars which *must* follow the check substring to
+ * be capable of matching, e.g. 2 in /substring[ab]cd?/.
+ * Should be nonnegative! */
+
+ SSize_t check_end_shift_c = 0;
/* current lowest pos in string where the regex can start matching */
char *rx_origin = strpos;
SV *check;
goto fail;
}
- RX_MATCH_UTF8_set(rx,utf8_target);
+ RXp_MATCH_UTF8_set(prog, utf8_target);
reginfo->is_utf8_target = cBOOL(utf8_target);
reginfo->info_aux = NULL;
reginfo->strbeg = strbeg;
if (prog->check_offset_min == prog->check_offset_max) {
/* Substring at constant offset from beg-of-str... */
- SSize_t slen = SvCUR(check);
+ SSize_t slen_b = SvCUR(check);
char *s = HOP3c(strpos, prog->check_offset_min, strend);
DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
if (SvTAIL(check)) {
/* In this case, the regex is anchored at the end too.
* Unless it's a multiline match, the lengths must match
- * exactly, give or take a \n. NB: slen >= 1 since
+ * exactly, give or take a \n. NB: slen_b >= 1 since
* the last char of check is \n */
if (!multiline
- && ( strend - s > slen
- || strend - s < slen - 1
- || (strend - s == slen && strend[-1] != '\n')))
+ && ( strend - s > slen_b
+ || strend - s < slen_b - 1
+ || (strend - s == slen_b && strend[-1] != '\n')))
{
DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
" String too long...\n"));
goto fail_finish;
}
- /* Now should match s[0..slen-2] */
- slen--;
+ /* Now should match s[0..slen_b-2] */
+ slen_b--;
}
- if (slen && (strend - s < slen
+ if (slen_b && (strend - s < slen_b
|| *SvPVX_const(check) != *s
- || (slen > 1 && (memNE(SvPVX_const(check), s, slen)))))
+ || (slen_b > 1 && (memNE(SvPVX_const(check), s, slen_b)))))
{
DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
" String not equal...\n"));
}
}
- end_shift = prog->check_end_shift;
+ check_end_shift_c = prog->check_end_shift;
#ifdef DEBUGGING /* 7/99: reports of failure (with the older version) */
- if (end_shift < 0)
+ if (check_end_shift_c < 0)
Perl_croak(aTHX_ "panic: end_shift: %" IVdf " pattern:\n%s\n ",
- (IV)end_shift, RX_PRECOMP(prog));
+ (IV)check_end_shift_c, RX_PRECOMP(rx));
#endif
restart:
/* This is the (re)entry point of the main loop in this function.
* The goal of this loop is to:
* 1) find the "check" substring in the region rx_origin..strend
- * (adjusted by start_shift / end_shift). If not found, reject
+ * (adjusted by check_min_offset_c / check_end_shift_c). If not found, reject
* immediately.
* 2) If it exists, look for the "other" substr too if defined; for
* example, if the check substr maps to the anchored substr, then
" Real end Shift: %" IVdf "\n",
(IV)(rx_origin - strbeg),
(IV)prog->check_offset_min,
- (IV)start_shift,
- (IV)end_shift,
+ (IV)check_min_offset_c,
+ (IV)check_end_shift_c,
(IV)prog->check_end_shift);
});
- end_point = HOP3(strend, -end_shift, strbeg);
- start_point = HOPMAYBE3(rx_origin, start_shift, end_point);
+ end_point = HOPBACK3(strend, check_end_shift_c, rx_origin);
+ if (!end_point)
+ goto fail_finish;
+ start_point = HOPMAYBE3(rx_origin, check_min_offset_c, end_point);
if (!start_point)
goto fail_finish;
&& prog->intflags & PREGf_ANCH
&& prog->check_offset_max != SSize_t_MAX)
{
- SSize_t len = SvCUR(check) - !!SvTAIL(check);
+ SSize_t check_len_b = SvCUR(check) - !!SvTAIL(check);
const char * const anchor =
(prog->intflags & PREGf_ANCH_GPOS ? strpos : strbeg);
+ SSize_t targ_len_b = (char*)end_point - anchor;
+
+ if (check_len_b > targ_len_b) {
+ DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
+ "Anchored string too short...\n"));
+ goto fail_finish;
+ }
/* do a bytes rather than chars comparison. It's conservative;
* so it skips doing the HOP if the result can't possibly end
* up earlier than the old value of end_point.
*/
- if ((char*)end_point - anchor > prog->check_offset_max) {
+ assert(anchor + check_len_b <= (char *)end_point);
+ if (prog->check_offset_max + check_len_b < targ_len_b) {
end_point = HOP3lim((U8*)anchor,
prog->check_offset_max,
- end_point -len)
- + len;
+ end_point - check_len_b
+ )
+ + check_len_b;
}
}
: (char*)HOP3lim(rx_origin, other->max_offset, last1);
}
else {
- assert(strpos + start_shift <= check_at);
- last = HOP4c(check_at, other->min_offset - start_shift,
+ assert(strpos + check_min_offset_c <= check_at);
+ last = HOP4c(check_at, other->min_offset - check_min_offset_c,
strbeg, strend);
}
if (progi->regstclass && PL_regkind[OP(progi->regstclass)]!=TRIE) {
const U8* const str = (U8*)STRING(progi->regstclass);
- /* XXX this value could be pre-computed */
- const int cl_l = (PL_regkind[OP(progi->regstclass)] == EXACT
+ /* The length (in chars) if the character class. This is almost
+ * always 1.
+ * XXX this value could be pre-computed */
+ const int class_len_c = (PL_regkind[OP(progi->regstclass)] == EXACT
? (reginfo->is_utf8_pat
? utf8_distance(str + STR_LEN(progi->regstclass), str)
: STR_LEN(progi->regstclass))
*/
if (prog->anchored_substr || prog->anchored_utf8 || ml_anch)
- endpos= HOP3c(rx_origin, (prog->minlen ? cl_l : 0), strend);
+ endpos = HOP3clim(rx_origin,
+ (prog->minlen ? class_len_c : 0),
+ strend);
else if (prog->float_substr || prog->float_utf8) {
- rx_max_float = HOP3c(check_at, -start_shift, strbeg);
- endpos= HOP3c(rx_max_float, cl_l, strend);
+ rx_max_float = HOP3c(check_at, -check_min_offset_c, strbeg);
+ endpos = HOP3clim(rx_max_float, class_len_c, strend);
}
else
endpos= strend;
DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
- " looking for class: start_shift: %" IVdf " check_at: %" IVdf
+ " looking for class: check_min_offset: %" IVdf " check_at: %" IVdf
" rx_origin: %" IVdf " endpos: %" IVdf "\n",
- (IV)start_shift, (IV)(check_at - strbeg),
+ (IV)check_min_offset_c, (IV)(check_at - strbeg),
(IV)(rx_origin - strbeg), (IV)(endpos - strbeg)));
s = find_byclass(prog, progi->regstclass, rx_origin, endpos,
if (prog->anchored_substr || prog->anchored_utf8) {
if (prog->substrs->check_ix == 1) { /* check is float */
/* Have both, check_string is floating */
- assert(rx_origin + start_shift <= check_at);
- if (rx_origin + start_shift != check_at) {
+ assert(rx_origin + check_min_offset_c <= check_at);
+ if (rx_origin + check_min_offset_c != check_at) {
/* not at latest position float substr could match:
* Recheck anchored substring, but not floating.
* The condition above is in bytes rather than
/* uses bytes rather than char calculations for efficiency.
* It's conservative: it errs on the side of doing 'goto restart',
* where there is code that does a proper char-based test */
- if (rx_origin + start_shift + end_shift > strend) {
+ if (rx_origin + check_min_offset_c + check_end_shift_c > strend) {
DEBUG_EXECUTE_r( Perl_re_printf( aTHX_
" Could not match STCLASS...\n") );
goto fail;
DEBUG_EXECUTE_r( Perl_re_printf( aTHX_
" about to look for %s substr starting at offset %ld (rx_origin now %" IVdf ")...\n",
(prog->substrs->check_ix ? "floating" : "anchored"),
- (long)(rx_origin + start_shift - strbeg),
+ (long)(rx_origin + check_min_offset_c - strbeg),
(IV)(rx_origin - strbeg)
));
goto restart;
* trying that it will fail; so don't start a match past the
* required minimum number from the far end */
e = HOP3c(strend, -((SSize_t)ln), s);
-
- if (reginfo->intuit && e < s) {
- e = s; /* Due to minlen logic of intuit() */
- }
+ if (e < s)
+ break;
c1 = *pat_string;
c2 = fold_array[c1];
*/
e = HOP3c(strend, -((SSize_t)lnc), s);
- if (reginfo->intuit && e < s) {
- e = s; /* Due to minlen logic of intuit() */
- }
-
/* XXX Note that we could recalculate e to stop the loop earlier,
* as the worst case expansion above will rarely be met, and as we
* go along we would usually find that e moves further to the left.
}
else {
/* create new COW SV to share string */
- RX_MATCH_COPY_FREE(rx);
+ RXp_MATCH_COPY_FREE(prog);
prog->saved_copy = sv_setsv_cow(prog->saved_copy, sv);
}
prog->subbeg = (char *)SvPVX_const(prog->saved_copy);
assert(min >= 0 && min <= max && min <= strend - strbeg);
sublen = max - min;
- if (RX_MATCH_COPIED(rx)) {
+ if (RXp_MATCH_COPIED(prog)) {
if (sublen > prog->sublen)
prog->subbeg =
(char*)saferealloc(prog->subbeg, sublen+1);
prog->subbeg[sublen] = '\0';
prog->suboffset = min;
prog->sublen = sublen;
- RX_MATCH_COPIED_on(rx);
+ RXp_MATCH_COPIED_on(prog);
}
prog->subcoffset = prog->suboffset;
if (prog->suboffset && utf8_target) {
}
}
else {
- RX_MATCH_COPY_FREE(rx);
+ RXp_MATCH_COPY_FREE(prog);
prog->subbeg = strbeg;
prog->suboffset = 0;
prog->subcoffset = 0;
/* match via INTUIT shouldn't have any captures.
* Let @-, @+, $^N know */
prog->lastparen = prog->lastcloseparen = 0;
- RX_MATCH_UTF8_set(rx, utf8_target);
+ RXp_MATCH_UTF8_set(prog, utf8_target);
prog->offs[0].start = s - strbeg;
prog->offs[0].end = utf8_target
? (char*)utf8_hop((U8*)s, prog->minlenret) - strbeg
Perl_croak(aTHX_ "corrupted regexp program");
}
- RX_MATCH_TAINTED_off(rx);
- RX_MATCH_UTF8_set(rx, utf8_target);
+ RXp_MATCH_TAINTED_off(prog);
+ RXp_MATCH_UTF8_set(prog, utf8_target);
reginfo->prog = rx; /* Yes, sorry that this is confusing. */
reginfo->intuit = 0;
regprop(prog, prop, c, reginfo, NULL);
{
RE_PV_QUOTED_DECL(quoted,utf8_target,PERL_DEBUG_PAD_ZERO(1),
- s,strend-s,60);
+ s,strend-s,PL_dump_re_max_len);
Perl_re_printf( aTHX_
"Matching stclass %.*s against %s (%d bytes)\n",
(int)SvCUR(prop), SvPVX_const(prop),
reginitcolors();
{
RE_PV_QUOTED_DECL(s0, utf8_pat, PERL_DEBUG_PAD_ZERO(0),
- RX_PRECOMP_const(prog), RX_PRELEN(prog), 60);
+ RX_PRECOMP_const(prog), RX_PRELEN(prog), PL_dump_re_max_len);
RE_PV_QUOTED_DECL(s1, utf8_target, PERL_DEBUG_PAD_ZERO(1),
- start, end - start, 60);
+ start, end - start, PL_dump_re_max_len);
Perl_re_printf( aTHX_
"%s%s REx%s %s against %s\n",
const int is_uni = utf8_target ? 1 : 0;
RE_PV_COLOR_DECL(s0,len0,is_uni,PERL_DEBUG_PAD(0),
- (locinput - pref_len),pref0_len, 60, 4, 5);
+ (locinput - pref_len),pref0_len, PL_dump_re_max_len, 4, 5);
RE_PV_COLOR_DECL(s1,len1,is_uni,PERL_DEBUG_PAD(1),
(locinput - pref_len + pref0_len),
- pref_len - pref0_len, 60, 2, 3);
+ pref_len - pref0_len, PL_dump_re_max_len, 2, 3);
RE_PV_COLOR_DECL(s2,len2,is_uni,PERL_DEBUG_PAD(2),
locinput, loc_regeol - locinput, 10, 0, 1);
}
else { /* Does participate in folds */
AV* list = (AV*) *listp;
- if (av_tindex_nomg(list) != 1) {
+ if (av_tindex_skip_len_mg(list) != 1) {
/* If there aren't exactly two folds to this, it is
* outside the scope of this function */
/* Do not break within emoji flag sequences. That is, do not
* break between regional indicator (RI) symbols if there is an
* odd number of RI characters before the break point.
- * GB12 ^ (RI RI)* RI × RI
+ * GB12 sot (RI RI)* RI × RI
* GB13 [^RI] (RI RI)* RI × RI */
while (backup_one_GCB(strbeg,
* only if there are an even number of regional indicators
* preceding the position of the break.
*
- * sot (RI RI)* RI × RI
+ * sot (RI RI)* RI × RI
* [^RI] (RI RI)* RI × RI */
while (backup_one_LB(strbeg,
* odd number of RI characters before the potential break
* point.
*
- * WB15 ^ (RI RI)* RI × RI
+ * WB15 sot (RI RI)* RI × RI
* WB16 [^RI] (RI RI)* RI × RI */
while (backup_one_WB(&previous,
regnode *next;
U32 n = 0; /* general value; init to avoid compiler warning */
SSize_t ln = 0; /* len or last; init to avoid compiler warning */
+ SSize_t endref = 0; /* offset of end of backref when ln is start */
char *locinput = startpos;
char *pushinput; /* where to continue after a PUSH */
I32 nextchr; /* is always set to UCHARAT(locinput), or -1 at EOS */
SV *sv_yes_mark = NULL; /* last mark name we have seen
during a successful match */
U32 lastopen = 0; /* last open we saw */
- bool has_cutgroup = RX_HAS_CUTGROUP(rex) ? 1 : 0;
+ bool has_cutgroup = RXp_HAS_CUTGROUP(rex) ? 1 : 0;
SV* const oreplsv = GvSVn(PL_replgv);
/* these three flags are set by various ops to signal information to
* the very next op. They have a useful lifetime of exactly one loop
U8 gimme = G_SCALAR;
CV *caller_cv = NULL; /* who called us */
CV *last_pushed_cv = NULL; /* most recently called (?{}) CV */
- CHECKPOINT runops_cp; /* savestack position before executing EVAL */
U32 maxopenparen = 0; /* max '(' index seen so far */
int to_complement; /* Invert the result? */
_char_class_number classnum;
bool is_utf8_pat = reginfo->is_utf8_pat;
bool match = FALSE;
+ I32 orig_savestack_ix = PL_savestack_ix;
/* Solaris Studio 12.3 messes up fetching PL_charclass['\n'] */
#if (defined(__SUNPRO_C) && (__SUNPRO_C == 0x5120) && defined(__x86_64) && defined(USE_64_BIT_ALL))
if (scan->flags == EXACTL || scan->flags == EXACTFLU8) {
_CHECK_AND_WARN_PROBLEMATIC_LOCALE;
if (utf8_target
+ && nextchr >= 0 /* guard against negative EOS value in nextchr */
&& UTF8_IS_ABOVE_LATIN1(nextchr)
&& scan->flags == EXACTL)
{
{
U8 *uc;
if ( ST.jump ) {
+ /* undo any captures done in the tail part of a branch,
+ * e.g.
+ * /(?:X(.)(.)|Y(.)).../
+ * where the trie just matches X then calls out to do the
+ * rest of the branch */
REGCP_UNWIND(ST.cp);
UNWIND_PAREN(ST.lastparen, ST.lastcloseparen);
}
do_nref_ref_common:
ln = rex->offs[n].start;
+ endref = rex->offs[n].end;
reginfo->poscache_iter = reginfo->poscache_maxiter; /* Void cache */
- if (rex->lastparen < n || ln == -1)
+ if (rex->lastparen < n || ln == -1 || endref == -1)
sayNO; /* Do not match unless seen CLOSEn. */
- if (ln == rex->offs[n].end)
+ if (ln == endref)
break;
s = reginfo->strbeg + ln;
* not going off the end given by reginfo->strend, and
* returns in <limit> upon success, how much of the
* current input was matched */
- if (! foldEQ_utf8_flags(s, NULL, rex->offs[n].end - ln, utf8_target,
+ if (! foldEQ_utf8_flags(s, NULL, endref - ln, utf8_target,
locinput, &limit, 0, utf8_target, utf8_fold_flags))
{
sayNO;
(type == REF ||
UCHARAT(s) != fold_array[nextchr]))
sayNO;
- ln = rex->offs[n].end - ln;
+ ln = endref - ln;
if (locinput + ln > reginfo->strend)
sayNO;
if (ln > 1 && (type == REF
goto eval_recurse_doit;
/* NOTREACHED */
- case EVAL: /* /(?{A})B/ /(??{A})B/ and /(?(?{A})X|Y)B/ */
+ case EVAL: /* /(?{...})B/ /(??{A})B/ and /(?(?{...})X|Y)B/ */
if (cur_eval && cur_eval->locinput==locinput) {
if ( ++nochange_depth > max_nochange_depth )
Perl_croak(aTHX_ "EVAL without pos change exceeded limit in regex");
/* save *all* paren positions */
regcppush(rex, 0, maxopenparen);
- REGCP_SET(runops_cp);
+ REGCP_SET(ST.lastcp);
if (!caller_cv)
caller_cv = find_runcv(NULL);
nop = (OP*)rexi->data->data[n];
}
- /* normally if we're about to execute code from the same
- * CV that we used previously, we just use the existing
- * CX stack entry. However, its possible that in the
- * meantime we may have backtracked, popped from the save
- * stack, and undone the SAVECOMPPAD(s) associated with
- * PUSH_MULTICALL; in which case PL_comppad no longer
- * points to newcv's pad. */
+ /* Some notes about MULTICALL and the context and save stacks.
+ *
+ * In something like
+ * /...(?{ my $x)}...(?{ my $y)}...(?{ my $z)}.../
+ * since codeblocks don't introduce a new scope (so that
+ * local() etc accumulate), at the end of a successful
+ * match there will be a SAVEt_CLEARSV on the savestack
+ * for each of $x, $y, $z. If the three code blocks above
+ * happen to have come from different CVs (e.g. via
+ * embedded qr//s), then we must ensure that during any
+ * savestack unwinding, PL_comppad always points to the
+ * right pad at each moment. We achieve this by
+ * interleaving SAVEt_COMPPAD's on the savestack whenever
+ * there is a change of pad.
+ * In theory whenever we call a code block, we should
+ * push a CXt_SUB context, then pop it on return from
+ * that code block. This causes a bit of an issue in that
+ * normally popping a context also clears the savestack
+ * back to cx->blk_oldsaveix, but here we specifically
+ * don't want to clear the save stack on exit from the
+ * code block.
+ * Also for efficiency we don't want to keep pushing and
+ * popping the single SUB context as we backtrack etc.
+ * So instead, we push a single context the first time
+ * we need, it, then hang onto it until the end of this
+ * function. Whenever we encounter a new code block, we
+ * update the CV etc if that's changed. During the times
+ * in this function where we're not executing a code
+ * block, having the SUB context still there is a bit
+ * naughty - but we hope that no-one notices.
+ * When the SUB context is initially pushed, we fake up
+ * cx->blk_oldsaveix to be as if we'd pushed this context
+ * on first entry to S_regmatch rather than at some random
+ * point during the regexe execution. That way if we
+ * croak, popping the context stack will ensure that
+ * *everything* SAVEd by this function is undone and then
+ * the context popped, rather than e.g., popping the
+ * context (and restoring the original PL_comppad) then
+ * popping more of the savestack and restoring a bad
+ * PL_comppad.
+ */
+
+ /* If this is the first EVAL, push a MULTICALL. On
+ * subsequent calls, if we're executing a different CV, or
+ * if PL_comppad has got messed up from backtracking
+ * through SAVECOMPPADs, then refresh the context.
+ */
if (newcv != last_pushed_cv || PL_comppad != last_pad)
{
U8 flags = (CXp_SUB_RE |
((newcv == caller_cv) ? CXp_SUB_RE_FAKE : 0));
+ SAVECOMPPAD();
if (last_pushed_cv) {
- /* PUSH/POP_MULTICALL save and restore the
- * caller's PL_comppad; if we call multiple subs
- * using the same CX block, we have to save and
- * unwind the varying PL_comppad's ourselves,
- * especially restoring the right PL_comppad on
- * backtrack - so save it on the save stack */
- SAVECOMPPAD();
CHANGE_MULTICALL_FLAGS(newcv, flags);
}
else {
PUSH_MULTICALL_FLAGS(newcv, flags);
}
+ /* see notes above */
+ CX_CUR()->blk_oldsaveix = orig_savestack_ix;
+
last_pushed_cv = newcv;
}
else {
if (logical == 0) /* (?{})/ */
sv_setsv(save_scalar(PL_replgv), ret); /* $^R */
else if (logical == 1) { /* /(?(?{...})X|Y)/ */
- sw = cBOOL(SvTRUE(ret));
+ sw = cBOOL(SvTRUE_NN(ret));
logical = 0;
}
else { /* /(??{}) */
* in the regexp code uses the pad ! */
PL_op = oop;
PL_curcop = ocurcop;
- regcp_restore(rex, runops_cp, &maxopenparen);
+ regcp_restore(rex, ST.lastcp, &maxopenparen);
PL_curpm_under = PL_curpm;
PL_curpm = PL_reg_curpm;
- if (logical != 2)
- break;
+ if (logical != 2) {
+ PUSH_STATE_GOTO(EVAL_B, next, locinput);
+ /* NOTREACHED */
+ }
}
/* only /(??{})/ from now on */
ST.prev_eval = cur_eval;
cur_eval = st;
/* now continue from first node in postoned RE */
- PUSH_YES_STATE_GOTO(EVAL_AB, startpoint, locinput);
+ PUSH_YES_STATE_GOTO(EVAL_postponed_AB, startpoint, locinput);
NOT_REACHED; /* NOTREACHED */
}
- case EVAL_AB: /* cleanup after a successful (??{A})B */
+ case EVAL_postponed_AB: /* cleanup after a successful (??{A})B */
/* note: this is called twice; first after popping B, then A */
DEBUG_STACK_r({
Perl_re_exec_indentf( aTHX_ "EVAL_AB cur_eval=%p prev_eval=%p\n",
sayYES;
- case EVAL_AB_fail: /* unsuccessfully ran A or B in (??{A})B */
+ case EVAL_B_fail: /* unsuccessful B in (?{...})B */
+ REGCP_UNWIND(ST.lastcp);
+ sayNO;
+
+ case EVAL_postponed_AB_fail: /* unsuccessfully ran A or B in (??{A})B */
/* note: this is called twice; first after popping B, then A */
DEBUG_STACK_r({
Perl_re_exec_indentf( aTHX_ "EVAL_AB_fail cur_eval=%p prev_eval=%p\n",
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);
- REGCP_SET(ST.lastcp);
PUSH_YES_STATE_GOTO(WHILEM_B_min, ST.save_curlyx->u.curlyx.B,
locinput);
NOT_REACHED; /* NOTREACHED */
CACHEsayNO;
NOT_REACHED; /* NOTREACHED */
- case WHILEM_A_min_fail: /* just failed to match A in a minimal match */
- /* FALLTHROUGH */
case WHILEM_A_pre_fail: /* just failed to match even minimal A */
REGCP_UNWIND(ST.lastcp);
regcppop(rex, &maxopenparen);
+ /* FALLTHROUGH */
+ case WHILEM_A_min_fail: /* just failed to match A in a minimal match */
cur_curlyx->u.curlyx.lastloc = ST.save_lastloc;
cur_curlyx->u.curlyx.count--;
CACHEsayNO;
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);
if (cur_curlyx->u.curlyx.count >= /*max*/ARG2(cur_curlyx->u.curlyx.me)) {
/* Maximum greed exceeded */
);
/* 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);
- REGCP_SET(ST.lastcp);
PUSH_STATE_GOTO(WHILEM_A_min,
/*A*/ NEXTOPER(ST.save_curlyx->u.curlyx.me) + EXTRA_STEP_2ARGS,
locinput);
SET_RECURSE_LOCINPUT("FAKE-END[after]", cur_eval->locinput);
- PUSH_YES_STATE_GOTO(EVAL_AB, st->u.eval.prev_eval->u.eval.B,
+ PUSH_YES_STATE_GOTO(EVAL_postponed_AB, st->u.eval.prev_eval->u.eval.B,
locinput); /* match B */
}
assert(!NEXTCHR_IS_EOS);
if (utf8_target) {
locinput += PL_utf8skip[nextchr];
- /* locinput is allowed to go 1 char off the end, but not 2+ */
+ /* locinput is allowed to go 1 char off the end (signifying
+ * EOS), but not 2+ */
if (locinput > reginfo->strend)
sayNO;
}
DEBUG_STACK_r({
regmatch_state *cur = st;
regmatch_state *curyes = yes_state;
- int curd = depth;
+ U32 i;
regmatch_slab *slab = PL_regmatch_slab;
- for (;curd > -1 && (depth-curd < 3);cur--,curd--) {
+ for (i = 0; i < 3 && i <= depth; cur--,i++) {
if (cur < SLAB_FIRST(slab)) {
slab = slab->prev;
cur = SLAB_LAST(slab);
}
- Perl_re_exec_indentf( aTHX_ "#%-3d %-10s %s\n",
+ Perl_re_exec_indentf( aTHX_ "%4s #%-3d %-10s %s\n",
depth,
- curd, PL_reg_name[cur->resume_state],
+ i ? " " : "push",
+ depth - i, PL_reg_name[cur->resume_state],
(curyes == cur) ? "yes" : ""
);
if (curyes == cur)
if (last_pushed_cv) {
dSP;
+ /* see "Some notes about MULTICALL" above */
POP_MULTICALL;
PERL_UNUSED_VAR(SP);
}
+ else
+ LEAVE_SCOPE(orig_savestack_ix);
assert(!result || locinput - reginfo->strbeg >= 0);
return result ? locinput - reginfo->strbeg : -1;
return TRUE;
}
+#ifndef PERL_IN_XSUB_RE
+
bool
Perl__is_grapheme(pTHX_ const U8 * strbeg, const U8 * s, const U8 * strend, const UV cp)
{
return isGCB(cp_gcb_val, next_cp_gcb_val, strbeg, s, TRUE);
}
+#endif
https://perl5.git.perl.org / perl5.git / blobdiff