Missing REx engine patch

To: perl5-porters@perl.org (Mailing list Perl5)
Message-Id: <199910250347.XAA16094@monk.mps.ohio-state.edu>

p4raw-id: //depot/cfgperl@4452

diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index a6a723c..5b1c324 100644 (file)
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -2352,6 +2352,10 @@ was string.
 
 (P) The lexer got into a bad state while processing a case modifier.
 
+=item panic: %s
+
+(P) An internal error.
+
 =item Parentheses missing around "%s" list
 
 (W) You said something like

diff --git a/regcomp.c b/regcomp.c
index e3ba341..504b13c 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -944,7 +944,12 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
 
        /* Starting-point info. */
       again:
-       if (OP(first) == EXACT);        /* Empty, get anchored substr later. */
+       if (PL_regkind[(U8)OP(first) == EXACT]) {
+           if (OP(first) == EXACT);    /* Empty, get anchored substr later. */
+           else if ((OP(first) == EXACTF || OP(first) == EXACTFL)
+                    && !UTF)
+               r->regstclass = first;
+       }
        else if (strchr((char*)PL_simple+4,OP(first)))
            r->regstclass = first;
        else if (PL_regkind[(U8)OP(first)] == BOUND ||

diff --git a/regexec.c b/regexec.c
index 7b5a488..fc5117f 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -918,6 +918,11 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
     else if (c = prog->regstclass) {
        I32 doevery = (prog->reganch & ROPT_SKIP) == 0;
        char *cc;
+       char *m;
+       int ln;
+       int c1;
+       int c2;
+       char *e;
 
        if (minlen)
            dontbother = minlen - 1;
@@ -953,6 +958,43 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
                s++;
            }
            break;
+       case EXACTF:
+           m = STRING(c);
+           ln = STR_LEN(c);
+           c1 = *m;
+           c2 = PL_fold[c1];
+           goto do_exactf;
+       case EXACTFL:
+           m = STRING(c);
+           ln = STR_LEN(c);
+           c1 = *m;
+           c2 = PL_fold_locale[c1];
+         do_exactf:
+           e = strend - ln;
+
+           /* Here it is NOT UTF!  */
+           if (c1 == c2) {
+               while (s <= e) {
+                   if ( *s == c1
+                        && (ln == 1 || (OP(c) == EXACTF
+                                        ? ibcmp(s, m, ln)
+                                        : ibcmp_locale(s, m, ln)))
+                        && regtry(prog, s) )
+                       goto got_it;
+                   s++;
+               }
+           } else {
+               while (s <= e) {
+                   if ( (*s == c1 || *s == c2)
+                        && (ln == 1 || (OP(c) == EXACTF
+                                        ? ibcmp(s, m, ln)
+                                        : ibcmp_locale(s, m, ln)))
+                        && regtry(prog, s) )
+                       goto got_it;
+                   s++;
+               }
+           }
+           break;
        case BOUNDL:
            PL_reg_flags |= RF_tainted;
            /* FALL THROUGH */
@@ -1364,6 +1406,9 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
                s += UTF8SKIP(s);
            }
            break;
+       default:
+           croak("panic: unknown regstclass %d", (int)OP(c));
+           break;
        }
     }
     else {