This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re: [ID 20000809.005] trouble with long string and /m modifier - uninitialized value
[perl5.git] / regexec.c
index 1ae9315..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++;
@@ -674,6 +690,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
            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
@@ -736,6 +753,8 @@ 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,
                                "Looking for %s substr starting at offset %ld...\n",
                                 what, (long)(s + start_shift - i_strpos)) );
@@ -746,6 +765,8 @@ 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,
                          "Looking for anchored substr starting at offset %ld...\n",
                          (long)(other_last - i_strpos)) );
@@ -755,6 +776,8 @@ 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,
                          "Looking for /%s^%s/m starting at offset %ld...\n",
                          PL_colors[0],PL_colors[1], (long)(t - i_strpos)) );
@@ -776,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 */
@@ -1881,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:
@@ -3035,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. */
@@ -3058,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. */
@@ -3101,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. */
@@ -3125,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. */