* 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 _pDEPTH)
{
const int retval = PL_savestack_ix;
const int paren_elems_to_push =
(int)parenfloor, (unsigned)REGCP_PAREN_ELEMS);
if ((elems_shifted >> SAVE_TIGHT_SHIFT) != total_elems)
- Perl_croak(aTHX_ "panic: paren_elems_to_push offset %"UVuf
+ Perl_croak(aTHX_ "panic: paren_elems_to_push offset %" UVuf
" out of range (%lu-%ld)",
total_elems,
(unsigned long)maxopenparen,
DEBUG_BUFFERS_r(
if ((int)maxopenparen > (int)parenfloor)
- Perl_re_printf( aTHX_
- "rex=0x%"UVxf" offs=0x%"UVxf": saving capture indices:\n",
- PTR2UV(rex),
+ Perl_re_exec_indentf( aTHX_
+ "rex=0x%" UVxf " offs=0x%" UVxf ": saving capture indices:\n",
+ depth,
+ PTR2UV(rex),
PTR2UV(rex->offs)
);
);
SSPUSHIV(rex->offs[p].end);
SSPUSHIV(rex->offs[p].start);
SSPUSHINT(rex->offs[p].start_tmp);
- DEBUG_BUFFERS_r(Perl_re_printf( aTHX_
- " \\%"UVuf": %"IVdf"(%"IVdf")..%"IVdf"\n",
- (UV)p,
+ DEBUG_BUFFERS_r(Perl_re_exec_indentf( aTHX_
+ " \\%" UVuf ": %" IVdf "(%" IVdf ")..%" IVdf "\n",
+ depth,
+ (UV)p,
(IV)rex->offs[p].start,
(IV)rex->offs[p].start_tmp,
(IV)rex->offs[p].end
/* These are needed since we do not localize EVAL nodes: */
#define REGCP_SET(cp) \
DEBUG_STATE_r( \
- Perl_re_exec_indentf( aTHX_ \
- "Setting an EVAL scope, savestack=%"IVdf",\n", \
+ Perl_re_exec_indentf( aTHX_ \
+ "Setting an EVAL scope, savestack=%" IVdf ",\n", \
depth, (IV)PL_savestack_ix \
) \
); \
#define REGCP_UNWIND(cp) \
DEBUG_STATE_r( \
if (cp != PL_savestack_ix) \
- Perl_re_exec_indentf( aTHX_ \
- "Clearing an EVAL scope, savestack=%"IVdf"..%"IVdf"\n",\
+ Perl_re_exec_indentf( aTHX_ \
+ "Clearing an EVAL scope, savestack=%" \
+ IVdf "..%" IVdf "\n", \
depth, (IV)(cp), (IV)PL_savestack_ix \
) \
); \
STATIC void
-S_regcppop(pTHX_ regexp *rex, U32 *maxopenparen_p)
+S_regcppop(pTHX_ regexp *rex, U32 *maxopenparen_p _pDEPTH)
{
UV i;
U32 paren;
/* Now restore the parentheses context. */
DEBUG_BUFFERS_r(
if (i || rex->lastparen + 1 <= rex->nparens)
- Perl_re_printf( aTHX_
- "rex=0x%"UVxf" offs=0x%"UVxf": restoring capture indices to:\n",
- PTR2UV(rex),
+ Perl_re_exec_indentf( aTHX_
+ "rex=0x%" UVxf " offs=0x%" UVxf ": restoring capture indices to:\n",
+ depth,
+ PTR2UV(rex),
PTR2UV(rex->offs)
);
);
tmps = SSPOPIV;
if (paren <= rex->lastparen)
rex->offs[paren].end = tmps;
- DEBUG_BUFFERS_r( Perl_re_printf( aTHX_
- " \\%"UVuf": %"IVdf"(%"IVdf")..%"IVdf"%s\n",
- (UV)paren,
+ DEBUG_BUFFERS_r( Perl_re_exec_indentf( aTHX_
+ " \\%" UVuf ": %" IVdf "(%" IVdf ")..%" IVdf "%s\n",
+ depth,
+ (UV)paren,
(IV)rex->offs[paren].start,
(IV)rex->offs[paren].start_tmp,
(IV)rex->offs[paren].end,
if (i > *maxopenparen_p)
rex->offs[i].start = -1;
rex->offs[i].end = -1;
- DEBUG_BUFFERS_r( Perl_re_printf( aTHX_
- " \\%"UVuf": %s ..-1 undeffing\n",
- (UV)i,
+ DEBUG_BUFFERS_r( Perl_re_exec_indentf( aTHX_
+ " \\%" UVuf ": %s ..-1 undeffing\n",
+ depth,
+ (UV)i,
(i > *maxopenparen_p) ? "-1" : " "
));
}
* 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 _pDEPTH)
{
I32 tmpix = PL_savestack_ix;
+ PERL_ARGS_ASSERT_REGCP_RESTORE;
+
PL_savestack_ix = ix;
regcppop(rex, maxopenparen_p);
PL_savestack_ix = tmpix;
continue;
Perl_re_printf( aTHX_
- " substrs[%d]: min=%"IVdf" max=%"IVdf" end shift=%"IVdf
- " useful=%"IVdf" utf8=%d [%s]\n",
+ " substrs[%d]: min=%" IVdf " max=%" IVdf " end shift=%" IVdf
+ " useful=%" IVdf " utf8=%d [%s]\n",
i,
(IV)prog->substrs->data[i].min_offset,
(IV)prog->substrs->data[i].max_offset,
char *s = HOP3c(strpos, prog->check_offset_min, strend);
DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
- " Looking for check substr at fixed offset %"IVdf"...\n",
+ " Looking for check substr at fixed offset %" IVdf "...\n",
(IV)prog->check_offset_min));
if (SvTAIL(check)) {
/* Now should match s[0..slen-2] */
slen--;
}
- if (slen && (*SvPVX_const(check) != *s
- || (slen > 1 && memNE(SvPVX_const(check), s, slen))))
+ if (slen && (strend - s < slen
+ || *SvPVX_const(check) != *s
+ || (slen > 1 && (memNE(SvPVX_const(check), s, slen)))))
{
DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
" String not equal...\n"));
#ifdef DEBUGGING /* 7/99: reports of failure (with the older version) */
if (end_shift < 0)
- Perl_croak(aTHX_ "panic: end_shift: %"IVdf" pattern:\n%s\n ",
+ Perl_croak(aTHX_ "panic: end_shift: %" IVdf " pattern:\n%s\n ",
(IV)end_shift, RX_PRECOMP(prog));
#endif
DEBUG_OPTIMISE_MORE_r({
Perl_re_printf( aTHX_
- " At restart: rx_origin=%"IVdf" Check offset min: %"IVdf
- " Start shift: %"IVdf" End shift %"IVdf
- " Real end Shift: %"IVdf"\n",
+ " At restart: rx_origin=%" IVdf " Check offset min: %" IVdf
+ " Start shift: %" IVdf " End shift %" IVdf
+ " Real end Shift: %" IVdf "\n",
(IV)(rx_origin - strbeg),
(IV)prog->check_offset_min,
(IV)start_shift,
check, multiline ? FBMrf_MULTILINE : 0);
DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
- " doing 'check' fbm scan, [%"IVdf"..%"IVdf"] gave %"IVdf"\n",
+ " doing 'check' fbm scan, [%" IVdf "..%" IVdf "] gave %" IVdf "\n",
(IV)((char*)start_point - strbeg),
(IV)((char*)end_point - strbeg),
(IV)(check_at ? check_at - strbeg : -1)
rx_origin = HOP3c(check_at, -prog->check_offset_max, rx_origin);
/* Finish the diagnostic message */
DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
- "%ld (rx_origin now %"IVdf")...\n",
+ "%ld (rx_origin now %" IVdf ")...\n",
(long)(check_at - strbeg),
(IV)(rx_origin - strbeg)
));
if (from > to) {
s = NULL;
DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
- " skipping 'other' fbm scan: %"IVdf" > %"IVdf"\n",
+ " skipping 'other' fbm scan: %" IVdf " > %" IVdf "\n",
(IV)(from - strbeg),
(IV)(to - strbeg)
));
multiline ? FBMrf_MULTILINE : 0
);
DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
- " doing 'other' fbm scan, [%"IVdf"..%"IVdf"] gave %"IVdf"\n",
+ " doing 'other' fbm scan, [%" IVdf "..%" IVdf "] gave %" IVdf "\n",
(IV)(from - strbeg),
(IV)(to - strbeg),
(IV)(s ? s - strbeg : -1)
? HOP3c(rx_origin, 1, strend)
: HOP4c(last, 1 - other->min_offset, strbeg, strend);
DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
- "; about to retry %s at offset %ld (rx_origin now %"IVdf")...\n",
+ "; about to retry %s at offset %ld (rx_origin now %" IVdf ")...\n",
(other_ix ? "floating" : "anchored"),
(long)(HOP3c(check_at, 1, strend) - strbeg),
(IV)(rx_origin - strbeg)
other_last = HOP3c(s, 1, strend);
}
DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
- " at offset %ld (rx_origin now %"IVdf")...\n",
+ " at offset %ld (rx_origin now %" IVdf ")...\n",
(long)(s - strbeg),
(IV)(rx_origin - strbeg)
));
else {
DEBUG_OPTIMISE_MORE_r(
Perl_re_printf( aTHX_
- " Check-only match: offset min:%"IVdf" max:%"IVdf
- " check_at:%"IVdf" rx_origin:%"IVdf" rx_origin-check_at:%"IVdf
- " strend:%"IVdf"\n",
+ " Check-only match: offset min:%" IVdf " max:%" IVdf
+ " check_at:%" IVdf " rx_origin:%" IVdf " rx_origin-check_at:%" IVdf
+ " strend:%" IVdf "\n",
(IV)prog->check_offset_min,
(IV)prog->check_offset_max,
(IV)(check_at-strbeg),
* didn't contradict, so just retry the anchored "other"
* substr */
DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
- " Found /%s^%s/m, rescanning for anchored from offset %"IVdf" (rx_origin now %"IVdf")...\n",
+ " Found /%s^%s/m, rescanning for anchored from offset %" IVdf " (rx_origin now %" IVdf ")...\n",
PL_colors[0], PL_colors[1],
(IV)(rx_origin - strbeg + prog->anchored_offset),
(IV)(rx_origin - strbeg)
endpos= strend;
DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
- " looking for class: start_shift: %"IVdf" check_at: %"IVdf
- " rx_origin: %"IVdf" endpos: %"IVdf"\n",
+ " looking for class: start_shift: %" IVdf " check_at: %" IVdf
+ " rx_origin: %" IVdf " endpos: %" IVdf "\n",
(IV)start_shift, (IV)(check_at - strbeg),
(IV)(rx_origin - strbeg), (IV)(endpos - strbeg)));
* practice the extra fbm_instr() is likely to
* get skipped anyway. */
DEBUG_EXECUTE_r( Perl_re_printf( aTHX_
- " about to retry anchored at offset %ld (rx_origin now %"IVdf")...\n",
+ " about to retry anchored at offset %ld (rx_origin now %" IVdf ")...\n",
(long)(other_last - strbeg),
(IV)(rx_origin - strbeg)
));
goto fail;
}
DEBUG_EXECUTE_r( Perl_re_printf( aTHX_
- " about to look for %s substr starting at offset %ld (rx_origin now %"IVdf")...\n",
+ " 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),
(IV)(rx_origin - strbeg)
REXEC_FBC_UTF8_CLASS_SCAN(
reginclass(prog, c, (U8*)s, (U8*) strend, utf8_target));
}
+ else if (ANYOF_FLAGS(c)) {
+ REXEC_FBC_CLASS_SCAN(reginclass(prog,c, (U8*)s, (U8*)s+1, 0));
+ }
else {
- REXEC_FBC_CLASS_SCAN(REGINCLASS(prog, c, (U8*)s, 0));
+ REXEC_FBC_CLASS_SCAN(ANYOF_BITMAP_TEST(c, *((U8*)s)));
}
break;
dump_exec_pos( (char *)uc, c, strend,
real_start, s, utf8_target, 0);
Perl_re_printf( aTHX_
- " Charid:%3u CP:%4"UVxf" ",
+ " Charid:%3u CP:%4" UVxf " ",
charid, uvc);
});
}
dump_exec_pos( (char *)uc, c, strend, real_start,
s, utf8_target, 0 );
Perl_re_printf( aTHX_
- "%sState: %4"UVxf", word=%"UVxf,
+ "%sState: %4" UVxf ", word=%" UVxf,
failed ? " Fail transition to " : "",
(UV)state, (UV)word);
});
if (leftmost) {
s = (char*)leftmost;
DEBUG_TRIE_EXECUTE_r({
- Perl_re_printf( aTHX_ "Matches word #%"UVxf" at position %"IVdf". Trying full pattern...\n",
+ Perl_re_printf( aTHX_ "Matches word #%" UVxf " at position %" IVdf ". Trying full pattern...\n",
(UV)accepted_word, (IV)(s - real_start)
);
});
: strbeg; /* pos() not defined; use start of string */
DEBUG_GPOS_r(Perl_re_printf( aTHX_
- "GPOS ganch set to strbeg[%"IVdf"]\n", (IV)(reginfo->ganch - strbeg)));
+ "GPOS ganch set to strbeg[%" IVdf "]\n", (IV)(reginfo->ganch - strbeg)));
/* in the presence of \G, we may need to start looking earlier in
* the string than the suggested start point of stringarg:
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_
- "rex=0x%"UVxf" saving offs: orig=0x%"UVxf" new=0x%"UVxf"\n",
- PTR2UV(prog),
+ DEBUG_BUFFERS_r(Perl_re_exec_indentf( aTHX_
+ "rex=0x%" UVxf " saving offs: orig=0x%" UVxf " new=0x%" UVxf "\n",
+ 0,
+ PTR2UV(prog),
PTR2UV(swap),
PTR2UV(prog->offs)
));
DEBUG_BUFFERS_r(
if (swap)
- Perl_re_printf( aTHX_
- "rex=0x%"UVxf" freeing offs: 0x%"UVxf"\n",
- PTR2UV(prog),
+ Perl_re_exec_indentf( aTHX_
+ "rex=0x%" UVxf " freeing offs: 0x%" UVxf "\n",
+ 0,
+ PTR2UV(prog),
PTR2UV(swap)
);
);
if (swap) {
/* we failed :-( roll it back */
- DEBUG_BUFFERS_r(Perl_re_printf( aTHX_
- "rex=0x%"UVxf" rolling back offs: freeing=0x%"UVxf" restoring=0x%"UVxf"\n",
- PTR2UV(prog),
+ DEBUG_BUFFERS_r(Perl_re_exec_indentf( aTHX_
+ "rex=0x%" UVxf " rolling back offs: freeing=0x%" UVxf " restoring=0x%" UVxf "\n",
+ 0,
+ PTR2UV(prog),
PTR2UV(prog->offs),
PTR2UV(swap)
));
* 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;
PerlIO *f= Perl_debug_log;
PERL_ARGS_ASSERT_RE_EXEC_INDENTF;
va_start(ap, depth);
- PerlIO_printf(f, "%*s|%4"UVuf"| %*s", REPORT_CODE_OFF, "", (UV)depth, INDENT_CHARS(depth), "" );
+ PerlIO_printf(f, "%*s|%4" UVuf "| %*s", REPORT_CODE_OFF, "", (UV)depth, INDENT_CHARS(depth), "" );
result = PerlIO_vprintf(f, fmt, ap);
va_end(ap);
return result;
STATIC regmatch_state *
S_push_slab(pTHX)
{
-#if PERL_VERSION < 9 && !defined(PERL_CORE)
- dMY_CXT;
-#endif
regmatch_slab *s = PL_regmatch_slab->next;
if (!s) {
Newx(s, 1, regmatch_slab);
const STRLEN tlen=len0+len1+len2;
Perl_re_printf( aTHX_
- "%4"IVdf" <%.*s%.*s%s%.*s>%*s|%4u| ",
+ "%4" IVdf " <%.*s%.*s%s%.*s>%*s|%4u| ",
(IV)(locinput - loc_bostr),
len0, s0,
len1, s1,
STATIC SSize_t
S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
{
-
-#if PERL_VERSION < 9 && !defined(PERL_CORE)
- dMY_CXT;
-#endif
dVAR;
const bool utf8_target = reginfo->is_utf8_target;
const U32 uniflags = UTF8_ALLOW_DEFAULT;
I32 nextchr; /* is always set to UCHARAT(locinput), or -1 at EOS */
bool result = 0; /* return value of S_regmatch */
- int depth = 0; /* depth of backtrack stack */
+ U32 depth = 0; /* depth of backtrack stack */
U32 nochange_depth = 0; /* depth of GOSUB recursion with nochange */
const U32 max_nochange_depth =
(3 * rex->nparens > MAX_RECURSE_EVAL_NOCHANGE_DEPTH) ?
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) {
DUMP_EXEC_POS( locinput, scan, utf8_target, depth );
regprop(rex, prop, scan, reginfo, NULL);
Perl_re_printf( aTHX_
- "%*s%"IVdf":%s(%"IVdf")\n",
+ "%*s%" IVdf ":%s(%" IVdf ")\n",
INDENT_CHARS(depth), "",
(IV)(scan - rexi->program),
SvPVX_const(prop),
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( Perl_debug_log,
+ "%*s%sState: %4" UVxf " Accepted: %c ",
+ INDENT_CHARS(depth), "", PL_colors[4],
(UV)state, (accepted ? 'Y' : 'N'));
});
}
DEBUG_TRIE_EXECUTE_r(
Perl_re_printf( aTHX_
- "Charid:%3x CP:%4"UVxf" After State: %4"UVxf"%s\n",
+ "Charid:%3x CP:%4" UVxf " After State: %4" UVxf "%s\n",
charid, uvc, (UV)state, PL_colors[5] );
);
}
}
DEBUG_EXECUTE_r(
- Perl_re_exec_indentf( aTHX_ "%sgot %"IVdf" possible matches%s\n",
+ Perl_re_exec_indentf( aTHX_ "%sgot %" IVdf " possible matches%s\n",
depth,
PL_colors[4], (IV)ST.accepted, PL_colors[5] );
);
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);
}
no_final = 0;
}
- if ( ST.jump) {
+ if ( ST.jump ) {
ST.lastparen = rex->lastparen;
ST.lastcloseparen = rex->lastcloseparen;
REGCP_SET(ST.cp);
);
});
- 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 */
}
CV *newcv;
/* save *all* paren positions */
- regcppush(rex, 0, maxopenparen);
+ regcppush(rex, 0, maxopenparen);
REGCP_SET(runops_cp);
if (!caller_cv)
nop = nop->op_next;
DEBUG_STATE_r( Perl_re_printf( aTHX_
- " re EVAL PL_op=0x%"UVxf"\n", PTR2UV(nop)) );
+ " re EVAL PL_op=0x%" UVxf "\n", PTR2UV(nop)) );
rex->offs[0].end = locinput - reginfo->strbeg;
if (reginfo->info_aux_eval->pos_magic)
* in the regexp code uses the pad ! */
PL_op = oop;
PL_curcop = ocurcop;
- S_regcp_restore(aTHX_ rex, runops_cp, &maxopenparen);
- PL_curpm = PL_reg_curpm;
+ regcp_restore(rex, runops_cp, &maxopenparen);
+ PL_curpm_under = PL_curpm;
+ PL_curpm = PL_reg_curpm;
if (logical != 2)
break;
rexi = RXi_GET(rex);
REGCP_UNWIND(ST.lastcp);
- regcppop(rex, &maxopenparen);
+ regcppop(rex, &maxopenparen);
cur_eval = ST.prev_eval;
cur_curlyx = ST.prev_curlyx;
rex->offs[n].start_tmp = locinput - reginfo->strbeg;
if (n > maxopenparen)
maxopenparen = n;
- DEBUG_BUFFERS_r(Perl_re_printf( aTHX_
- "rex=0x%"UVxf" offs=0x%"UVxf": \\%"UVuf": set %"IVdf" tmp; maxopenparen=%"UVuf"\n",
+ 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,
#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_ \
- "rex=0x%"UVxf" offs=0x%"UVxf": \\%"UVuf": set %"IVdf"..%"IVdf"\n", \
+ 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, \
/* First just match a string of min A's. */
if (n < min) {
- ST.cp = regcppush(rex, cur_curlyx->u.curlyx.parenfloor,
- maxopenparen);
+ ST.cp = regcppush(rex, cur_curlyx->u.curlyx.parenfloor, maxopenparen);
cur_curlyx->u.curlyx.lastloc = locinput;
REGCP_SET(ST.lastcp);
DEBUG_EXECUTE_r( Perl_re_exec_indentf( aTHX_ "whilem: (cache) already tried at this position...\n",
depth)
);
+ cur_curlyx->u.curlyx.count--;
sayNO; /* cache records failure */
}
ST.cache_offset = offset;
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,
+ 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,
/* Prefer A over B for maximal matching. */
if (n < max) { /* More greed allowed? */
- ST.cp = regcppush(rex, cur_curlyx->u.curlyx.parenfloor,
+ ST.cp = regcppush(rex, cur_curlyx->u.curlyx.parenfloor,
maxopenparen);
cur_curlyx->u.curlyx.lastloc = locinput;
REGCP_SET(ST.lastcp);
/* FALLTHROUGH */
case WHILEM_A_pre_fail: /* just failed to match even minimal A */
REGCP_UNWIND(ST.lastcp);
- regcppop(rex, &maxopenparen);
+ regcppop(rex, &maxopenparen);
cur_curlyx->u.curlyx.lastloc = ST.save_lastloc;
cur_curlyx->u.curlyx.count--;
CACHEsayNO;
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? */
+ regcppop(rex, &maxopenparen); /* Restore some previous $<digit>s? */
DEBUG_EXECUTE_r(Perl_re_exec_indentf( aTHX_ "whilem: failed, trying continuation...\n",
depth)
);
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);
+ 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,
+ ST.cp = regcppush(rex, cur_curlyx->u.curlyx.parenfloor,
maxopenparen);
REGCP_SET(ST.lastcp);
PUSH_STATE_GOTO(WHILEM_A_min,
ST.count = ST.minmod ? ARG1(ST.me) : ARG2(ST.me);
}
DEBUG_EXECUTE_r(
- Perl_re_exec_indentf( aTHX_ "CURLYM now matched %"IVdf" times, len=%"IVdf"...\n",
+ Perl_re_exec_indentf( aTHX_ "CURLYM now matched %" IVdf " times, len=%" IVdf "...\n",
depth, (IV) ST.count, (IV)ST.alen)
);
}
DEBUG_EXECUTE_r(
- Perl_re_exec_indentf( aTHX_ "CURLYM trying tail with matches=%"IVdf"...\n",
+ Perl_re_exec_indentf( aTHX_ "CURLYM trying tail with matches=%" IVdf "...\n",
depth, (IV)ST.count)
);
if (! NEXTCHR_IS_EOS && ST.c1 != CHRTEST_VOID) {
{
/* simulate B failing */
DEBUG_OPTIMISE_r(
- Perl_re_exec_indentf( aTHX_ "CURLYM Fast bail next target=0x%"UVXf" c1=0x%"UVXf" c2=0x%"UVXf"\n",
+ Perl_re_exec_indentf( aTHX_ "CURLYM Fast bail next target=0x%" UVXf " c1=0x%" UVXf " c2=0x%" UVXf "\n",
depth,
valid_utf8_to_uvchr((U8 *) locinput, NULL),
valid_utf8_to_uvchr(ST.c1_utf8, NULL),
char *li = locinput;
minmod = 0;
if (ST.min &&
- regrepeat(rex, &li, ST.A, reginfo, ST.min, depth)
+ regrepeat(rex, &li, ST.A, reginfo, ST.min)
< ST.min)
sayNO;
SET_locinput(li);
/* avoid taking address of locinput, so it can remain
* a register var */
char *li = locinput;
- ST.count = regrepeat(rex, &li, ST.A, reginfo, ST.max, depth);
+ ST.count = regrepeat(rex, &li, ST.A, reginfo, ST.max);
if (ST.count < ST.min)
sayNO;
SET_locinput(li);
* locinput matches */
char *li = ST.oldloc;
ST.count += n;
- if (regrepeat(rex, &li, ST.A, reginfo, n, depth) < n)
+ if (regrepeat(rex, &li, ST.A, reginfo, n) < n)
sayNO;
assert(n == REG_INFTY || locinput == li);
}
/* failed -- move forward one */
{
char *li = locinput;
- if (!regrepeat(rex, &li, ST.A, reginfo, 1, depth)) {
+ if (!regrepeat(rex, &li, ST.A, reginfo, 1)) {
sayNO;
}
locinput = li;
st->u.eval.prev_rex = rex_sv; /* inner */
/* Save *all* the positions. */
- st->u.eval.cp = regcppush(rex, 0, maxopenparen);
+ st->u.eval.cp = regcppush(rex, 0, maxopenparen);
rex_sv = CUR_EVAL.prev_rex;
is_utf8_pat = reginfo->is_utf8_pat = cBOOL(RX_UTF8(rex_sv));
SET_reg_curpm(rex_sv);
/* Restore parens of the outer rex without popping the
* savestack */
- S_regcp_restore(aTHX_ rex, CUR_EVAL.lastcp,
- &maxopenparen);
+ regcp_restore(rex, CUR_EVAL.lastcp, &maxopenparen);
st->u.eval.prev_eval = cur_eval;
cur_eval = CUR_EVAL.prev_eval;
sv_commit = ST.mark_name;
DEBUG_EXECUTE_r({
- Perl_re_exec_indentf( aTHX_ "%ssetting cutpoint to mark:%"SVf"...%s\n",
+ Perl_re_exec_indentf( aTHX_ "%ssetting cutpoint to mark:%" SVf "...%s\n",
depth,
PL_colors[4], SVfARG(sv_commit), PL_colors[5]);
});
break;
default:
- PerlIO_printf(Perl_error_log, "%"UVxf" %d\n",
+ PerlIO_printf(Perl_error_log, "%" UVxf " %d\n",
PTR2UV(scan), OP(scan));
Perl_croak(aTHX_ "regexp memory corruption");
*/
STATIC I32
S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p,
- regmatch_info *const reginfo, I32 max, int depth)
+ regmatch_info *const reginfo, I32 max _pDEPTH)
{
char *scan; /* Pointer to current position in target string */
I32 c;
unsigned int to_complement = 0; /* Invert the result? */
UV utf8_flags;
_char_class_number classnum;
-#ifndef DEBUGGING
- PERL_UNUSED_ARG(depth);
-#endif
PERL_ARGS_ASSERT_REGREPEAT;
scan += UTF8SKIP(scan);
hardcount++;
}
- } else {
- while (scan < loceol && REGINCLASS(prog, p, (U8*)scan, 0))
+ }
+ else if (ANYOF_FLAGS(p)) {
+ while (scan < loceol
+ && reginclass(prog, p, (U8*)scan, (U8*)scan+1, 0))
+ scan++;
+ }
+ else {
+ while (scan < loceol && ANYOF_BITMAP_TEST(p, *((U8*)scan)))
scan++;
}
break;
DEBUG_EXECUTE_r({
SV * const prop = sv_newmortal();
regprop(prog, prop, p, reginfo, NULL);
- Perl_re_exec_indentf( aTHX_ "%s can match %"IVdf" times out of %"IVdf"...\n",
+ Perl_re_exec_indentf( aTHX_ "%s can match %" IVdf " times out of %" IVdf "...\n",
depth, SvPVX_const(prop),(IV)c,(IV)max);
});
});
* UTF8_IS_INVARIANT() works even if not in UTF-8 */
if (! UTF8_IS_INVARIANT(c) && utf8_target) {
STRLEN c_len = 0;
- c = utf8n_to_uvchr(p, p_end - p, &c_len,
- (UTF8_ALLOW_DEFAULT & UTF8_ALLOW_ANYUV)
- | UTF8_ALLOW_FFFF | UTF8_CHECK_ONLY);
- /* see [perl #37836] for UTF8_ALLOW_ANYUV; [perl #38293] for
- * UTF8_ALLOW_FFFF */
+ c = utf8n_to_uvchr(p, p_end - p, &c_len, ( UTF8_ALLOW_DEFAULT
+ | UTF8_CHECK_ONLY));
if (c_len == (STRLEN)-1)
Perl_croak(aTHX_ "Malformed UTF-8 character (fatal)");
if (c > 255 && OP(n) == ANYOFL && ! ANYOFL_UTF8_LOCALE_REQD(flags)) {
&& ckWARN_d(WARN_NON_UNICODE))
{
Perl_warner(aTHX_ packWARN(WARN_NON_UNICODE),
- "Matched non-Unicode code point 0x%04"UVXf" against Unicode property; may not be portable", c);
+ "Matched non-Unicode code point 0x%04" UVXf " against Unicode property; may not be portable", c);
}
}
}
SET_reg_curpm(reginfo->prog);
eval_state->curpm = PL_curpm;
+ PL_curpm_under = PL_curpm;
PL_curpm = PL_reg_curpm;
if (RXp_MATCH_COPIED(rex)) {
/* Here is a serious problem: we cannot rewrite subbeg,
https://perl5.git.perl.org / perl5.git / blobdiff