**** Alterations to Henry's code are...
****
**** Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- **** 2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
+ **** 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 by Larry Wall and others
****
**** You may distribute under the terms of either the GNU General Public
**** License or the Artistic License, as specified in the README file.
/* TODO: Combine JUMPABLE and HAS_TEXT to cache OP(rn) */
/* for use after a quantifier and before an EXACT-like node -- japhy */
-#define JUMPABLE(rn) ( \
- OP(rn) == OPEN || OP(rn) == CLOSE || OP(rn) == EVAL || \
+/* it would be nice to rework regcomp.sym to generate this stuff. sigh */
+#define JUMPABLE(rn) ( \
+ OP(rn) == OPEN || \
+ (OP(rn) == CLOSE && (!cur_eval || cur_eval->u.eval.close_paren != ARG(rn))) || \
+ OP(rn) == EVAL || \
OP(rn) == SUSPEND || OP(rn) == IFMATCH || \
OP(rn) == PLUS || OP(rn) == MINMOD || \
+ OP(rn) == KEEPS || (PL_regkind[OP(rn)] == VERB) || \
(PL_regkind[OP(rn)] == CURLY && ARG1(rn) > 0) \
)
+#define IS_EXACT(rn) (PL_regkind[OP(rn)] == EXACT)
-#define HAS_TEXT(rn) ( \
- PL_regkind[OP(rn)] == EXACT || PL_regkind[OP(rn)] == REF \
-)
+#define HAS_TEXT(rn) ( IS_EXACT(rn) || PL_regkind[OP(rn)] == REF )
+
+#if 0
+/* Currently these are only used when PL_regkind[OP(rn)] == EXACT so
+ we don't need this definition. */
+#define IS_TEXT(rn) ( OP(rn)==EXACT || OP(rn)==REF || OP(rn)==NREF )
+#define IS_TEXTF(rn) ( OP(rn)==EXACTF || OP(rn)==REFF || OP(rn)==NREFF )
+#define IS_TEXTFL(rn) ( OP(rn)==EXACTFL || OP(rn)==REFFL || OP(rn)==NREFFL )
+
+#else
+/* ... so we use this as its faster. */
+#define IS_TEXT(rn) ( OP(rn)==EXACT )
+#define IS_TEXTF(rn) ( OP(rn)==EXACTF )
+#define IS_TEXTFL(rn) ( OP(rn)==EXACTFL )
+
+#endif
/*
Search for mandatory following text node; for lookahead, the text must
if (paren_elems_to_push < 0)
Perl_croak(aTHX_ "panic: paren_elems_to_push < 0");
-#define REGCP_OTHER_ELEMS 8
+#define REGCP_OTHER_ELEMS 7
SSGROW(paren_elems_to_push + REGCP_OTHER_ELEMS);
for (p = PL_regsize; p > parenfloor; p--) {
/* REGCP_PARENS_ELEMS are pushed per pairs of parentheses. */
- SSPUSHINT(PL_regendp[p]);
- SSPUSHINT(PL_regstartp[p]);
+ SSPUSHINT(PL_regoffs[p].end);
+ SSPUSHINT(PL_regoffs[p].start);
SSPUSHPTR(PL_reg_start_tmp[p]);
SSPUSHINT(p);
- DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
+ DEBUG_BUFFERS_r(PerlIO_printf(Perl_debug_log,
" saving \\%"UVuf" %"IVdf"(%"IVdf")..%"IVdf"\n",
- (UV)p, (IV)PL_regstartp[p],
+ (UV)p, (IV)PL_regoffs[p].start,
(IV)(PL_reg_start_tmp[p] - PL_bostr),
- (IV)PL_regendp[p]
+ (IV)PL_regoffs[p].end
));
}
/* REGCP_OTHER_ELEMS are pushed in any case, parentheses or no. */
- SSPUSHPTR(PL_regstartp);
- SSPUSHPTR(PL_regendp);
+ SSPUSHPTR(PL_regoffs);
SSPUSHINT(PL_regsize);
SSPUSHINT(*PL_reglastparen);
SSPUSHINT(*PL_reglastcloseparen);
*PL_reglastcloseparen = SSPOPINT;
*PL_reglastparen = SSPOPINT;
PL_regsize = SSPOPINT;
- PL_regendp=(I32 *) SSPOPPTR;
- PL_regstartp=(I32 *) SSPOPPTR;
+ PL_regoffs=(regexp_paren_pair *) SSPOPPTR;
/* Now restore the parentheses context. */
I32 tmps;
U32 paren = (U32)SSPOPINT;
PL_reg_start_tmp[paren] = (char *) SSPOPPTR;
- PL_regstartp[paren] = SSPOPINT;
+ PL_regoffs[paren].start = SSPOPINT;
tmps = SSPOPINT;
if (paren <= *PL_reglastparen)
- PL_regendp[paren] = tmps;
- DEBUG_EXECUTE_r(
+ PL_regoffs[paren].end = tmps;
+ DEBUG_BUFFERS_r(
PerlIO_printf(Perl_debug_log,
" restoring \\%"UVuf" to %"IVdf"(%"IVdf")..%"IVdf"%s\n",
- (UV)paren, (IV)PL_regstartp[paren],
+ (UV)paren, (IV)PL_regoffs[paren].start,
(IV)(PL_reg_start_tmp[paren] - PL_bostr),
- (IV)PL_regendp[paren],
+ (IV)PL_regoffs[paren].end,
(paren > *PL_reglastparen ? "(no)" : ""));
);
}
- DEBUG_EXECUTE_r(
+ DEBUG_BUFFERS_r(
if (*PL_reglastparen + 1 <= rex->nparens) {
PerlIO_printf(Perl_debug_log,
" restoring \\%"IVdf"..\\%"IVdf" to undef\n",
* --jhi */
for (i = *PL_reglastparen + 1; i <= rex->nparens; i++) {
if (i > PL_regsize)
- PL_regstartp[i] = -1;
- PL_regendp[i] = -1;
+ PL_regoffs[i].start = -1;
+ PL_regoffs[i].end = -1;
}
#endif
return input;
/* end shift should be non negative here */
}
-#ifdef DEBUGGING /* 7/99: reports of failure (with the older version) */
+#ifdef QDEBUGGING /* 7/99: reports of failure (with the older version) */
if (end_shift < 0)
Perl_croak(aTHX_ "panic: end_shift: %"IVdf" pattern:\n%s\n ",
(IV)end_shift, prog->precomp);
if (PL_screamfirst[BmRARE(check)] >= 0
|| ( BmRARE(check) == '\n'
- && (BmPREVIOUS(check) == (U8)SvCUR(check) - 1)
+ && (BmPREVIOUS(check) == SvCUR(check) - 1)
&& SvTAIL(check) ))
s = screaminstr(sv, check,
srch_start_shift + (s - strbeg), srch_end_shift, pp, 0);
return s;
}
+static void
+S_swap_match_buff (pTHX_ regexp *prog) {
+ regexp_paren_pair *t;
+
+ if (!prog->swap) {
+ /* We have to be careful. If the previous successful match
+ was from this regex we don't want a subsequent paritally
+ successful match to clobber the old results.
+ So when we detect this possibility we add a swap buffer
+ to the re, and switch the buffer each match. If we fail
+ we switch it back, otherwise we leave it swapped.
+ */
+ Newxz(prog->swap, (prog->nparens + 1), regexp_paren_pair);
+ }
+ t = prog->swap;
+ prog->swap = prog->offs;
+ prog->offs = t;
+}
+
+
/*
- regexec_flags - match a regexp against a string
*/
I32 multiline;
RXi_GET_DECL(prog,progi);
regmatch_info reginfo; /* create some info to pass to regtry etc */
+ bool swap_on_fail = 0;
GET_RE_DEBUG_FLAGS_DECL;
reginfo.ganch = strbeg;
}
if (PL_curpm && (PM_GETRE(PL_curpm) == prog)) {
- I32 *t;
- if (!progi->swap) {
- /* We have to be careful. If the previous successful match
- was from this regex we don't want a subsequent paritally
- successful match to clobber the old results.
- So when we detect this possibility we add a swap buffer
- to the re, and switch the buffer each match. If we fail
- we switch it back, otherwise we leave it swapped.
- */
- Newxz(progi->swap, 1, regexp_paren_ofs);
- /* no need to copy these */
- Newxz(progi->swap->startp, prog->nparens + 1, I32);
- Newxz(progi->swap->endp, prog->nparens + 1, I32);
- }
- t = progi->swap->startp;
- progi->swap->startp = prog->startp;
- prog->startp = t;
- t = progi->swap->endp;
- progi->swap->endp = prog->endp;
- prog->endp = t;
+ swap_on_fail = 1;
+ swap_match_buff(prog); /* do we need a save destructor here for
+ eval dies? */
}
if (!(flags & REXEC_CHECKED) && (prog->check_substr != NULL || prog->check_utf8 != NULL)) {
re_scream_pos_data d;
SV * const prop = sv_newmortal();
regprop(prog, prop, c);
{
- RE_PV_QUOTED_DECL(quoted,UTF,PERL_DEBUG_PAD_ZERO(1),
+ RE_PV_QUOTED_DECL(quoted,do_utf8,PERL_DEBUG_PAD_ZERO(1),
s,strend-s,60);
PerlIO_printf(Perl_debug_log,
"Matching stclass %.*s against %s (%d chars)\n",
PL_colors[4], PL_colors[5]));
if (PL_reg_eval_set)
restore_pos(aTHX_ prog);
- if (progi->swap) {
+ if (swap_on_fail)
/* we failed :-( roll it back */
- I32 *t;
- t = progi->swap->startp;
- progi->swap->startp = prog->startp;
- prog->startp = t;
- t = progi->swap->endp;
- progi->swap->endp = prog->endp;
- prog->endp = t;
- }
+ swap_match_buff(prog);
+
return 0;
}
S_regtry(pTHX_ regmatch_info *reginfo, char **startpos)
{
dVAR;
- register I32 *sp;
- register I32 *ep;
CHECKPOINT lastcp;
regexp *prog = reginfo->prog;
RXi_GET_DECL(prog,progi);
prog->sublen = PL_regeol - PL_bostr; /* strend may have been modified */
}
DEBUG_EXECUTE_r(PL_reg_starttry = *startpos);
- prog->startp[0] = *startpos - PL_bostr;
+ prog->offs[0].start = *startpos - PL_bostr;
PL_reginput = *startpos;
PL_reglastparen = &prog->lastparen;
PL_reglastcloseparen = &prog->lastcloseparen;
prog->lastparen = 0;
prog->lastcloseparen = 0;
PL_regsize = 0;
- PL_regstartp = prog->startp;
- PL_regendp = prog->endp;
+ PL_regoffs = prog->offs;
if (PL_reg_start_tmpl <= prog->nparens) {
PL_reg_start_tmpl = prog->nparens*3/2 + 3;
if(PL_reg_start_tmp)
* on those tests seems to be returning null fields from matches.
* --jhi */
#if 1
- sp = PL_regstartp;
- ep = PL_regendp;
if (prog->nparens) {
+ regexp_paren_pair *pp = PL_regoffs;
register I32 i;
for (i = prog->nparens; i > (I32)*PL_reglastparen; i--) {
- *++sp = -1;
- *++ep = -1;
+ ++pp;
+ pp->start = -1;
+ pp->end = -1;
}
}
#endif
REGCP_SET(lastcp);
if (regmatch(reginfo, progi->program + 1)) {
- PL_regendp[0] = PL_reginput - PL_bostr;
+ PL_regoffs[0].end = PL_reginput - PL_bostr;
return 1;
}
if (reginfo->cutpoint)
STATIC regmatch_state *
S_push_slab(pTHX)
{
-#if PERL_VERSION < 9
+#if PERL_VERSION < 9 && !defined(PERL_CORE)
dMY_CXT;
#endif
regmatch_slab *s = PL_regmatch_slab->next;
PerlIO_printf(Perl_debug_log, \
" %*s"pp" %s%s%s%s%s\n", \
depth*2, "", \
- reg_name[st->resume_state], \
+ PL_reg_name[st->resume_state], \
((st==yes_state||st==mark_state) ? "[" : ""), \
((st==yes_state) ? "Y" : ""), \
((st==mark_state) ? "M" : ""), \
I32 *nums=(I32*)SvPVX(sv_dat);
for ( n=0; n<SvIVX(sv_dat); n++ ) {
if ((I32)*PL_reglastparen >= nums[n] &&
- PL_regendp[nums[n]] != -1)
+ PL_regoffs[nums[n]].end != -1)
{
return nums[n];
}
return 0;
}
+#define SETREX(Re1,Re2) \
+ if (PL_reg_eval_set) PM_SETRE((PL_reg_curpm), (Re2)); \
+ Re1 = (Re2)
+
STATIC I32 /* 0 failure, 1 success */
S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
{
-#if PERL_VERSION < 9
+#if PERL_VERSION < 9 && !defined(PERL_CORE)
dMY_CXT;
#endif
dVAR;
bool result = 0; /* return value of S_regmatch */
int depth = 0; /* depth of backtrack stack */
- int nochange_depth = 0; /* depth of GOSUB recursion with nochange*/
+ U32 nochange_depth = 0; /* depth of GOSUB recursion with nochange */
+ const U32 max_nochange_depth =
+ (3 * rex->nparens > MAX_RECURSE_EVAL_NOCHANGE_DEPTH) ?
+ 3 * rex->nparens : MAX_RECURSE_EVAL_NOCHANGE_DEPTH;
+
regmatch_state *yes_state = NULL; /* state to pop to on success of
subpattern */
/* mark_state piggy backs on the yes_state logic so that when we unwind
GET_RE_DEBUG_FLAGS_DECL;
#endif
- DEBUG_OPTIMISE_r( {
+ DEBUG_OPTIMISE_r( DEBUG_EXECUTE_r({
PerlIO_printf(Perl_debug_log,"regmatch start\n");
- });
+ }));
/* on first ever call to regmatch, allocate first slab */
if (!PL_regmatch_slab) {
Newx(PL_regmatch_slab, 1, regmatch_slab);
if (locinput == reginfo->ganch)
break;
sayNO;
+
+ case KEEPS:
+ /* update the startpoint */
+ st->u.keeper.val = PL_regoffs[0].start;
+ PL_reginput = locinput;
+ PL_regoffs[0].start = locinput - PL_bostr;
+ PUSH_STATE_GOTO(KEEPS_next, next);
+ /*NOT-REACHED*/
+ case KEEPS_next_fail:
+ /* rollback the start point change */
+ PL_regoffs[0].start = st->u.keeper.val;
+ sayNO_SILENT;
+ /*NOT-REACHED*/
case EOL:
goto seol;
case MEOL:
ST.B = next;
ST.jump = trie->jump;
ST.me = scan;
-
/*
traverse the TRIE keeping track of all accepting states
we transition through until we get to a failing node.
PL_colors[4], (IV)ST.accepted, PL_colors[5] );
);
}}
-
- /* FALL THROUGH */
+ goto trie_first_try; /* jump into the fail handler */
+ /* NOTREACHED */
case TRIE_next_fail: /* we failed - try next alterative */
+ if ( ST.jump) {
+ REGCP_UNWIND(ST.cp);
+ for (n = *PL_reglastparen; n > ST.lastparen; n--)
+ PL_regoffs[n].end = -1;
+ *PL_reglastparen = n;
+ }
+ trie_first_try:
if (do_cutgroup) {
do_cutgroup = 0;
no_final = 0;
}
+
+ if ( ST.jump) {
+ ST.lastparen = *PL_reglastparen;
+ REGCP_SET(ST.cp);
+ }
if ( ST.accepted == 1 ) {
/* only one choice left - just continue */
DEBUG_EXECUTE_r({
continue; /* execute rest of RE */
}
-
- if (!ST.accepted-- ) {
+
+ if ( !ST.accepted-- ) {
DEBUG_EXECUTE_r({
PerlIO_printf( Perl_debug_log,
"%*s %sTRIE failed...%s\n",
FREETMPS;
LEAVE;
sayNO_SILENT;
- }
+ /*NOTREACHED*/
+ }
/*
There are at least two accepting states left. Presumably
n = ARG(scan); /* which paren pair */
type = OP(scan);
do_ref:
- ln = PL_regstartp[n];
+ ln = PL_regoffs[n].start;
PL_reg_leftiter = PL_reg_maxiter; /* Void cache */
if (*PL_reglastparen < n || ln == -1)
sayNO; /* Do not match unless seen CLOSEn. */
- if (ln == PL_regendp[n])
+ if (ln == PL_regoffs[n].end)
break;
s = PL_bostr + ln;
if (do_utf8 && type != REF) { /* REF can do byte comparison */
char *l = locinput;
- const char *e = PL_bostr + PL_regendp[n];
+ const char *e = PL_bostr + PL_regoffs[n].end;
/*
* Note that we can't do the "other character" lookup trick as
* in the 8-bit case (no pun intended) because in Unicode we
(UCHARAT(s) != (type == REFF
? PL_fold : PL_fold_locale)[nextchr])))
sayNO;
- ln = PL_regendp[n] - ln;
+ ln = PL_regoffs[n].end - ln;
if (locinput + ln > PL_regeol)
sayNO;
if (ln > 1 && (type == REF
regnode *startpoint;
case GOSTART:
- case GOSUB: /* /(...(?1))/ */
- if (cur_eval && cur_eval->locinput==locinput) {
+ case GOSUB: /* /(...(?1))/ /(...(?&foo))/ */
+ if (cur_eval && cur_eval->locinput==locinput) {
if (cur_eval->u.eval.close_paren == (U32)ARG(scan))
Perl_croak(aTHX_ "Infinite recursion in regex");
- if ( ++nochange_depth > MAX_RECURSE_EVAL_NOCHANGE_DEPTH )
+ if ( ++nochange_depth > max_nochange_depth )
Perl_croak(aTHX_
"Pattern subroutine nesting without pos change"
" exceeded limit in regex");
/* NOTREACHED */
case EVAL: /* /(?{A})B/ /(??{A})B/ and /(?(?{A})X|Y)B/ */
if (cur_eval && cur_eval->locinput==locinput) {
- if ( ++nochange_depth > MAX_RECURSE_EVAL_NOCHANGE_DEPTH )
+ if ( ++nochange_depth > max_nochange_depth )
Perl_croak(aTHX_ "EVAL without pos change exceeded limit in regex");
} else {
nochange_depth = 0;
DEBUG_STATE_r( PerlIO_printf(Perl_debug_log,
" re_eval 0x%"UVxf"\n", PTR2UV(PL_op)) );
PAD_SAVE_LOCAL(old_comppad, (PAD*)rexi->data->data[n + 2]);
- PL_regendp[0] = PL_reg_magic->mg_len = locinput - PL_bostr;
+ PL_regoffs[0].end = PL_reg_magic->mg_len = locinput - PL_bostr;
if (sv_yes_mark) {
SV *sv_mrk = get_sv("REGMARK", 1);
}
if (mg) {
- re = (regexp *)mg->mg_obj;
- (void)ReREFCNT_inc(re);
+ re = reg_temp_copy((regexp *)mg->mg_obj); /*XXX:dmq*/
}
else {
STRLEN len;
PL_regsize = osize;
}
}
+ RX_MATCH_COPIED_off(re);
+ re->subbeg = rex->subbeg;
+ re->sublen = rex->sublen;
rei = RXi_GET(re);
DEBUG_EXECUTE_r(
debug_start_match(re, do_utf8, locinput, PL_regeol,
ST.cp = regcppush(0); /* Save *all* the positions. */
REGCP_SET(ST.lastcp);
- PL_regstartp = re->startp; /* essentially NOOP on GOSUB */
- PL_regendp = re->endp; /* essentially NOOP on GOSUB */
+ PL_regoffs = re->offs; /* essentially NOOP on GOSUB */
*PL_reglastparen = 0;
*PL_reglastcloseparen = 0;
ST.prev_rex = rex;
ST.prev_curlyx = cur_curlyx;
- rex = re;
+ SETREX(rex,re);
rexi = rei;
cur_curlyx = NULL;
ST.B = next;
/* note: this is called twice; first after popping B, then A */
PL_reg_flags ^= ST.toggle_reg_flags;
ReREFCNT_dec(rex);
- rex = ST.prev_rex;
+ SETREX(rex,ST.prev_rex);
rexi = RXi_GET(rex);
regcpblow(ST.cp);
cur_eval = ST.prev_eval;
cur_curlyx = ST.prev_curlyx;
/* XXXX This is too dramatic a measure... */
PL_reg_maxiter = 0;
+ if ( nochange_depth )
+ nochange_depth--;
sayYES;
/* note: this is called twice; first after popping B, then A */
PL_reg_flags ^= ST.toggle_reg_flags;
ReREFCNT_dec(rex);
- rex = ST.prev_rex;
+ SETREX(rex,ST.prev_rex);
rexi = RXi_GET(rex);
PL_reginput = locinput;
REGCP_UNWIND(ST.lastcp);
cur_curlyx = ST.prev_curlyx;
/* XXXX This is too dramatic a measure... */
PL_reg_maxiter = 0;
+ if ( nochange_depth )
+ nochange_depth--;
sayNO_SILENT;
#undef ST
break;
case CLOSE:
n = ARG(scan); /* which paren pair */
- PL_regstartp[n] = PL_reg_start_tmp[n] - PL_bostr;
- PL_regendp[n] = locinput - PL_bostr;
+ PL_regoffs[n].start = PL_reg_start_tmp[n] - PL_bostr;
+ PL_regoffs[n].end = locinput - PL_bostr;
/*if (n > PL_regsize)
PL_regsize = n;*/
if (n > *PL_reglastparen)
if ( OP(cursor)==CLOSE ){
n = ARG(cursor);
if ( n <= lastopen ) {
- PL_regstartp[n] = PL_reg_start_tmp[n] - PL_bostr;
- PL_regendp[n] = locinput - PL_bostr;
+ PL_regoffs[n].start
+ = PL_reg_start_tmp[n] - PL_bostr;
+ PL_regoffs[n].end = locinput - PL_bostr;
/*if (n > PL_regsize)
PL_regsize = n;*/
if (n > *PL_reglastparen)
/*NOTREACHED*/
case GROUPP:
n = ARG(scan); /* which paren pair */
- sw = (bool)(*PL_reglastparen >= n && PL_regendp[n] != -1);
+ sw = (bool)(*PL_reglastparen >= n && PL_regoffs[n].end != -1);
break;
case NGROUPP:
/* reg_check_named_buff_matched returns 0 for no match */
}
REGCP_UNWIND(ST.cp);
for (n = *PL_reglastparen; n > ST.lastparen; n--)
- PL_regendp[n] = -1;
+ PL_regoffs[n].end = -1;
*PL_reglastparen = n;
/*dmq: *PL_reglastcloseparen = n; */
scan = ST.next_branch;
regnode *text_node = ST.B;
if (! HAS_TEXT(text_node))
FIND_NEXT_IMPT(text_node);
- if (HAS_TEXT(text_node)
- && PL_regkind[OP(text_node)] != REF)
+ /* this used to be
+
+ (HAS_TEXT(text_node) && PL_regkind[OP(text_node)] == EXACT)
+
+ But the former is redundant in light of the latter.
+
+ if this changes back then the macro for
+ IS_TEXT and friends need to change.
+ */
+ if (PL_regkind[OP(text_node)] == EXACT)
{
+
ST.c1 = (U8)*STRING(text_node);
ST.c2 =
- (OP(text_node) == EXACTF || OP(text_node) == REFF)
+ (IS_TEXTF(text_node))
? PL_fold[ST.c1]
- : (OP(text_node) == EXACTFL || OP(text_node) == REFFL)
+ : (IS_TEXTFL(text_node))
? PL_fold_locale[ST.c1]
: ST.c1;
}
&& UCHARAT(PL_reginput) != ST.c2)
{
/* simulate B failing */
+ DEBUG_OPTIMISE_r(
+ PerlIO_printf(Perl_debug_log,
+ "%*s CURLYM Fast bail c1=%"IVdf" c2=%"IVdf"\n",
+ (int)(REPORT_CODE_OFF+(depth*2)),"",
+ (IV)ST.c1,(IV)ST.c2
+ ));
state_num = CURLYM_B_fail;
goto reenter_switch;
}
/* mark current A as captured */
I32 paren = ST.me->flags;
if (ST.count) {
- PL_regstartp[paren]
+ PL_regoffs[paren].start
= HOPc(PL_reginput, -ST.alen) - PL_bostr;
- PL_regendp[paren] = PL_reginput - PL_bostr;
+ PL_regoffs[paren].end = PL_reginput - PL_bostr;
/*dmq: *PL_reglastcloseparen = paren; */
}
else
- PL_regendp[paren] = -1;
+ PL_regoffs[paren].end = -1;
if (cur_eval && cur_eval->u.eval.close_paren &&
cur_eval->u.eval.close_paren == (U32)ST.me->flags)
{
#define CURLY_SETPAREN(paren, success) \
if (paren) { \
if (success) { \
- PL_regstartp[paren] = HOPc(locinput, -1) - PL_bostr; \
- PL_regendp[paren] = locinput - PL_bostr; \
+ PL_regoffs[paren].start = HOPc(locinput, -1) - PL_bostr; \
+ PL_regoffs[paren].end = locinput - PL_bostr; \
*PL_reglastcloseparen = paren; \
} \
else \
- PL_regendp[paren] = -1; \
+ PL_regoffs[paren].end = -1; \
}
case STAR: /* /A*B/ where A is width 1 */
if (! HAS_TEXT(text_node))
ST.c1 = ST.c2 = CHRTEST_VOID;
else {
- if (PL_regkind[OP(text_node)] == REF) {
+ if ( PL_regkind[OP(text_node)] != EXACT ) {
ST.c1 = ST.c2 = CHRTEST_VOID;
goto assume_ok_easy;
}
else
s = (U8*)STRING(text_node);
-
+
+ /* Currently we only get here when
+
+ PL_rekind[OP(text_node)] == EXACT
+
+ if this changes back then the macro for IS_TEXT and
+ friends need to change. */
if (!UTF) {
ST.c2 = ST.c1 = *s;
- if (OP(text_node) == EXACTF || OP(text_node) == REFF)
+ if (IS_TEXTF(text_node))
ST.c2 = PL_fold[ST.c1];
- else if (OP(text_node) == EXACTFL || OP(text_node) == REFFL)
+ else if (IS_TEXTFL(text_node))
ST.c2 = PL_fold_locale[ST.c1];
}
else { /* UTF */
- if (OP(text_node) == EXACTF || OP(text_node) == REFF) {
+ if (IS_TEXTF(text_node)) {
STRLEN ulen1, ulen2;
U8 tmpbuf1[UTF8_MAXBYTES_CASE+1];
U8 tmpbuf2[UTF8_MAXBYTES_CASE+1];
case CURLY_B_min_known_fail:
/* failed to find B in a non-greedy match where c1,c2 valid */
if (ST.paren && ST.count)
- PL_regendp[ST.paren] = -1;
+ PL_regoffs[ST.paren].end = -1;
PL_reginput = locinput; /* Could be reset... */
REGCP_UNWIND(ST.cp);
case CURLY_B_min_fail:
/* failed to find B in a non-greedy match where c1,c2 invalid */
if (ST.paren && ST.count)
- PL_regendp[ST.paren] = -1;
+ PL_regoffs[ST.paren].end = -1;
REGCP_UNWIND(ST.cp);
/* failed -- move forward one */
case CURLY_B_max_fail:
/* failed to find B in a greedy match */
if (ST.paren && ST.count)
- PL_regendp[ST.paren] = -1;
+ PL_regoffs[ST.paren].end = -1;
REGCP_UNWIND(ST.cp);
/* back up. */
if (cur_eval) {
/* we've just finished A in /(??{A})B/; now continue with B */
I32 tmpix;
-
-
st->u.eval.toggle_reg_flags
= cur_eval->u.eval.toggle_reg_flags;
PL_reg_flags ^= st->u.eval.toggle_reg_flags;
st->u.eval.prev_rex = rex; /* inner */
- rex = cur_eval->u.eval.prev_rex; /* outer */
+ SETREX(rex,cur_eval->u.eval.prev_rex);
rexi = RXi_GET(rex);
cur_curlyx = cur_eval->u.eval.prev_curlyx;
ReREFCNT_inc(rex);
DEBUG_EXECUTE_r(
PerlIO_printf(Perl_debug_log, "%*s EVAL trying tail ... %"UVxf"\n",
REPORT_CODE_OFF+depth*2, "",PTR2UV(cur_eval)););
- PUSH_YES_STATE_GOTO(EVAL_AB,
+ if ( nochange_depth )
+ nochange_depth--;
+
+ PUSH_YES_STATE_GOTO(EVAL_AB,
st->u.eval.prev_eval->u.eval.B); /* match B */
}
}
PerlIO_printf(Perl_error_log, "%*s#%-3d %-10s %s\n",
REPORT_CODE_OFF + 2 + depth * 2,"",
- curd, reg_name[cur->resume_state],
+ curd, PL_reg_name[cur->resume_state],
(curyes == cur) ? "yes" : ""
);
if (curyes == cur)
register char *loceol = PL_regeol;
register I32 hardcount = 0;
register bool do_utf8 = PL_reg_match_utf8;
+#ifndef DEBUGGING
+ PERL_UNUSED_ARG(depth);
+#endif
scan = PL_reginput;
if (max == REG_INFTY)
SV* const sv = newSVsv(prog->substrs->data[i].substr);
prog->substrs->data[i].utf8_substr = sv;
sv_utf8_upgrade(sv);
- if (SvVALID(prog->substrs->data[i].substr))
- fbm_compile(sv, 0);
- if (SvTAIL(prog->substrs->data[i].substr))
- SvTAIL_on(sv);
+ if (SvVALID(prog->substrs->data[i].substr)) {
+ const U8 flags = BmFLAGS(prog->substrs->data[i].substr);
+ if (flags & FBMcf_TAIL) {
+ /* Trim the trailing \n that fbm_compile added last
+ time. */
+ SvCUR_set(sv, SvCUR(sv) - 1);
+ /* Whilst this makes the SV technically "invalid" (as its
+ buffer is no longer followed by "\0") when fbm_compile()
+ adds the "\n" back, a "\0" is restored. */
+ }
+ fbm_compile(sv, flags);
+ }
if (prog->substrs->data[i].substr == prog->check_substr)
prog->check_utf8 = sv;
}
&& !prog->substrs->data[i].substr) {
SV* sv = newSVsv(prog->substrs->data[i].utf8_substr);
if (sv_utf8_downgrade(sv, TRUE)) {
- if (SvVALID(prog->substrs->data[i].utf8_substr))
- fbm_compile(sv, 0);
- if (SvTAIL(prog->substrs->data[i].utf8_substr))
- SvTAIL_on(sv);
+ if (SvVALID(prog->substrs->data[i].utf8_substr)) {
+ const U8 flags
+ = BmFLAGS(prog->substrs->data[i].utf8_substr);
+ if (flags & FBMcf_TAIL) {
+ /* Trim the trailing \n that fbm_compile added last
+ time. */
+ SvCUR_set(sv, SvCUR(sv) - 1);
+ }
+ fbm_compile(sv, flags);
+ }
} else {
SvREFCNT_dec(sv);
sv = &PL_sv_undef;
https://perl5.git.perl.org / perl5.git / blobdiff