Benchmark displays bogus CPU stats (suggested by Cedric Auzanne

[perl5.git] / regexec.c

diff --git a/regexec.c b/regexec.c
index cce1166..106c5d1 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -335,6 +335,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
        DEBUG_r(PerlIO_printf(Perl_debug_log, "String too short...\n"));
        goto fail;
     }
+    check = prog->check_substr;
     if (prog->reganch & ROPT_ANCH) {   /* Match at beg-of-str or after \n */
        ml_anch = !( (prog->reganch & ROPT_ANCH_SINGLE)
                     || ( (prog->reganch & ROPT_ANCH_BOL)
@@ -351,8 +352,8 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
            }
            PL_regeol = strend;                 /* Used in HOP() */
            s = HOPc(strpos, prog->check_offset_min);
-           if (SvTAIL(prog->check_substr)) {
-               slen = SvCUR(prog->check_substr);       /* >= 1 */
+           if (SvTAIL(check)) {
+               slen = SvCUR(check);    /* >= 1 */
 
                if ( strend - s > slen || strend - s < slen - 1 
                     || (strend - s == slen && strend[-1] != '\n')) {
@@ -361,29 +362,28 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
                }
                /* Now should match s[0..slen-2] */
                slen--;
-               if (slen && (*SvPVX(prog->check_substr) != *s
+               if (slen && (*SvPVX(check) != *s
                             || (slen > 1
-                                && memNE(SvPVX(prog->check_substr), s, slen)))) {
+                                && memNE(SvPVX(check), s, slen)))) {
                  report_neq:
                    DEBUG_r(PerlIO_printf(Perl_debug_log, "String not equal...\n"));
                    goto fail_finish;
                }
            }
-           else if (*SvPVX(prog->check_substr) != *s
-                    || ((slen = SvCUR(prog->check_substr)) > 1
-                        && memNE(SvPVX(prog->check_substr), s, slen)))
+           else if (*SvPVX(check) != *s
+                    || ((slen = SvCUR(check)) > 1
+                        && memNE(SvPVX(check), s, slen)))
                goto report_neq;
            goto success_at_start;
        }
        /* Match is anchored, but substr is not anchored wrt beg-of-str. */
        s = strpos;
        start_shift = prog->check_offset_min; /* okay to underestimate on CC */
-       /* Should be nonnegative! */
        end_shift = prog->minlen - start_shift -
-           CHR_SVLEN(prog->check_substr) + (SvTAIL(prog->check_substr) != 0);
+           CHR_SVLEN(check) + (SvTAIL(check) != 0);
        if (!ml_anch) {
-           I32 end = prog->check_offset_max + CHR_SVLEN(prog->check_substr)
-                                        - (SvTAIL(prog->check_substr) != 0);
+           I32 end = prog->check_offset_max + CHR_SVLEN(check)
+                                        - (SvTAIL(check) != 0);
            I32 eshift = strend - s - end;
 
            if (end_shift < eshift)
@@ -396,7 +396,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
        start_shift = prog->check_offset_min; /* okay to underestimate on CC */
        /* Should be nonnegative! */
        end_shift = prog->minlen - start_shift -
-           CHR_SVLEN(prog->check_substr) + (SvTAIL(prog->check_substr) != 0);
+           CHR_SVLEN(check) + (SvTAIL(check) != 0);
     }
 
 #ifdef DEBUGGING       /* 7/99: reports of failure (with the older version) */
@@ -404,7 +404,6 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
        Perl_croak(aTHX_ "panic: end_shift");
 #endif
 
-    check = prog->check_substr;
   restart:
     /* Find a possible match in the region s..strend by looking for
        the "check" substring in the region corrected by start/end_shift. */
@@ -640,7 +639,10 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
        /* Even in this situation we may use MBOL flag if strpos is offset
           wrt the start of the string. */
        if (ml_anch && sv
-           && (strpos + SvCUR(sv) != strend) && strpos[-1] != '\n') {
+           && (strpos + SvCUR(sv) != strend) && strpos[-1] != '\n'
+           /* May be due to an implicit anchor of m{.*foo}  */
+           && !(prog->reganch & ROPT_IMPLICIT))
+       {
            t = strpos;
            goto find_anchor;
        }
@@ -689,6 +691,10 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
        char *startpos = sv ? strend - SvCUR(sv) : s;
 
        t = s;
+       if (prog->reganch & ROPT_UTF8) {        
+           PL_regdata = prog->data;    /* Used by REGINCLASS UTF logic */
+           PL_bostr = startpos;
+       }
         s = find_byclass(prog, prog->regstclass, s, endpos, startpos, 1);
        if (!s) {
 #ifdef DEBUGGING
@@ -701,6 +707,8 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
            }
            DEBUG_r( PerlIO_printf(Perl_debug_log,
                                   "This position contradicts STCLASS...\n") );
+           if ((prog->reganch & ROPT_ANCH) && !ml_anch)
+               goto fail;
            /* Contradict one of substrings */
            if (prog->anchored_substr) {
                if (prog->anchored_substr == check) {
@@ -729,13 +737,17 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
                          (long)(other_last - i_strpos)) );
                goto do_other_anchored;
            }
-           if (!prog->float_substr) {  /* Could have been deleted */
-               if (ml_anch) {
-                   s = t = t + 1;
-                   goto try_at_offset;
-               }
-               goto fail;
+           /* Another way we could have checked stclass at the
+               current position only: */
+           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)) );
+               goto try_at_offset;
            }
+           if (!prog->float_substr)    /* Could have been deleted */
+               goto fail;
            /* Check is floating subtring. */
          retry_floating_check:
            t = check_at - start_shift;
@@ -864,9 +876,9 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta
            /* FALL THROUGH */
        case BOUNDUTF8:
            tmp = (I32)(s != startpos) ? utf8_to_uv(reghop((U8*)s, -1), 0) : '\n';
-           tmp = ((OP(c) == BOUND ? isALNUM_uni(tmp) : isALNUM_LC_uni(tmp)) != 0);
+           tmp = ((OP(c) == BOUNDUTF8 ? isALNUM_uni(tmp) : isALNUM_LC_uni(tmp)) != 0);
            while (s < strend) {
-               if (tmp == !(OP(c) == BOUND ?
+               if (tmp == !(OP(c) == BOUNDUTF8 ?
                             swash_fetch(PL_utf8_alnum, (U8*)s) :
                             isALNUM_LC_utf8((U8*)s)))
                {
@@ -899,12 +911,10 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta
            PL_reg_flags |= RF_tainted;
            /* FALL THROUGH */
        case NBOUNDUTF8:
-           if (prog->minlen)
-               strend = reghop_c(strend, -1);
            tmp = (I32)(s != startpos) ? utf8_to_uv(reghop((U8*)s, -1), 0) : '\n';
-           tmp = ((OP(c) == NBOUND ? isALNUM_uni(tmp) : isALNUM_LC_uni(tmp)) != 0);
+           tmp = ((OP(c) == NBOUNDUTF8 ? isALNUM_uni(tmp) : isALNUM_LC_uni(tmp)) != 0);
            while (s < strend) {
-               if (tmp == !(OP(c) == NBOUND ?
+               if (tmp == !(OP(c) == NBOUNDUTF8 ?
                             swash_fetch(PL_utf8_alnum, (U8*)s) :
                             isALNUM_LC_utf8((U8*)s)))
                    tmp = !tmp;
@@ -2325,6 +2335,7 @@ S_regmatch(pTHX_ regnode *prog)
                        I32 onpar = PL_regnpar;
 
                        pm.op_pmflags = 0;
+                       pm.op_pmdynflags = (UTF||DO_UTF8(ret) ? PMdf_UTF8 : 0);
                        re = CALLREGCOMP(aTHX_ t, t + len, &pm);
                        if (!(SvFLAGS(ret) 
                              & (SVs_TEMP | SVs_PADTMP | SVf_READONLY)))