#define regcpblow(cp) LEAVE_SCOPE(cp)
+#define TRYPAREN(paren, n, input) { \
+ if (paren) { \
+ if (n) { \
+ PL_regstartp[paren] = HOPc(input, -1) - PL_bostr; \
+ PL_regendp[paren] = input - PL_bostr; \
+ } \
+ else \
+ PL_regendp[paren] = -1; \
+ } \
+ if (regmatch(next)) \
+ sayYES; \
+ if (paren && n) \
+ PL_regendp[paren] = -1; \
+}
+
+
/*
* pregexec and friends
*/
|| ( (prog->reganch & ROPT_ANCH_BOL)
&& !PL_multiline ) ); /* Check after \n? */
- if ((prog->check_offset_min == prog->check_offset_max) && !ml_anch) {
+ if (!ml_anch) {
+ if ( !(prog->reganch & ROPT_ANCH_GPOS) /* Checked by the caller */
+ /* SvCUR is not set on references: SvRV and SvPVX overlap */
+ && sv && !SvROK(sv)
+ && (strpos + SvCUR(sv) != strend)) {
+ DEBUG_r(PerlIO_printf(Perl_debug_log, "Not at start...\n"));
+ goto fail;
+ }
+ if (prog->check_offset_min == prog->check_offset_max) {
/* Substring at constant offset from beg-of-str... */
I32 slen;
- if ( !(prog->reganch & ROPT_ANCH_GPOS) /* Checked by the caller */
- /* SvCUR is not set on references: SvRV and SvPVX overlap */
- && sv && !SvROK(sv)
- && (strpos + SvCUR(sv) != strend)) {
- DEBUG_r(PerlIO_printf(Perl_debug_log, "Not at start...\n"));
- goto fail;
- }
PL_regeol = strend; /* Used in HOP() */
s = HOPc(strpos, prog->check_offset_min);
if (SvTAIL(check)) {
&& 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;
than for "\n", so one should lower the limit for t? */
DEBUG_r(PerlIO_printf(Perl_debug_log, "Found /%s^%s/m, restarting lookup for check-string at offset %ld...\n",
PL_colors[0],PL_colors[1], (long)(t + 1 - i_strpos)));
- strpos = s = t + 1;
+ other_last = strpos = s = t + 1;
goto restart;
}
t++;
SvREFCNT_dec(prog->check_substr);
prog->check_substr = Nullsv; /* disable */
prog->float_substr = Nullsv; /* clear */
+ check = Nullsv; /* abort */
s = strpos;
/* XXXX This is a remnant of the old implementation. It
looks wasteful, since now INTUIT can use many
"Could not match STCLASS...\n") );
goto fail;
}
+ if (!check)
+ goto giveup;
DEBUG_r( PerlIO_printf(Perl_debug_log,
"Looking for %s substr starting at offset %ld...\n",
what, (long)(s + start_shift - i_strpos)) );
goto retry_floating_check;
/* Recheck anchored substring, but not floating... */
s = check_at;
+ if (!check)
+ goto giveup;
DEBUG_r( PerlIO_printf(Perl_debug_log,
"Looking for anchored substr starting at offset %ld...\n",
(long)(other_last - i_strpos)) );
current position only: */
if (ml_anch) {
s = t = t + 1;
+ if (!check)
+ goto giveup;
DEBUG_r( PerlIO_printf(Perl_debug_log,
"Looking for /%s^%s/m starting at offset %ld...\n",
PL_colors[0],PL_colors[1], (long)(t - i_strpos)) );
PerlIO_printf(Perl_debug_log,
"Does not contradict STCLASS...\n") );
}
- DEBUG_r(PerlIO_printf(Perl_debug_log, "%sGuessed:%s match at offset %ld\n",
- PL_colors[4], PL_colors[5], (long)(s - i_strpos)) );
+ giveup:
+ DEBUG_r(PerlIO_printf(Perl_debug_log, "%s%s:%s match at offset %ld\n",
+ PL_colors[4], (check ? "Guessed" : "Giving up"),
+ PL_colors[5], (long)(s - i_strpos)) );
return s;
fail_finish: /* Substring not found */
PL_reg_flags |= RF_tainted;
/* FALL THROUGH */
case BOUNDUTF8:
- tmp = (I32)(s != startpos) ? utf8_to_uv(reghop((U8*)s, -1), 0) : '\n';
+ tmp = (I32)(s != startpos) ? utf8_to_uv_chk(reghop((U8*)s, -1), 0, 0) : '\n';
tmp = ((OP(c) == BOUNDUTF8 ? isALNUM_uni(tmp) : isALNUM_LC_uni(tmp)) != 0);
while (s < strend) {
if (tmp == !(OP(c) == BOUNDUTF8 ?
PL_reg_flags |= RF_tainted;
/* FALL THROUGH */
case NBOUNDUTF8:
- tmp = (I32)(s != startpos) ? utf8_to_uv(reghop((U8*)s, -1), 0) : '\n';
+ tmp = (I32)(s != startpos) ? utf8_to_uv_chk(reghop((U8*)s, -1), 0, 0) : '\n';
tmp = ((OP(c) == NBOUNDUTF8 ? isALNUM_uni(tmp) : isALNUM_LC_uni(tmp)) != 0);
while (s < strend) {
if (tmp == !(OP(c) == NBOUNDUTF8 ?
}
sayNO;
case SBOL:
- if (locinput == PL_regbol && PL_regprev == '\n')
+ if (locinput == PL_bostr)
break;
sayNO;
case GPOS:
while (s < e) {
if (l >= PL_regeol)
sayNO;
- if (utf8_to_uv((U8*)s, 0) != (c1 ?
+ if (utf8_to_uv_chk((U8*)s, 0, 0) != (c1 ?
toLOWER_utf8((U8*)l) :
toLOWER_LC_utf8((U8*)l)))
{
case NBOUNDUTF8:
/* was last char in word? */
ln = (locinput != PL_regbol)
- ? utf8_to_uv(reghop((U8*)locinput, -1), 0) : PL_regprev;
+ ? utf8_to_uv_chk(reghop((U8*)locinput, -1), 0, 0) : PL_regprev;
if (OP(scan) == BOUNDUTF8 || OP(scan) == NBOUNDUTF8) {
ln = isALNUM_uni(ln);
n = swash_fetch(PL_utf8_alnum, (U8*)locinput);
sayNO;
}
/* PL_reginput == locinput now */
- if (paren) {
- if (ln) {
- PL_regstartp[paren] = HOPc(locinput, -1) - PL_bostr;
- PL_regendp[paren] = locinput - PL_bostr;
- }
- else
- PL_regendp[paren] = -1;
- }
- if (regmatch(next))
- sayYES;
+ TRYPAREN(paren, ln, locinput);
PL_reginput = locinput; /* Could be reset... */
REGCP_UNWIND;
/* Couldn't or didn't -- move forward. */
UCHARAT(PL_reginput) == c1 ||
UCHARAT(PL_reginput) == c2)
{
- if (paren) {
- if (n) {
- PL_regstartp[paren] = HOPc(PL_reginput, -1) - PL_bostr;
- PL_regendp[paren] = PL_reginput - PL_bostr;
- }
- else
- PL_regendp[paren] = -1;
- }
- if (regmatch(next))
- sayYES;
+ TRYPAREN(paren, n, PL_reginput);
REGCP_UNWIND;
}
/* Couldn't or didn't -- move forward. */
UCHARAT(PL_reginput) == c1 ||
UCHARAT(PL_reginput) == c2)
{
- if (paren && n) {
- if (n) {
- PL_regstartp[paren] = HOPc(PL_reginput, -1) - PL_bostr;
- PL_regendp[paren] = PL_reginput - PL_bostr;
- }
- else
- PL_regendp[paren] = -1;
- }
- if (regmatch(next))
- sayYES;
+ TRYPAREN(paren, n, PL_reginput);
REGCP_UNWIND;
}
/* Couldn't or didn't -- back up. */
UCHARAT(PL_reginput) == c1 ||
UCHARAT(PL_reginput) == c2)
{
- if (regmatch(next))
- sayYES;
+ TRYPAREN(paren, n, PL_reginput);
REGCP_UNWIND;
}
/* Couldn't or didn't -- back up. */
(ANYOF_CLASS_TEST(p, ANYOF_UPPER) && isUPPER_LC(c)) ||
(ANYOF_CLASS_TEST(p, ANYOF_NUPPER) && !isUPPER_LC(c)) ||
(ANYOF_CLASS_TEST(p, ANYOF_XDIGIT) && isXDIGIT(c)) ||
- (ANYOF_CLASS_TEST(p, ANYOF_NXDIGIT) && !isXDIGIT(c))
+ (ANYOF_CLASS_TEST(p, ANYOF_NXDIGIT) && !isXDIGIT(c)) ||
+ (ANYOF_CLASS_TEST(p, ANYOF_PSXSPC) && isPSXSPC(c)) ||
+ (ANYOF_CLASS_TEST(p, ANYOF_NPSXSPC) && !isPSXSPC(c)) ||
+ (ANYOF_CLASS_TEST(p, ANYOF_BLANK) && isBLANK(c)) ||
+ (ANYOF_CLASS_TEST(p, ANYOF_NBLANK) && !isBLANK(c))
) /* How's that for a conditional? */
{
match = TRUE;
PL_curpm = PL_reg_oldcurpm;
}
}
-