#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
*/
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 */
}
sayNO;
case SBOL:
- if (locinput == PL_regbol && PL_regprev == '\n')
+ if (locinput == PL_bostr)
break;
sayNO;
case GPOS:
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;
}
}
-