From: Gurusamy Sarathy <gsar@cpan.org>
Date: Sun, 28 May 2000 20:53:42 +0000 (+0000)
Subject: cosmetic fixups of RE debug output (from Ilya Zakharevich)
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f5952150083836317649e1348b3d43ae1f7054a1;p=p5sagit%2Fp5-mst-13.2.git

cosmetic fixups of RE debug output (from Ilya Zakharevich)

p4raw-id: //depot/perl@6152
---

diff --git a/regexec.c b/regexec.c
index 60a5f6c..1ae9315 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 */