);
for (p = parenfloor+1; p <= (I32)maxopenparen; p++) {
/* REGCP_PARENS_ELEMS are pushed per pairs of parentheses. */
- SSPUSHINT(rex->offs[p].end);
- SSPUSHINT(rex->offs[p].start);
+ SSPUSHIV(rex->offs[p].end);
+ SSPUSHIV(rex->offs[p].start);
SSPUSHINT(rex->offs[p].start_tmp);
DEBUG_BUFFERS_r(PerlIO_printf(Perl_debug_log,
" \\%"UVuf": %"IVdf"(%"IVdf")..%"IVdf"\n",
);
paren = *maxopenparen_p;
for ( ; i > 0; i -= REGCP_PAREN_ELEMS) {
- I32 tmps;
+ SSize_t tmps;
rex->offs[paren].start_tmp = SSPOPINT;
- rex->offs[paren].start = SSPOPINT;
- tmps = SSPOPINT;
+ rex->offs[paren].start = SSPOPIV;
+ tmps = SSPOPIV;
if (paren <= rex->lastparen)
rex->offs[paren].end = tmps;
DEBUG_BUFFERS_r( PerlIO_printf(Perl_debug_log,
*/
I32
Perl_pregexec(pTHX_ REGEXP * const prog, char* stringarg, char *strend,
- char *strbeg, I32 minend, SV *screamer, U32 nosave)
+ char *strbeg, SSize_t minend, SV *screamer, U32 nosave)
/* stringarg: the point in the string at which to begin matching */
/* strend: pointer to null at end of string */
/* strbeg: real beginning of string */
{
dVAR;
struct regexp *const prog = ReANY(rx);
- I32 start_shift = 0;
+ SSize_t start_shift = 0;
/* Should be nonnegative! */
- I32 end_shift = 0;
+ SSize_t end_shift = 0;
char *s;
SV *check;
char *t;
See [perl #115242] */
{
/* Substring at constant offset from beg-of-str... */
- I32 slen;
+ SSize_t slen;
s = HOP3c(strpos, prog->check_offset_min, strend);
end_shift = prog->check_end_shift;
if (!ml_anch) {
- const I32 end = prog->check_offset_max + CHR_SVLEN(check)
+ const SSize_t end = prog->check_offset_max + CHR_SVLEN(check)
- (SvTAIL(check) != 0);
- const I32 eshift = CHR_DIST((U8*)strend, (U8*)s) - end;
+ const SSize_t eshift = CHR_DIST((U8*)strend, (U8*)s) - end;
if (end_shift < eshift)
end_shift = eshift;
the "check" substring in the region corrected by start/end_shift. */
{
- I32 srch_start_shift = start_shift;
- I32 srch_end_shift = end_shift;
+ SSize_t srch_start_shift = start_shift;
+ SSize_t srch_end_shift = end_shift;
U8* start_point;
U8* end_point;
if (srch_start_shift < 0 && strbeg - s > srch_start_shift) {
* characters, and there are only 2 availabe, we know without
* trying that it will fail; so don't start a match past the
* required minimum number from the far end */
- e = HOP3c(strend, -((I32)ln), s);
+ e = HOP3c(strend, -((SSize_t)ln), s);
if (reginfo->intuit && e < s) {
e = s; /* Due to minlen logic of intuit() */
* only 2 are left, it's guaranteed to fail, so don't start a
* match that would require us to go beyond the end of the string
*/
- e = HOP3c(strend, -((I32)lnc), s);
+ e = HOP3c(strend, -((SSize_t)lnc), s);
if (reginfo->intuit && e < s) {
e = s; /* Due to minlen logic of intuit() */
"Copy on write: regexp capture, type %d\n",
(int) SvTYPE(sv));
}
- /* skip creating new COW SV if a valid one already exists */
- if (! ( prog->saved_copy
- && SvIsCOW(sv)
- && SvPOKp(sv)
- && SvIsCOW(prog->saved_copy)
- && SvPOKp(prog->saved_copy)
- && SvPVX(sv) == SvPVX(prog->saved_copy)))
+ /* Create a new COW SV to share the match string and store
+ * in saved_copy, unless the current COW SV in saved_copy
+ * is valid and suitable for our purpose */
+ if (( prog->saved_copy
+ && SvIsCOW(prog->saved_copy)
+ && SvPOKp(prog->saved_copy)
+ && SvIsCOW(sv)
+ && SvPOKp(sv)
+ && SvPVX(sv) == SvPVX(prog->saved_copy)))
{
+ /* just reuse saved_copy SV */
+ if (RXp_MATCH_COPIED(prog)) {
+ Safefree(prog->subbeg);
+ RXp_MATCH_COPIED_off(prog);
+ }
+ }
+ else {
+ /* create new COW SV to share string */
RX_MATCH_COPY_FREE(rx);
prog->saved_copy = sv_setsv_cow(prog->saved_copy, sv);
- prog->subbeg = (char *)SvPVX_const(prog->saved_copy);
- assert (SvPOKp(prog->saved_copy));
}
+ prog->subbeg = (char *)SvPVX_const(prog->saved_copy);
+ assert (SvPOKp(prog->saved_copy));
prog->sublen = strend - strbeg;
prog->suboffset = 0;
prog->subcoffset = 0;
} else
#endif
{
- I32 min = 0;
- I32 max = strend - strbeg;
- I32 sublen;
+ SSize_t min = 0;
+ SSize_t max = strend - strbeg;
+ SSize_t sublen;
if ( (flags & REXEC_COPY_SKIP_POST)
- && !(RX_EXTFLAGS(rx) & RXf_PMf_KEEPCOPY) /* //p */
+ && !(prog->extflags & RXf_PMf_KEEPCOPY) /* //p */
&& !(PL_sawampersand & SAWAMPERSAND_RIGHT)
) { /* don't copy $' part of string */
U32 n = 0;
}
if ( (flags & REXEC_COPY_SKIP_PRE)
- && !(RX_EXTFLAGS(rx) & RXf_PMf_KEEPCOPY) /* //p */
+ && !(prog->extflags & RXf_PMf_KEEPCOPY) /* //p */
&& !(PL_sawampersand & SAWAMPERSAND_LEFT)
) { /* don't copy $` part of string */
U32 n = 0;
* $x = "\x{100}" x 1E6; 1 while $x =~ /(.)/g;
* from going quadratic */
if (SvPOKp(sv) && SvPVX(sv) == strbeg)
- sv_pos_b2u(sv, &(prog->subcoffset));
+ prog->subcoffset = sv_pos_b2u_flags(sv, prog->subcoffset,
+ SV_GMAGIC|SV_CONST_RETURN);
else
prog->subcoffset = utf8_length((U8*)strbeg,
(U8*)(strbeg+prog->suboffset));
*/
I32
Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, char *strend,
- char *strbeg, I32 minend, SV *sv, void *data, U32 flags)
+ char *strbeg, SSize_t minend, SV *sv, void *data, U32 flags)
/* stringarg: the point in the string at which to begin matching */
/* strend: pointer to null at end of string */
/* strbeg: real beginning of string */
* itself is accessed via the pointers above */
/* data: May be used for some additional optimizations.
Currently unused. */
-/* nosave: For optimizations. */
+/* flags: For optimizations. See REXEC_* in regexp.h */
{
dVAR;
char *s;
regnode *c;
char *startpos;
- I32 minlen; /* must match at least this many chars */
- I32 dontbother = 0; /* how many characters not to try at end */
- I32 end_shift = 0; /* Same for the end. */ /* CC */
+ SSize_t minlen; /* must match at least this many chars */
+ SSize_t dontbother = 0; /* how many characters not to try at end */
const bool utf8_target = cBOOL(DO_UTF8(sv));
I32 multiline;
RXi_GET_DECL(prog,progi);
startpos = stringarg;
if (prog->extflags & RXf_GPOS_SEEN) {
+ MAGIC *mg;
+
+ /* set reginfo->ganch, the position where \G can match */
+
+ reginfo->ganch =
+ (flags & REXEC_IGNOREPOS)
+ ? stringarg /* use start pos rather than pos() */
+ : (sv && (mg = mg_find_mglob(sv)) && mg->mg_len >= 0)
+ /* Defined pos(): */
+ ? strbeg + MgBYTEPOS(mg, sv, strbeg, strend-strbeg)
+ : strbeg; /* pos() not defined; use start of string */
+
+ DEBUG_GPOS_r(PerlIO_printf(Perl_debug_log,
+ "GPOS ganch set to strbeg[%"IVdf"]\n", 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:
* if gofs->prog is set, then that's a known, fixed minimum
* or if the minimum offset isn't known, then we have to go back
* to the start of the string, e.g. /w+\G/
*/
- if (prog->gofs) {
+
+ if (prog->extflags & RXf_ANCH_GPOS) {
+ startpos = reginfo->ganch - prog->gofs;
+ if (startpos <
+ ((flags & REXEC_FAIL_ON_UNDERFLOW) ? stringarg : strbeg))
+ {
+ DEBUG_r(PerlIO_printf(Perl_debug_log,
+ "fail: ganch-gofs before earliest possible start\n"));
+ return 0;
+ }
+ }
+ else if (prog->gofs) {
if (startpos - prog->gofs < strbeg)
startpos = strbeg;
else
return 0;
}
+ /* at the end of this function, we'll do a LEAVE_SCOPE(oldsave),
+ * which will call destuctors to reset PL_regmatch_state, free higher
+ * PL_regmatch_slabs, and clean up regmatch_info_aux and
+ * regmatch_info_aux_eval */
+
+ oldsave = PL_savestack_ix;
+
s = startpos;
- if ((RX_EXTFLAGS(rx) & RXf_USE_INTUIT)
+ if ((prog->extflags & RXf_USE_INTUIT)
&& !(flags & REXEC_CHECKED))
{
s = re_intuit_start(rx, sv, strbeg, startpos, strend,
if (!s)
return 0;
- if (RX_EXTFLAGS(rx) & RXf_CHECK_ALL) {
+ if (prog->extflags & RXf_CHECK_ALL) {
/* we can match based purely on the result of INTUIT.
* Set up captures etc just for $& and $-[0]
* (an intuit-only match wont have $1,$2,..) */
* Let @-, @+, $^N know */
prog->lastparen = prog->lastcloseparen = 0;
RX_MATCH_UTF8_set(rx, utf8_target);
+ prog->offs[0].start = s - strbeg;
+ prog->offs[0].end = utf8_target
+ ? (char*)utf8_hop((U8*)s, prog->minlenret) - strbeg
+ : s - strbeg + prog->minlenret;
if ( !(flags & REXEC_NOT_FIRST) )
S_reg_set_capture_string(aTHX_ rx,
strbeg, strend,
sv, flags, utf8_target);
- prog->offs[0].start = s - strbeg;
- prog->offs[0].end = utf8_target
- ? (char*)utf8_hop((U8*)s, prog->minlenret) - strbeg
- : s - strbeg + prog->minlenret;
return 1;
}
}
-
- /* at the end of this function, we'll do a LEAVE_SCOPE(oldsave),
- * which will call destuctors to reset PL_regmatch_state, free higher
- * PL_regmatch_slabs, and clean up regmatch_info_aux and
- * regmatch_info_aux_eval */
-
- oldsave = PL_savestack_ix;
-
multiline = prog->extflags & RXf_PMf_MULTILINE;
if (strend - s < (minlen+(prog->check_offset_min<0?prog->check_offset_min:0))) {
/* If there is a "must appear" string, look for it. */
- if (prog->extflags & RXf_GPOS_SEEN) { /* Need to set reginfo->ganch */
- MAGIC *mg;
- if (flags & REXEC_IGNOREPOS){ /* Means: check only at start */
- reginfo->ganch = stringarg;
- DEBUG_GPOS_r(PerlIO_printf(Perl_debug_log,
- "GPOS IGNOREPOS: reginfo->ganch = stringarg\n"));
- } else if (sv && (mg = mg_find_mglob(sv))
- && mg->mg_len >= 0) {
- reginfo->ganch = strbeg + mg->mg_len; /* Defined pos() */
- DEBUG_GPOS_r(PerlIO_printf(Perl_debug_log,
- "GPOS MAGIC: reginfo->ganch = strbeg + %"IVdf"\n",(IV)mg->mg_len));
-
- if (prog->extflags & RXf_ANCH_GPOS) {
- if (s > reginfo->ganch)
- goto phooey;
- s = reginfo->ganch - prog->gofs;
- DEBUG_GPOS_r(PerlIO_printf(Perl_debug_log,
- "GPOS ANCH_GPOS: s = ganch - %"UVxf"\n",(UV)prog->gofs));
- if (s < strbeg)
- goto phooey;
- }
- }
- else { /* pos() not defined */
- reginfo->ganch = strbeg;
- DEBUG_GPOS_r(PerlIO_printf(Perl_debug_log,
- "GPOS: reginfo->ganch = strbeg\n"));
- }
- }
if (PL_curpm && (PM_GETRE(PL_curpm) == rx)) {
/* We have to be careful. If the previous successful match
was from this regex we don't want a subsequent partially
/* Simplest case: anchored match need be tried only once. */
/* [unless only anchor is BOL and multiline is set] */
if (prog->extflags & (RXf_ANCH & ~RXf_ANCH_GPOS)) {
- if (s == startpos && regtry(reginfo, &startpos))
+ if (s == startpos && regtry(reginfo, &s))
goto got_it;
else if (multiline || (prog->intflags & PREGf_IMPLICIT)
|| (prog->extflags & RXf_ANCH_MBOL)) /* XXXX SBOL? */
goto phooey;
} else if (RXf_GPOS_CHECK == (prog->extflags & RXf_GPOS_CHECK))
{
- /* the warning about reginfo->ganch being used without initialization
- is bogus -- we set it above, when prog->extflags & RXf_GPOS_SEEN
- and we only enter this block when the same bit is set. */
- char *tmp_s = reginfo->ganch - prog->gofs;
-
- if (tmp_s >= strbeg && regtry(reginfo, &tmp_s))
+ /* For anchored \G, the only position it can match from is
+ * (ganch-gofs); we already set startpos to this above; if intuit
+ * moved us on from there, we can't possibly succeed */
+ assert(startpos == reginfo->ganch - prog->gofs);
+ if (s == startpos && regtry(reginfo, &s))
goto got_it;
goto phooey;
}
|| ((prog->float_substr != NULL || prog->float_utf8 != NULL)
&& prog->float_max_offset < strend - s)) {
SV *must;
- I32 back_max;
- I32 back_min;
+ SSize_t back_max;
+ SSize_t back_min;
char *last;
char *last1; /* Last position checked before */
#ifdef DEBUGGING
last = strend;
} else {
last = HOP3c(strend, /* Cannot start after this */
- -(I32)(CHR_SVLEN(must)
+ -(SSize_t)(CHR_SVLEN(must)
- (SvTAIL(must) != 0) + back_min), strbeg);
}
if (s > reginfo->strbeg)
/* XXXX check_substr already used to find "s", can optimize if
check_substr==must. */
- dontbother = end_shift;
+ dontbother = 0;
strend = HOPc(strend, -dontbother);
while ( (s <= last) &&
(s = fbm_instr((unsigned char*)HOP3(s, back_min, (back_min<0 ? strbeg : strend)),
CHECKPOINT lastcp;
REGEXP *const rx = reginfo->prog;
regexp *const prog = ReANY(rx);
- I32 result;
+ SSize_t result;
RXi_GET_DECL(prog,progi);
GET_RE_DEBUG_FLAGS_DECL;
}
/* returns -1 on failure, $+[0] on success */
-STATIC I32
+STATIC SSize_t
S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
{
#if PERL_VERSION < 9 && !defined(PERL_CORE)
regnode *scan;
regnode *next;
U32 n = 0; /* general value; init to avoid compiler warning */
- I32 ln = 0; /* len or last; init to avoid compiler warning */
+ SSize_t ln = 0; /* len or last; init to avoid compiler warning */
char *locinput = startpos;
char *pushinput; /* where to continue after a PUSH */
I32 nextchr; /* is always set to UCHARAT(locinput) */
rex->offs[0].end = locinput - reginfo->strbeg;
if (reginfo->info_aux_eval->pos_magic)
- reginfo->info_aux_eval->pos_magic->mg_len
- = locinput - reginfo->strbeg;
+ MgBYTEPOS_set(reginfo->info_aux_eval->pos_magic,
+ reginfo->sv, reginfo->strbeg,
+ locinput - reginfo->strbeg);
if (sv_yes_mark) {
SV *sv_mrk = get_sv("REGMARK", 1);
if (reginfo->poscache_iter-- == 0) {
/* initialise cache */
- const I32 size = (reginfo->poscache_maxiter + 7)/8;
+ const SSize_t size = (reginfo->poscache_maxiter + 7)/8;
regmatch_info_aux *const aux = reginfo->info_aux;
if (aux->poscache) {
- if ((I32)reginfo->poscache_size < size) {
+ if ((SSize_t)reginfo->poscache_size < size) {
Renew(aux->poscache, size, char);
reginfo->poscache_size = size;
}
if (reginfo->poscache_iter < 0) {
/* have we already failed at this position? */
- I32 offset, mask;
+ SSize_t offset, mask;
reginfo->poscache_iter = -1; /* stop eventual underflow */
offset = (scan->flags & 0xf) - 1
S_core_regclass_swash(pTHX_ const regexp *prog, const regnode* node, bool doinit, SV** listsvp)
{
/* Returns the swash for the input 'node' in the regex 'prog'.
- * If <doinit> is true, will attempt to create the swash if not already
+ * If <doinit> is 'true', will attempt to create the swash if not already
* done.
- * If <listsvp> is non-null, will return the swash initialization string in
- * it.
+ * If <listsvp> is non-null, will return the printable contents of the
+ * swash. This can be used to get debugging information even before the
+ * swash exists, by calling this function with 'doinit' set to false, in
+ * which case the components that will be used to eventually create the
+ * swash are returned (in a printable form).
* Tied intimately to how regcomp.c sets up the data structure */
dVAR;
SV *sw = NULL;
- SV *si = NULL;
+ SV *si = NULL; /* Input swash initialization string */
SV* invlist = NULL;
RXi_GET_DECL(prog,progi);
/* Element [1] is reserved for the set-up swash. If already there,
* return it; if not, create it and store it there */
- if (SvROK(ary[1])) {
+ if (ary[1] && SvROK(ary[1])) {
sw = ary[1];
}
else if (si && doinit) {
}
}
+ /* If requested, return a printable version of what this swash matches */
if (listsvp) {
SV* matches_string = newSVpvn("", 0);
- /* Use the swash, if any, which has to have incorporated into it all
- * possibilities */
+ /* The swash should be used, if possible, to get the data, as it
+ * contains the resolved data. But this function can be called at
+ * compile-time, before everything gets resolved, in which case we
+ * return the currently best available information, which is the string
+ * that will eventually be used to do that resolving, 'si' */
if ((! sw || (invlist = _get_swash_invlist(sw)) == NULL)
&& (si && si != &PL_sv_undef))
{
-
- /* If no swash, use the input initialization string, if available */
sv_catsv(matches_string, si);
}
}
STATIC U8 *
-S_reghop3(U8 *s, I32 off, const U8* lim)
+S_reghop3(U8 *s, SSize_t off, const U8* lim)
{
/* return the position 'off' UTF-8 characters away from 's', forward if
* 'off' >= 0, backwards if negative. But don't go outside of position
we ifdef it out - dmq
*/
STATIC U8 *
-S_reghop4(U8 *s, I32 off, const U8* llim, const U8* rlim)
+S_reghop4(U8 *s, SSize_t off, const U8* llim, const U8* rlim)
{
dVAR;
#endif
STATIC U8 *
-S_reghopmaybe3(U8* s, I32 off, const U8* lim)
+S_reghopmaybe3(U8* s, SSize_t off, const U8* lim)
{
dVAR;
}
eval_state->pos_magic = mg;
eval_state->pos = mg->mg_len;
+ eval_state->pos_flags = mg->mg_flags;
}
else
eval_state->pos_magic = NULL;
RXp_MATCH_COPIED_on(rex);
}
if (eval_state->pos_magic)
+ {
eval_state->pos_magic->mg_len = eval_state->pos;
+ eval_state->pos_magic->mg_flags =
+ (eval_state->pos_magic->mg_flags & ~MGf_BYTES)
+ | (eval_state->pos_flags & MGf_BYTES);
+ }
PL_curpm = eval_state->curpm;
}
https://perl5.git.perl.org / perl5.git / blobdiff