const declaration fixup
[p5sagit/p5-mst-13.2.git] / regexec.c
index 55cc437..a6fd6ae 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -541,6 +541,9 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
                            start_shift + (s - strbeg), end_shift, pp, 0);
        else
            goto fail_finish;
+       /* we may be pointing at the wrong string */
+       if (s && RX_MATCH_COPIED(prog))
+           s = prog->subbeg + (s - SvPVX(sv));
        if (data)
            *data->scream_olds = s;
     }
@@ -595,7 +598,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
 
                t = s - prog->check_offset_max;
                if (s - strpos > prog->check_offset_max  /* signed-corrected t > strpos */
-                   && (!(prog->reganch & ROPT_UTF8)
+                   && (!do_utf8
                        || ((t = reghopmaybe3_c(s, -(prog->check_offset_max), strpos))
                            && t > strpos)))
                    /* EMPTY */;
@@ -715,7 +718,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
 
     t = s - prog->check_offset_max;
     if (s - strpos > prog->check_offset_max  /* signed-corrected t > strpos */
-        && (!(prog->reganch & ROPT_UTF8)
+        && (!do_utf8
            || ((t = reghopmaybe3_c(s, -prog->check_offset_max, strpos))
                 && t > strpos))) {
        /* Fixed substring is found far enough so that the match
@@ -959,25 +962,40 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta
        /* We know what class it must start with. */
        switch (OP(c)) {
        case ANYOF:
-           while (s < strend) {
-               STRLEN skip = do_utf8 ? UTF8SKIP(s) : 1;
-                 
-               if (do_utf8 ?
-                   reginclass(c, (U8*)s, 0, do_utf8) :
-                   REGINCLASS(c, (U8*)s) ||
-                   (ANYOF_FOLD_SHARP_S(c, s, strend) &&
-                    /* The assignment of 2 is intentional:
-                     * for the sharp s, the skip is 2. */
-                    (skip = SHARP_S_SKIP)
-                    )) {
-                   if (tmp && (norun || regtry(prog, s)))
-                       goto got_it;
-                   else
-                       tmp = doevery;
-               }
-               else 
-                   tmp = 1;
-               s += skip;
+           if (do_utf8) {
+                while (s < strend) {
+                     if ((ANYOF_FLAGS(c) & ANYOF_UNICODE) ||
+                         !UTF8_IS_INVARIANT((U8)s[0]) ?
+                         reginclass(c, (U8*)s, 0, do_utf8) :
+                         REGINCLASS(c, (U8*)s)) {
+                          if (tmp && (norun || regtry(prog, s)))
+                               goto got_it;
+                          else
+                               tmp = doevery;
+                     }
+                     else 
+                          tmp = 1;
+                     s += UTF8SKIP(s);
+                }
+           }
+           else {
+                while (s < strend) {
+                     STRLEN skip = 1;
+
+                     if (REGINCLASS(c, (U8*)s) ||
+                         (ANYOF_FOLD_SHARP_S(c, s, strend) &&
+                          /* The assignment of 2 is intentional:
+                           * for the folded sharp s, the skip is 2. */
+                          (skip = SHARP_S_SKIP))) {
+                          if (tmp && (norun || regtry(prog, s)))
+                               goto got_it;
+                          else
+                               tmp = doevery;
+                     }
+                     else 
+                          tmp = 1;
+                     s += skip;
+                }
            }
            break;
        case CANY:
@@ -1843,6 +1861,9 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
                 : (s = fbm_instr((unsigned char*)HOP3(s, back_min, strend),
                                  (unsigned char*)strend, must,
                                  PL_multiline ? FBMrf_MULTILINE : 0))) ) {
+           /* we may be pointing at the wrong string */
+           if ((flags & REXEC_SCREAM) && RX_MATCH_COPIED(prog))
+               s = prog->subbeg + (s - SvPVX(sv));
            DEBUG_r( did_match = 1 );
            if (HOPc(s, -back_max) > last1) {
                last1 = HOPc(s, -back_min);
@@ -1882,9 +1903,12 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
        goto phooey;
     }
     else if ((c = prog->regstclass)) {
-       if (minlen && PL_regkind[(U8)OP(prog->regstclass)] != EXACT)
+       if (minlen) {
+           I32 op = (U8)OP(prog->regstclass);
            /* don't bother with what can't match */
-           strend = HOPc(strend, -(minlen - 1));
+           if (PL_regkind[op] != EXACT && op != CANY)
+               strend = HOPc(strend, -(minlen - 1));
+       }
        DEBUG_r({
            SV *prop = sv_newmortal();
            char *s0;
@@ -1926,6 +1950,9 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
                                   end_shift, &scream_pos, 1); /* last one */
                if (!last)
                    last = scream_olds; /* Only one occurrence. */
+               /* we may be pointing at the wrong string */
+               else if (RX_MATCH_COPIED(prog))
+                   s = prog->subbeg + (s - SvPVX(sv));
            }
            else {
                STRLEN len;
@@ -2107,6 +2134,7 @@ S_regtry(pTHX_ regexp *prog, char *startpos)
     PL_reglastparen = &prog->lastparen;
     PL_reglastcloseparen = &prog->lastcloseparen;
     prog->lastparen = 0;
+    prog->lastcloseparen = 0;
     PL_regsize = 0;
     DEBUG_r(PL_reg_starttry = startpos);
     if (PL_reg_start_tmpl <= prog->nparens) {
@@ -2269,17 +2297,17 @@ S_regmatch(pTHX_ regnode *prog)
            regprop(prop, scan);
            {
              char *s0 =
-               do_utf8 ?
+               do_utf8 && OP(scan) != CANY ?
                pv_uni_display(dsv0, (U8*)(locinput - pref_len),
                               pref0_len, 60, UNI_DISPLAY_REGEX) :
                locinput - pref_len;
              int len0 = do_utf8 ? strlen(s0) : pref0_len;
-             char *s1 = do_utf8 ?
+             char *s1 = do_utf8 && OP(scan) != CANY ?
                pv_uni_display(dsv1, (U8*)(locinput - pref_len + pref0_len),
                               pref_len - pref0_len, 60, UNI_DISPLAY_REGEX) :
                locinput - pref_len + pref0_len;
              int len1 = do_utf8 ? strlen(s1) : pref_len - pref0_len;
-             char *s2 = do_utf8 ?
+             char *s2 = do_utf8 && OP(scan) != CANY ?
                pv_uni_display(dsv2, (U8*)locinput,
                               PL_regeol - locinput, 60, UNI_DISPLAY_REGEX) :
                locinput;
@@ -4049,8 +4077,26 @@ S_regrepeat(pTHX_ regnode *p, I32 max)
     case ANYOF:
        if (do_utf8) {
            loceol = PL_regeol;
-           while (hardcount < max && scan < loceol &&
-                  reginclass(p, (U8*)scan, 0, do_utf8)) {
+           while (hardcount < max && scan < loceol) {
+                bool cont = FALSE;
+                if (ANYOF_FLAGS(p) & ANYOF_UNICODE) {
+                     if (reginclass(p, (U8*)scan, 0, do_utf8))
+                          cont = TRUE;
+                }
+                else {
+                     U8 c = (U8)scan[0];
+
+                     if (UTF8_IS_INVARIANT(c)) {
+                          if (ANYOF_BITMAP_TEST(p, c))
+                               cont = TRUE;
+                     }
+                     else {
+                          if (reginclass(p, (U8*)scan, 0, do_utf8))
+                               cont = TRUE;
+                     }
+               }
+               if (!cont)
+                    break;
                scan += UTF8SKIP(scan);
                hardcount++;
            }