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 (file)
--- 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 */