Add byteorder to the myconfig output.

[perl5.git] / regexec.c

diff --git a/regexec.c b/regexec.c
index 60a5f6c..cbc8c19 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -221,6 +221,22 @@ typedef struct re_cc_state
 
 #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
  */
@@ -625,7 +641,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
                       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++;
@@ -634,15 +650,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 +676,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,9 +686,11 @@ 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 */
+           check = Nullsv;                     /* abort */
            s = strpos;
            /* XXXX This is a remnant of the old implementation.  It
                    looks wasteful, since now INTUIT can use many
@@ -730,8 +753,10 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
                                               "Could not match STCLASS...\n") );
                        goto fail;
                    }
+                   if (!check)
+                       goto giveup;
                    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;
                }
@@ -740,8 +765,10 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *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,
-                         "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;
            }
@@ -749,9 +776,11 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
                current position only: */
            if (ml_anch) {
                s = t = t + 1;
+               if (!check)
+                   goto giveup;
                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 */
@@ -770,8 +799,10 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *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 */
@@ -1875,7 +1906,7 @@ S_regmatch(pTHX_ regnode *prog)
            }
            sayNO;
        case SBOL:
-           if (locinput == PL_regbol && PL_regprev == '\n')
+           if (locinput == PL_bostr)
                break;
            sayNO;
        case GPOS:
@@ -3029,16 +3060,7 @@ S_regmatch(pTHX_ regnode *prog)
                                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. */
@@ -3052,16 +3074,7 @@ S_regmatch(pTHX_ regnode *prog)
                        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. */
@@ -3095,16 +3108,7 @@ S_regmatch(pTHX_ regnode *prog)
                            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. */
@@ -3119,8 +3123,7 @@ S_regmatch(pTHX_ regnode *prog)
                            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. */