From: Ilya Zakharevich <ilya@math.berkeley.edu>
Date: Sun, 24 Oct 1999 23:47:45 +0000 (-0400)
Subject: Missing REx engine patch
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b3c9acc1dea37c675a57f40a88b0c08196d48123;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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
--- 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
--- 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 {