I32 slen;
if ( !(prog->reganch & ROPT_ANCH_GPOS) /* Checked by the caller */
- && (sv && (strpos + SvCUR(sv) != strend)) ) {
+ /* 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;
}
try_at_start:
/* Even in this situation we may use MBOL flag if strpos is offset
wrt the start of the string. */
- if (ml_anch && sv
+ if (ml_anch && sv && !SvROK(sv) /* See prev comment on SvROK */
&& (strpos + SvCUR(sv) != strend) && strpos[-1] != '\n'
/* May be due to an implicit anchor of m{.*foo} */
&& !(prog->reganch & ROPT_IMPLICIT))
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
+ /* 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. */
/* we have /x+whatever/ */
/* it must be a one character string (XXXX Except UTF?) */
char ch = SvPVX(prog->anchored_substr)[0];
+#ifdef DEBUGGING
+ int did_match = 0;
+#endif
+
if (UTF) {
while (s < strend) {
if (*s == ch) {
+ DEBUG_r( did_match = 1 );
if (regtry(prog, s)) goto got_it;
s += UTF8SKIP(s);
while (s < strend && *s == ch)
else {
while (s < strend) {
if (*s == ch) {
+ DEBUG_r( did_match = 1 );
if (regtry(prog, s)) goto got_it;
s++;
while (s < strend && *s == ch)
s++;
}
}
+ DEBUG_r(did_match ||
+ PerlIO_printf(Perl_debug_log,
+ "Did not find anchored character...\n"));
}
/*SUPPRESS 560*/
else if (prog->anchored_substr != Nullsv
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 */
+#ifdef DEBUGGING
+ int did_match = 0;
+#endif
if (s > PL_bostr)
last1 = HOPc(s, -1);
: (s = fbm_instr((unsigned char*)HOP(s, back_min),
(unsigned char*)strend, must,
PL_multiline ? FBMrf_MULTILINE : 0))) ) {
+ DEBUG_r( did_match = 1 );
if (HOPc(s, -back_max) > last1) {
last1 = HOPc(s, -back_min);
s = HOPc(s, -back_max);
}
}
}
+ DEBUG_r(did_match ||
+ PerlIO_printf(Perl_debug_log, "Did not find %s substr `%s%.*s%s'%s...\n",
+ ((must == prog->anchored_substr)
+ ? "anchored" : "floating"),
+ PL_colors[0],
+ (int)(SvCUR(must) - (SvTAIL(must)!=0)),
+ SvPVX(must),
+ PL_colors[1], (SvTAIL(must) ? "$" : "")));
goto phooey;
}
- else if (c = prog->regstclass) {
+ else if ((c = prog->regstclass)) {
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;
+ DEBUG_r(PerlIO_printf(Perl_debug_log, "Contradicts stclass...\n"));
}
else {
dontbother = 0;
if (prog->float_substr != Nullsv) { /* Trim the end. */
char *last;
- I32 oldpos = scream_pos;
if (flags & REXEC_SCREAM) {
last = screaminstr(sv, prog->float_substr, s - strbeg,
last = strend; /* matching `$' */
}
}
- if (last == NULL) goto phooey; /* Should not happen! */
+ if (last == NULL) {
+ DEBUG_r(PerlIO_printf(Perl_debug_log,
+ "%sCan't trim the tail, match fails (should not happen)%s\n",
+ PL_colors[4],PL_colors[5]));
+ goto phooey; /* Should not happen! */
+ }
dontbother = strend - last + prog->float_min_offset;
}
if (minlen && (dontbother < minlen))
return 1;
phooey:
+ DEBUG_r(PerlIO_printf(Perl_debug_log, "%sMatch failed%s\n",
+ PL_colors[4],PL_colors[5]));
if (PL_reg_eval_set)
restore_pos(aTHXo_ 0);
return 0;
nextchr = UCHARAT(locinput);
break;
}
- if (!nextchr && locinput >= PL_regeol || nextchr == '\n')
+ if ((!nextchr && locinput >= PL_regeol) || nextchr == '\n')
sayNO;
nextchr = UCHARAT(++locinput);
break;
case REG_ANY:
- if (!nextchr && locinput >= PL_regeol || nextchr == '\n')
+ if ((!nextchr && locinput >= PL_regeol) || nextchr == '\n')
sayNO;
nextchr = UCHARAT(++locinput);
break;
*PL_reglastparen = n;
scan = next;
/*SUPPRESS 560*/
- if (n = (c1 == BRANCH ? NEXT_OFF(next) : ARG(next)))
+ if ((n = (c1 == BRANCH ? NEXT_OFF(next) : ARG(next))))
next += n;
else
next = NULL;
if (swash_fetch(sv, p))
match = TRUE;
else if (flags & ANYOF_FOLD) {
- I32 cf;
U8 tmpbuf[UTF8_MAXLEN];
if (flags & ANYOF_LOCALE) {
PL_reg_flags |= RF_tainted;