[ID 20020220.002] Perl 5.7.2 porting patches for POSIX 1003.1-2001 hosts
[p5sagit/p5-mst-13.2.git] / regexec.c
index 06f0d8e..900b491 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -67,7 +67,7 @@
  *
  ****    Alterations to Henry's code are...
  ****
- ****    Copyright (c) 1991-2001, Larry Wall
+ ****    Copyright (c) 1991-2002, Larry Wall
  ****
  ****    You may distribute under the terms of either the GNU General Public
  ****    License or the Artistic License, as specified in the README file.
 #define HOPMAYBEc(pos,off) ((char*)HOPMAYBE(pos,off))
 
 #define HOPBACK(pos, off) (            \
-    (UTF && PL_reg_match_utf8)         \
+    (PL_reg_match_utf8)                        \
        ? reghopmaybe((U8*)pos, -off)   \
     : (pos - off >= PL_bostr)          \
        ? (U8*)(pos - off)              \
     PL_regkind[(U8)OP(rn)] == EXACT || PL_regkind[(U8)OP(rn)] == REF \
 )
 
+/*
+  Search for mandatory following text node; for lookahead, the text must
+  follow but for lookbehind (rn->flags != 0) we skip to the next step.
+*/
 #define FIND_NEXT_IMPT(rn) STMT_START { \
     while (JUMPABLE(rn)) \
-       if (OP(rn) == SUSPEND || OP(rn) == IFMATCH || \
-           PL_regkind[(U8)OP(rn)] == CURLY) \
+       if (OP(rn) == SUSPEND || PL_regkind[(U8)OP(rn)] == CURLY) \
            rn = NEXTOPER(NEXTOPER(rn)); \
        else if (OP(rn) == PLUS) \
            rn = NEXTOPER(rn); \
+       else if (OP(rn) == IFMATCH) \
+           rn = (rn->flags == 0) ? NEXTOPER(NEXTOPER(rn)) : rn + ARG(rn); \
        else rn += NEXT_OFF(rn); \
 } STMT_END 
 
@@ -916,15 +921,22 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta
        switch (OP(c)) {
        case ANYOF:
            while (s < strend) {
-               if (reginclass(c, (U8*)s, do_utf8)) {
+               STRLEN skip = do_utf8 ? UTF8SKIP(s) : 1;
+
+               if (reginclass(c, (U8*)s, do_utf8) ||
+                   (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 += do_utf8 ? UTF8SKIP(s) : 1;
+               else 
+                    tmp = 1;
+               s += skip;
            }
            break;
        case CANY:
@@ -1012,12 +1024,12 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta
                        c = utf8_to_uvchr((U8*)s, &len);
 
                        /* Handle some of the three Greek sigmas cases.
-                         * Note that not all the possible combinations
-                         * are handled here: some of them are handled
-                         * handled by the standard folding rules, and
-                         * some of them (the character class or ANYOF
-                         * cases) are handled during compiletime in
-                         * regexec.c:S_regclass(). */
+                        * Note that not all the possible combinations
+                        * are handled here: some of them are handled
+                        * by the standard folding rules, and some of
+                        * them (the character class or ANYOF cases)
+                        * are handled during compiletime in
+                        * regexec.c:S_regclass(). */
                        if (c == (UV)UNICODE_GREEK_CAPITAL_LETTER_SIGMA ||
                            c == (UV)UNICODE_GREEK_SMALL_LETTER_FINAL_SIGMA)
                            c = (UV)UNICODE_GREEK_SMALL_LETTER_SIGMA;
@@ -1034,7 +1046,7 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta
                             if ( f != c
                                  && (f == c1 || f == c2)
                                  && (ln == foldlen ||
-                                     !ibcmp_utf8((char *)foldbuf,
+                                     !ibcmp_utf8((char *) foldbuf,
                                                  (char **)0, foldlen, do_utf8,
                                                  m,
                                                  (char **)0, ln,      UTF))
@@ -1554,9 +1566,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
     }
 
     minlen = prog->minlen;
-    if (strend - startpos < minlen &&
-       !PL_reg_match_utf8 /* ANYOFs can balloon to EXACTFs */
-       ) {
+    if (strend - startpos < minlen) {
         DEBUG_r(PerlIO_printf(Perl_debug_log,
                              "String too short [regexec_flags]...\n"));
        goto phooey;
@@ -2110,6 +2120,7 @@ typedef union re_unwind_t {
 
 #define sayYES goto yes
 #define sayNO goto no
+#define sayNO_ANYOF goto no_anyof
 #define sayYES_FINAL goto yes_final
 #define sayYES_LOUD  goto yes_loud
 #define sayNO_FINAL  goto no_final
@@ -2324,7 +2335,7 @@ S_regmatch(pTHX_ regnode *prog)
                        if (l >= PL_regeol)
                             sayNO;
                        if (NATIVE_TO_UNI(*(U8*)s) !=
-                           utf8_to_uvchr((U8*)l, &ulen))
+                           utf8_to_uvuni((U8*)l, &ulen))
                             sayNO;
                        l += ulen;
                        s ++;
@@ -2336,7 +2347,7 @@ S_regmatch(pTHX_ regnode *prog)
                        if (l >= PL_regeol)
                            sayNO;
                        if (NATIVE_TO_UNI(*((U8*)l)) !=
-                           utf8_to_uvchr((U8*)s, &ulen))
+                           utf8_to_uvuni((U8*)s, &ulen))
                            sayNO;
                        s += ulen;
                        l ++;
@@ -2369,9 +2380,21 @@ S_regmatch(pTHX_ regnode *prog)
                char *l = locinput;
                char *e = PL_regeol;
 
-               if (ibcmp_utf8(s, 0,  ln, do_utf8,
-                              l, &e, 0,  UTF))
-                    sayNO;
+               if (ibcmp_utf8(s, 0,  ln, UTF,
+                              l, &e, 0,  do_utf8)) {
+                    /* One more case for the sharp s:
+                     * pack("U0U*", 0xDF) =~ /ss/i,
+                     * the 0xC3 0x9F are the UTF-8
+                     * byte sequence for the U+00DF. */
+                    if (!(do_utf8 &&
+                          toLOWER(s[0]) == 's' &&
+                          ln >= 2 &&
+                          toLOWER(s[1]) == 's' &&
+                          (U8)l[0] == 0xC3 &&
+                          e - l >= 2 &&
+                          (U8)l[1] == 0x9F))
+                         sayNO;
+               }
                locinput = e;
                nextchr = UCHARAT(locinput);
                break;
@@ -2398,21 +2421,33 @@ S_regmatch(pTHX_ regnode *prog)
                STRLEN inclasslen = PL_regeol - locinput;
 
                if (!reginclasslen(scan, (U8*)locinput, &inclasslen, do_utf8))
-                   sayNO;
+                   sayNO_ANYOF;
                if (locinput >= PL_regeol)
                    sayNO;
                locinput += inclasslen;
                nextchr = UCHARAT(locinput);
+               break;
            }
            else {
                if (nextchr < 0)
                    nextchr = UCHARAT(locinput);
                if (!reginclass(scan, (U8*)locinput, do_utf8))
-                   sayNO;
+                   sayNO_ANYOF;
                if (!nextchr && locinput >= PL_regeol)
                    sayNO;
                nextchr = UCHARAT(++locinput);
+               break;
+           }
+       no_anyof:
+           /* If we might have the case of the German sharp s
+            * in a casefolding Unicode character class. */
+
+           if (ANYOF_FOLD_SHARP_S(scan, locinput, PL_regeol)) {
+                locinput += SHARP_S_SKIP;
+                nextchr = UCHARAT(locinput);
            }
+           else
+                sayNO;
            break;
        case ALNUML:
            PL_reg_flags |= RF_tainted;
@@ -3586,7 +3621,9 @@ S_regmatch(pTHX_ regnode *prog)
                n = regrepeat(scan, n);
                locinput = PL_reginput;
                if (ln < n && PL_regkind[(U8)OP(next)] == EOL &&
-                   (!PL_multiline  || OP(next) == SEOL || OP(next) == EOS)) {
+                   ((!PL_multiline && OP(next) != MEOL) ||
+                       OP(next) == SEOL || OP(next) == EOS))
+               {
                    ln = n;                     /* why back off? */
                    /* ...because $ and \Z can match before *and* after
                       newline at the end.  Consider "\n\n" =~ /\n+\Z\n/.
@@ -3879,7 +3916,7 @@ S_regrepeat(pTHX_ regnode *p, I32 max)
     case SANY:
         if (do_utf8) {
            loceol = PL_regeol;
-           while (scan < loceol) {
+           while (scan < loceol && hardcount < max) {
                scan += UTF8SKIP(scan);
                hardcount++;
            }