summaryrefslogtreecommitdiff
path: root/regexec.c
diff options
context:
space:
mode:
authorGurusamy Sarathy <gsar@cpan.org>2000-05-28 20:53:42 +0000
committerGurusamy Sarathy <gsar@cpan.org>2000-05-28 20:53:42 +0000
commitf5952150083836317649e1348b3d43ae1f7054a1 (patch)
tree474aea805d088d9535a4abb8b05a3c134c859580 /regexec.c
parent4ee3650ee977c6bdf13c668373fcfbfd0ae799dd (diff)
downloadperl-f5952150083836317649e1348b3d43ae1f7054a1.tar.gz
cosmetic fixups of RE debug output (from Ilya Zakharevich)
p4raw-id: //depot/perl@6152
Diffstat (limited to 'regexec.c')
-rw-r--r--regexec.c22
1 files changed, 14 insertions, 8 deletions
diff --git a/regexec.c b/regexec.c
index 60a5f6c1f9..1ae93150d6 100644
--- a/regexec.c
+++ b/regexec.c
@@ -634,15 +634,20 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
PL_colors[0],PL_colors[1]));
goto fail_finish;
}
+ else {
+ DEBUG_r(PerlIO_printf(Perl_debug_log, "Starting position does not contradict /%s^%s/m...\n",
+ PL_colors[0],PL_colors[1]));
+ }
s = t;
set_useful:
++BmUSEFUL(prog->check_substr); /* hooray/5 */
}
else {
PL_bostr = tmp;
- /* The found string does not prohibit matching at beg-of-str
+ /* The found string does not prohibit matching at strpos,
- no optimization of calling REx engine can be performed,
- unless it was an MBOL and we are not after MBOL. */
+ unless it was an MBOL and we are not after MBOL,
+ or a future STCLASS check will fail this. */
try_at_start:
/* Even in this situation we may use MBOL flag if strpos is offset
wrt the start of the string. */
@@ -655,8 +660,8 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
goto find_anchor;
}
DEBUG_r( if (ml_anch)
- PerlIO_printf(Perl_debug_log, "Does not contradict /%s^%s/m...\n",
- PL_colors[0],PL_colors[1]);
+ PerlIO_printf(Perl_debug_log, "Position at offset %ld does not contradict /%s^%s/m...\n",
+ (long)(strpos - i_strpos), PL_colors[0],PL_colors[1]);
);
success_at_start:
if (!(prog->reganch & ROPT_NAUGHTY) /* XXXX If strpos moved? */
@@ -665,6 +670,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
&& prog->check_substr == prog->float_substr)
{
/* If flags & SOMETHING - do not do it many times on the same match */
+ DEBUG_r(PerlIO_printf(Perl_debug_log, "... Disabling check substring...\n"));
SvREFCNT_dec(prog->check_substr);
prog->check_substr = Nullsv; /* disable */
prog->float_substr = Nullsv; /* clear */
@@ -731,7 +737,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
goto fail;
}
DEBUG_r( PerlIO_printf(Perl_debug_log,
- "Trying %s substr starting at offset %ld...\n",
+ "Looking for %s substr starting at offset %ld...\n",
what, (long)(s + start_shift - i_strpos)) );
goto restart;
}
@@ -741,7 +747,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
/* Recheck anchored substring, but not floating... */
s = check_at;
DEBUG_r( PerlIO_printf(Perl_debug_log,
- "Trying anchored substr starting at offset %ld...\n",
+ "Looking for anchored substr starting at offset %ld...\n",
(long)(other_last - i_strpos)) );
goto do_other_anchored;
}
@@ -750,8 +756,8 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
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)) );
+ "Looking for /%s^%s/m starting at offset %ld...\n",
+ PL_colors[0],PL_colors[1], (long)(t - i_strpos)) );
goto try_at_offset;
}
if (!prog->float_substr) /* Could have been deleted */