*
**** Alterations to Henry's code are...
****
- **** Copyright (c) 1991-1999, Larry Wall
+ **** Copyright (c) 1991-2000, Larry Wall
****
**** You may distribute under the terms of either the GNU General Public
**** License or the Artistic License, as specified in the README file.
PL_reg_re = prog;
}
-static char *find_byclass(regexp * prog, regnode *c, char *s, char *strend,
- char *startpos, I32 norun);
-
/*
* Need to implement the following flags for reg_anch:
*
DEBUG_r(PerlIO_printf(Perl_debug_log, "String too short...\n"));
goto fail;
}
+ check = prog->check_substr;
if (prog->reganch & ROPT_ANCH) { /* Match at beg-of-str or after \n */
ml_anch = !( (prog->reganch & ROPT_ANCH_SINGLE)
|| ( (prog->reganch & ROPT_ANCH_BOL)
}
PL_regeol = strend; /* Used in HOP() */
s = HOPc(strpos, prog->check_offset_min);
- if (SvTAIL(prog->check_substr)) {
- slen = SvCUR(prog->check_substr); /* >= 1 */
+ if (SvTAIL(check)) {
+ slen = SvCUR(check); /* >= 1 */
if ( strend - s > slen || strend - s < slen - 1
|| (strend - s == slen && strend[-1] != '\n')) {
}
/* Now should match s[0..slen-2] */
slen--;
- if (slen && (*SvPVX(prog->check_substr) != *s
+ if (slen && (*SvPVX(check) != *s
|| (slen > 1
- && memNE(SvPVX(prog->check_substr), s, slen)))) {
+ && memNE(SvPVX(check), s, slen)))) {
report_neq:
DEBUG_r(PerlIO_printf(Perl_debug_log, "String not equal...\n"));
goto fail_finish;
}
}
- else if (*SvPVX(prog->check_substr) != *s
- || ((slen = SvCUR(prog->check_substr)) > 1
- && memNE(SvPVX(prog->check_substr), s, slen)))
+ else if (*SvPVX(check) != *s
+ || ((slen = SvCUR(check)) > 1
+ && memNE(SvPVX(check), s, slen)))
goto report_neq;
goto success_at_start;
}
/* Match is anchored, but substr is not anchored wrt beg-of-str. */
s = strpos;
start_shift = prog->check_offset_min; /* okay to underestimate on CC */
- /* Should be nonnegative! */
end_shift = prog->minlen - start_shift -
- CHR_SVLEN(prog->check_substr) + (SvTAIL(prog->check_substr) != 0);
+ CHR_SVLEN(check) + (SvTAIL(check) != 0);
if (!ml_anch) {
- I32 end = prog->check_offset_max + CHR_SVLEN(prog->check_substr)
- - (SvTAIL(prog->check_substr) != 0);
+ I32 end = prog->check_offset_max + CHR_SVLEN(check)
+ - (SvTAIL(check) != 0);
I32 eshift = strend - s - end;
if (end_shift < eshift)
start_shift = prog->check_offset_min; /* okay to underestimate on CC */
/* Should be nonnegative! */
end_shift = prog->minlen - start_shift -
- CHR_SVLEN(prog->check_substr) + (SvTAIL(prog->check_substr) != 0);
+ CHR_SVLEN(check) + (SvTAIL(check) != 0);
}
#ifdef DEBUGGING /* 7/99: reports of failure (with the older version) */
Perl_croak(aTHX_ "panic: end_shift");
#endif
- check = prog->check_substr;
restart:
/* Find a possible match in the region s..strend by looking for
the "check" substring in the region corrected by start/end_shift. */
/* Even in this situation we may use MBOL flag if strpos is offset
wrt the start of the string. */
if (ml_anch && sv
- && (strpos + SvCUR(sv) != strend) && strpos[-1] != '\n') {
+ && (strpos + SvCUR(sv) != strend) && strpos[-1] != '\n'
+ /* May be due to an implicit anchor of m{.*foo} */
+ && !(prog->reganch & ROPT_IMPLICIT))
+ {
t = strpos;
goto find_anchor;
}
);
success_at_start:
if (!(prog->reganch & ROPT_NAUGHTY) /* XXXX If strpos moved? */
+ && prog->check_substr /* Could be deleted already */
&& --BmUSEFUL(prog->check_substr) < 0
- && prog->check_substr == prog->float_substr) { /* boo */
+ && prog->check_substr == prog->float_substr)
+ {
/* If flags & SOMETHING - do not do it many times on the same match */
SvREFCNT_dec(prog->check_substr);
prog->check_substr = Nullsv; /* disable */
s = strpos;
/* XXXX This is a remnant of the old implementation. It
looks wasteful, since now INTUIT can use many
- other heuristics too. */
+ other heuristics. */
prog->reganch &= ~RE_USE_INTUIT;
}
else
regstclass does not come from lookahead... */
/* If regstclass takes bytelength more than 1: If charlength==1, OK.
This leaves EXACTF only, which is dealt with in find_byclass(). */
+ int cl_l = (PL_regkind[(U8)OP(prog->regstclass)] == EXACT
+ ? STR_LEN(prog->regstclass)
+ : 1);
char *endpos = (prog->anchored_substr || ml_anch)
- ? s + (prog->minlen? 1 : 0)
- : (prog->float_substr ? check_at - start_shift + 1
+ ? s + (prog->minlen? cl_l : 0)
+ : (prog->float_substr ? check_at - start_shift + cl_l
: strend) ;
char *startpos = sv ? strend - SvCUR(sv) : s;
t = s;
+ if (prog->reganch & ROPT_UTF8) {
+ PL_regdata = prog->data; /* Used by REGINCLASS UTF logic */
+ PL_bostr = startpos;
+ }
s = find_byclass(prog, prog->regstclass, s, endpos, startpos, 1);
if (!s) {
#ifdef DEBUGGING
"Could not match STCLASS...\n") );
goto fail;
}
+ DEBUG_r( PerlIO_printf(Perl_debug_log,
+ "This position contradicts STCLASS...\n") );
+ if ((prog->reganch & ROPT_ANCH) && !ml_anch)
+ goto fail;
/* Contradict one of substrings */
if (prog->anchored_substr) {
- DEBUG_r( PerlIO_printf(Perl_debug_log,
- "This position contradicts STCLASS...\n") );
if (prog->anchored_substr == check) {
DEBUG_r( what = "anchored" );
hop_and_restart:
PL_regeol = strend; /* Used in HOP() */
s = HOPc(t, 1);
+ if (s + start_shift + end_shift > strend) {
+ /* XXXX Should be taken into account earlier? */
+ DEBUG_r( PerlIO_printf(Perl_debug_log,
+ "Could not match STCLASS...\n") );
+ goto fail;
+ }
DEBUG_r( PerlIO_printf(Perl_debug_log,
- "trying %s substr starting at offset %ld...\n",
+ "Trying %s substr starting at offset %ld...\n",
what, (long)(s + start_shift - i_strpos)) );
goto restart;
}
- /* Have both, check is floating */
+ /* Have both, check_string is floating */
if (t + start_shift >= check_at) /* Contradicts floating=check */
goto retry_floating_check;
/* Recheck anchored substring, but not floating... */
s = check_at;
DEBUG_r( PerlIO_printf(Perl_debug_log,
- "trying anchored substr starting at offset %ld...\n",
+ "Trying anchored substr starting at offset %ld...\n",
(long)(other_last - i_strpos)) );
goto do_other_anchored;
}
+ /* Another way we could have checked stclass at the
+ current position only: */
+ if (ml_anch) {
+ s = t = t + 1;
+ DEBUG_r( PerlIO_printf(Perl_debug_log,
+ "Trying /^/m starting at offset %ld...\n",
+ (long)(t - i_strpos)) );
+ goto try_at_offset;
+ }
+ if (!prog->float_substr) /* Could have been deleted */
+ goto fail;
/* Check is floating subtring. */
retry_floating_check:
t = check_at - start_shift;
return s;
fail_finish: /* Substring not found */
- BmUSEFUL(prog->check_substr) += 5; /* hooray */
+ if (prog->check_substr) /* could be removed already */
+ BmUSEFUL(prog->check_substr) += 5; /* hooray */
fail:
DEBUG_r(PerlIO_printf(Perl_debug_log, "%sMatch rejected by optimizer%s\n",
PL_colors[4],PL_colors[5]));
return Nullch;
}
-/*
- - regexec_flags - match a regexp against a string
- */
-I32
-Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *strend,
- char *strbeg, I32 minend, SV *sv, void *data, U32 flags)
-/* strend: pointer to null at end of string */
-/* strbeg: real beginning of string */
-/* minend: end of match must be >=minend after stringarg. */
-/* data: May be used for some additional optimizations. */
-/* nosave: For optimizations. */
+/* We know what class REx starts with. Try to find this position... */
+STATIC char *
+S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *startpos, I32 norun)
{
- dTHR;
- register char *s;
- register regnode *c;
- register char *startpos = stringarg;
- register I32 tmp;
- I32 minlen; /* must match at least this many chars */
- I32 dontbother = 0; /* how many characters not to try at end */
- I32 start_shift = 0; /* Offset of the start to find
- constant substr. */ /* CC */
- I32 end_shift = 0; /* Same for the end. */ /* CC */
- I32 scream_pos = -1; /* Internal iterator of scream. */
- char *scream_olds;
- SV* oreplsv = GvSV(PL_replgv);
-
- PL_regcc = 0;
-
- cache_re(prog);
-#ifdef DEBUGGING
- PL_regnarrate = PL_debug & 512;
-#endif
-
- /* Be paranoid... */
- if (prog == NULL || startpos == NULL) {
- Perl_croak(aTHX_ "NULL regexp parameter");
- return 0;
- }
-
- minlen = prog->minlen;
- if (strend - startpos < minlen) goto phooey;
-
- if (startpos == strbeg) /* is ^ valid at stringarg? */
- PL_regprev = '\n';
- else {
- PL_regprev = (U32)stringarg[-1];
- if (!PL_multiline && PL_regprev == '\n')
- PL_regprev = '\0'; /* force ^ to NOT match */
- }
-
- /* Check validity of program. */
- if (UCHARAT(prog->program) != REG_MAGIC) {
- Perl_croak(aTHX_ "corrupted regexp program");
- }
-
- PL_reg_flags = 0;
- PL_reg_eval_set = 0;
- PL_reg_maxiter = 0;
-
- if (prog->reganch & ROPT_UTF8)
- PL_reg_flags |= RF_utf8;
-
- /* Mark beginning of line for ^ and lookbehind. */
- PL_regbol = startpos;
- PL_bostr = strbeg;
- PL_reg_sv = sv;
-
- /* Mark end of line for $ (and such) */
- PL_regeol = strend;
-
- /* see how far we have to get to not match where we matched before */
- PL_regtill = startpos+minend;
-
- /* We start without call_cc context. */
- PL_reg_call_cc = 0;
-
- /* If there is a "must appear" string, look for it. */
- s = startpos;
-
- if (prog->reganch & ROPT_GPOS_SEEN) { /* Need to have PL_reg_ganch */
- MAGIC *mg;
-
- if (flags & REXEC_IGNOREPOS) /* Means: check only at start */
- PL_reg_ganch = startpos;
- else if (sv && SvTYPE(sv) >= SVt_PVMG
- && SvMAGIC(sv)
- && (mg = mg_find(sv, 'g')) && mg->mg_len >= 0) {
- PL_reg_ganch = strbeg + mg->mg_len; /* Defined pos() */
- if (prog->reganch & ROPT_ANCH_GPOS) {
- if (s > PL_reg_ganch)
- goto phooey;
- s = PL_reg_ganch;
- }
- }
- else /* pos() not defined */
- PL_reg_ganch = strbeg;
- }
-
- if (!(flags & REXEC_CHECKED) && prog->check_substr != Nullsv) {
- re_scream_pos_data d;
-
- d.scream_olds = &scream_olds;
- d.scream_pos = &scream_pos;
- s = re_intuit_start(prog, sv, s, strend, flags, &d);
- if (!s)
- goto phooey; /* not present */
- }
-
- DEBUG_r( if (!PL_colorset) reginitcolors() );
- DEBUG_r(PerlIO_printf(Perl_debug_log,
- "%sMatching REx%s `%s%.60s%s%s' against `%s%.*s%s%s'\n",
- PL_colors[4],PL_colors[5],PL_colors[0],
- prog->precomp,
- PL_colors[1],
- (strlen(prog->precomp) > 60 ? "..." : ""),
- PL_colors[0],
- (int)(strend - startpos > 60 ? 60 : strend - startpos),
- startpos, PL_colors[1],
- (strend - startpos > 60 ? "..." : ""))
- );
-
- /* Simplest case: anchored match need be tried only once. */
- /* [unless only anchor is BOL and multiline is set] */
- if (prog->reganch & (ROPT_ANCH & ~ROPT_ANCH_GPOS)) {
- if (s == startpos && regtry(prog, startpos))
- goto got_it;
- else if (PL_multiline || (prog->reganch & ROPT_IMPLICIT)
- || (prog->reganch & ROPT_ANCH_MBOL)) /* XXXX SBOL? */
- {
- char *end;
-
- if (minlen)
- dontbother = minlen - 1;
- end = HOPc(strend, -dontbother) - 1;
- /* for multiline we only have to try after newlines */
- if (prog->check_substr) {
- if (s == startpos)
- goto after_try;
- while (1) {
- if (regtry(prog, s))
- goto got_it;
- after_try:
- if (s >= end)
- goto phooey;
- if (prog->reganch & RE_USE_INTUIT) {
- s = re_intuit_start(prog, sv, s + 1, strend, flags, NULL);
- if (!s)
- goto phooey;
- }
- else
- s++;
- }
- } else {
- if (s > startpos)
- s--;
- while (s < end) {
- if (*s++ == '\n') { /* don't need PL_utf8skip here */
- if (regtry(prog, s))
- goto got_it;
- }
- }
- }
- }
- goto phooey;
- } else if (prog->reganch & ROPT_ANCH_GPOS) {
- if (regtry(prog, PL_reg_ganch))
- goto got_it;
- goto phooey;
- }
-
- /* Messy cases: unanchored match. */
- if (prog->anchored_substr && prog->reganch & ROPT_SKIP) {
- /* we have /x+whatever/ */
- /* it must be a one character string (XXXX Except UTF?) */
- char ch = SvPVX(prog->anchored_substr)[0];
- if (UTF) {
- while (s < strend) {
- if (*s == ch) {
- if (regtry(prog, s)) goto got_it;
- s += UTF8SKIP(s);
- while (s < strend && *s == ch)
- s += UTF8SKIP(s);
- }
- s += UTF8SKIP(s);
- }
- }
- else {
- while (s < strend) {
- if (*s == ch) {
- if (regtry(prog, s)) goto got_it;
- s++;
- while (s < strend && *s == ch)
- s++;
- }
- s++;
- }
- }
- }
- /*SUPPRESS 560*/
- else if (prog->anchored_substr != Nullsv
- || (prog->float_substr != Nullsv
- && prog->float_max_offset < strend - s)) {
- SV *must = prog->anchored_substr
- ? prog->anchored_substr : prog->float_substr;
- I32 back_max =
- prog->anchored_substr ? prog->anchored_offset : prog->float_max_offset;
- I32 back_min =
- prog->anchored_substr ? prog->anchored_offset : prog->float_min_offset;
- I32 delta = back_max - back_min;
- char *last = HOPc(strend, /* Cannot start after this */
- -(I32)(CHR_SVLEN(must)
- - (SvTAIL(must) != 0) + back_min));
- char *last1; /* Last position checked before */
-
- if (s > PL_bostr)
- last1 = HOPc(s, -1);
- else
- last1 = s - 1; /* bogus */
-
- /* XXXX check_substr already used to find `s', can optimize if
- check_substr==must. */
- scream_pos = -1;
- dontbother = end_shift;
- strend = HOPc(strend, -dontbother);
- while ( (s <= last) &&
- ((flags & REXEC_SCREAM)
- ? (s = screaminstr(sv, must, HOPc(s, back_min) - strbeg,
- end_shift, &scream_pos, 0))
- : (s = fbm_instr((unsigned char*)HOP(s, back_min),
- (unsigned char*)strend, must,
- PL_multiline ? FBMrf_MULTILINE : 0))) ) {
- if (HOPc(s, -back_max) > last1) {
- last1 = HOPc(s, -back_min);
- s = HOPc(s, -back_max);
- }
- else {
- char *t = (last1 >= PL_bostr) ? HOPc(last1, 1) : last1 + 1;
-
- last1 = HOPc(s, -back_min);
- s = t;
- }
- if (UTF) {
- while (s <= last1) {
- if (regtry(prog, s))
- goto got_it;
- s += UTF8SKIP(s);
- }
- }
- else {
- while (s <= last1) {
- if (regtry(prog, s))
- goto got_it;
- s++;
- }
- }
- }
- goto phooey;
- }
- else if (c = prog->regstclass) {
I32 doevery = (prog->reganch & ROPT_SKIP) == 0;
char *m;
int ln;
int c1;
int c2;
char *e;
+ register I32 tmp = 1; /* Scratch variable? */
- if (minlen)
- dontbother = minlen - 1;
- strend = HOPc(strend, -dontbother); /* don't bother with what can't match */
- tmp = 1;
/* We know what class it must start with. */
switch (OP(c)) {
case ANYOFUTF8:
while (s < strend) {
if (REGINCLASSUTF8(c, (U8*)s)) {
- if (tmp && regtry(prog, s))
+ if (tmp && (norun || regtry(prog, s)))
goto got_it;
else
tmp = doevery;
case ANYOF:
while (s < strend) {
if (REGINCLASS(c, *s)) {
- if (tmp && regtry(prog, s))
+ if (tmp && (norun || regtry(prog, s)))
goto got_it;
else
tmp = doevery;
do_exactf:
e = strend - ln;
+ if (norun && e < s)
+ e = s; /* Due to minlen logic of intuit() */
/* Here it is NOT UTF! */
if (c1 == c2) {
while (s <= e) {
if ( *s == c1
- && (ln == 1 || (OP(c) == EXACTF
- ? ibcmp(s, m, ln)
- : ibcmp_locale(s, m, ln)))
+ && (ln == 1 || !(OP(c) == EXACTF
+ ? ibcmp(s, m, ln)
+ : ibcmp_locale(s, m, ln)))
&& (norun || regtry(prog, s)) )
goto got_it;
s++;
} else {
while (s <= e) {
if ( (*s == c1 || *s == c2)
- && (ln == 1 || (OP(c) == EXACTF
- ? ibcmp(s, m, ln)
- : ibcmp_locale(s, m, ln)))
+ && (ln == 1 || !(OP(c) == EXACTF
+ ? ibcmp(s, m, ln)
+ : ibcmp_locale(s, m, ln)))
&& (norun || regtry(prog, s)) )
goto got_it;
s++;
/* FALL THROUGH */
case BOUNDUTF8:
tmp = (I32)(s != startpos) ? utf8_to_uv(reghop((U8*)s, -1), 0) : '\n';
- tmp = ((OP(c) == BOUND ? isALNUM_uni(tmp) : isALNUM_LC_uni(tmp)) != 0);
+ tmp = ((OP(c) == BOUNDUTF8 ? isALNUM_uni(tmp) : isALNUM_LC_uni(tmp)) != 0);
while (s < strend) {
- if (tmp == !(OP(c) == BOUND ?
+ if (tmp == !(OP(c) == BOUNDUTF8 ?
swash_fetch(PL_utf8_alnum, (U8*)s) :
isALNUM_LC_utf8((U8*)s)))
{
PL_reg_flags |= RF_tainted;
/* FALL THROUGH */
case NBOUNDUTF8:
- if (prog->minlen)
- strend = reghop_c(strend, -1);
tmp = (I32)(s != startpos) ? utf8_to_uv(reghop((U8*)s, -1), 0) : '\n';
- tmp = ((OP(c) == NBOUND ? isALNUM_uni(tmp) : isALNUM_LC_uni(tmp)) != 0);
+ tmp = ((OP(c) == NBOUNDUTF8 ? isALNUM_uni(tmp) : isALNUM_LC_uni(tmp)) != 0);
while (s < strend) {
- if (tmp == !(OP(c) == NBOUND ?
+ if (tmp == !(OP(c) == NBOUNDUTF8 ?
swash_fetch(PL_utf8_alnum, (U8*)s) :
isALNUM_LC_utf8((U8*)s)))
tmp = !tmp;
PL_colors[1],
(strlen(prog->precomp) > 60 ? "..." : ""),
PL_colors[0],
- (strend - startpos > 60 ? 60 : strend - startpos),
+ (int)(strend - startpos > 60 ? 60 : strend - startpos),
startpos, PL_colors[1],
(strend - startpos > 60 ? "..." : ""))
);
after_try:
if (s >= end)
goto phooey;
- s = re_intuit_start(prog, sv, s + 1, strend, flags, NULL);
- if (!s)
- goto phooey;
+ if (prog->reganch & RE_USE_INTUIT) {
+ s = re_intuit_start(prog, sv, s + 1, strend, flags, NULL);
+ if (!s)
+ goto phooey;
+ }
+ else
+ s++;
}
} else {
if (s > startpos)
goto phooey;
}
else if (c = prog->regstclass) {
- if (minlen) /* don't bother with what can't match */
+ if (minlen && PL_regkind[(U8)OP(prog->regstclass)] != EXACT)
+ /* don't bother with what can't match */
strend = HOPc(strend, -(minlen - 1));
if (find_byclass(prog, c, s, strend, startpos, 0))
goto got_it;
PerlIO_printf(Perl_debug_log, " setting stack tmpbase at %"IVdf"\n",
(IV)(PL_stack_sp - PL_stack_base));
));
- SAVEINT(cxstack[cxstack_ix].blk_oldsp);
+ SAVEI32(cxstack[cxstack_ix].blk_oldsp);
cxstack[cxstack_ix].blk_oldsp = PL_stack_sp - PL_stack_base;
/* Otherwise OP_NEXTSTATE will free whatever on stack now. */
SAVETMPS;
/* Apparently this is not needed, judging by wantarray. */
- /* SAVEINT(cxstack[cxstack_ix].blk_gimme);
+ /* SAVEI8(cxstack[cxstack_ix].blk_gimme);
cxstack[cxstack_ix].blk_gimme = G_SCALAR; */
if (PL_reg_sv) {
SAVEDESTRUCTOR_X(restore_pos, 0);
}
if (!PL_reg_curpm)
- New(22,PL_reg_curpm, 1, PMOP);
+ Newz(22,PL_reg_curpm, 1, PMOP);
PL_reg_curpm->op_pmregexp = prog;
PL_reg_oldcurpm = PL_curpm;
PL_curpm = PL_reg_curpm;
PL_reg_flags |= RF_tainted;
/* FALL THROUGH */
case SPACE:
- if (!nextchr && locinput >= PL_regeol)
+ if (!nextchr)
sayNO;
if (!(OP(scan) == SPACE
? isSPACE(nextchr) : isSPACE_LC(nextchr)))
PL_reg_flags |= RF_tainted;
/* FALL THROUGH */
case SPACEUTF8:
- if (!nextchr && locinput >= PL_regeol)
+ if (!nextchr)
sayNO;
if (nextchr & 0x80) {
if (!(OP(scan) == SPACEUTF8
- ? swash_fetch(PL_utf8_space,(U8*)locinput)
+ ? swash_fetch(PL_utf8_space, (U8*)locinput)
: isSPACE_LC_utf8((U8*)locinput)))
{
sayNO;
PL_reg_flags |= RF_tainted;
/* FALL THROUGH */
case NSPACE:
- if (!nextchr)
+ if (!nextchr && locinput >= PL_regeol)
sayNO;
- if (OP(scan) == SPACE
+ if (OP(scan) == NSPACE
? isSPACE(nextchr) : isSPACE_LC(nextchr))
sayNO;
nextchr = UCHARAT(++locinput);
PL_reg_flags |= RF_tainted;
/* FALL THROUGH */
case NSPACEUTF8:
- if (!nextchr)
+ if (!nextchr && locinput >= PL_regeol)
sayNO;
if (nextchr & 0x80) {
if (OP(scan) == NSPACEUTF8
- ? swash_fetch(PL_utf8_space,(U8*)locinput)
+ ? swash_fetch(PL_utf8_space, (U8*)locinput)
: isSPACE_LC_utf8((U8*)locinput))
{
sayNO;
PL_reg_flags |= RF_tainted;
/* FALL THROUGH */
case DIGIT:
- if (!nextchr && locinput >= PL_regeol)
+ if (!nextchr)
sayNO;
if (!(OP(scan) == DIGIT
? isDIGIT(nextchr) : isDIGIT_LC(nextchr)))
if (!nextchr)
sayNO;
if (nextchr & 0x80) {
- if (OP(scan) == NDIGITUTF8
- ? swash_fetch(PL_utf8_digit,(U8*)locinput)
- : isDIGIT_LC_utf8((U8*)locinput))
+ if (!(OP(scan) == DIGITUTF8
+ ? swash_fetch(PL_utf8_digit, (U8*)locinput)
+ : isDIGIT_LC_utf8((U8*)locinput)))
{
sayNO;
}
nextchr = UCHARAT(locinput);
break;
}
- if (!isDIGIT(nextchr))
+ if (!(OP(scan) == DIGITUTF8
+ ? isDIGIT(nextchr) : isDIGIT_LC(nextchr)))
sayNO;
nextchr = UCHARAT(++locinput);
break;
PL_reg_flags |= RF_tainted;
/* FALL THROUGH */
case NDIGIT:
- if (!nextchr)
+ if (!nextchr && locinput >= PL_regeol)
sayNO;
- if (OP(scan) == DIGIT
+ if (OP(scan) == NDIGIT
? isDIGIT(nextchr) : isDIGIT_LC(nextchr))
sayNO;
nextchr = UCHARAT(++locinput);
if (!nextchr && locinput >= PL_regeol)
sayNO;
if (nextchr & 0x80) {
- if (swash_fetch(PL_utf8_digit,(U8*)locinput))
+ if (OP(scan) == NDIGITUTF8
+ ? swash_fetch(PL_utf8_digit, (U8*)locinput)
+ : isDIGIT_LC_utf8((U8*)locinput))
+ {
sayNO;
+ }
locinput += PL_utf8skip[nextchr];
nextchr = UCHARAT(locinput);
break;
}
- if (isDIGIT(nextchr))
+ if (OP(scan) == NDIGITUTF8
+ ? isDIGIT(nextchr) : isDIGIT_LC(nextchr))
sayNO;
nextchr = UCHARAT(++locinput);
break;
I32 onpar = PL_regnpar;
pm.op_pmflags = 0;
+ pm.op_pmdynflags = (UTF||DO_UTF8(ret) ? PMdf_UTF8 : 0);
re = CALLREGCOMP(aTHX_ t, t + len, &pm);
if (!(SvFLAGS(ret)
& (SVs_TEMP | SVs_PADTMP | SVf_READONLY)))
projects / p5sagit/p5-mst-13.2.git / blobdiff