Integrate perlio:

[p5sagit/p5-mst-13.2.git] / regcomp.c

diff --git a/regcomp.c b/regcomp.c
index 3459e0a..51b3c5d 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -736,6 +736,50 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg
                    n = nnext;
                }
            }
+
+           if (UTF && OP(scan) == EXACTF && STR_LEN(scan) >= 6) {
+/*
+  Two problematic code points in Unicode casefolding of EXACT nodes:
+
+   U+0390 - GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS
+   U+03B0 - GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS
+
+   which casefold to
+
+   Unicode                     UTF-8
+
+   U+03B9 U+0308 U+0301                0xCE 0xB9 0xCC 0x88 0xCC 0x81
+   U+03C5 U+0308 U+0301                0xCF 0x85 0xCC 0x88 0xCC 0x81
+
+   This means that in case-insensitive matching (or "loose matching",
+   as Unicode calls it), an EXACTF of length six (the UTF-8 encoded byte
+   length of the above casefolded versions) can match a target string
+   of length two (the byte length of UTF-8 encoded U+0390 or U+03B0).
+   This would rather mess up the minimum length computation.
+
+   What we'll do is to look for the tail four bytes, and then peek
+   at the preceding two bytes to see whether we need to decrease
+   the minimum length by four (six minus two).
+
+   Thanks to the design of UTF-8, there cannot be false matches:
+   A sequence of valid UTF-8 bytes cannot be a subsequence of
+   another valid sequence of UTF-8 bytes.
+
+*/
+                char *s0 = STRING(scan), *s, *t;
+                char *s1 = s0 + STR_LEN(scan) - 1, *s2 = s1 - 4;
+                char *t0 = "\xcc\x88\xcc\x81";
+                char *t1 = t0 + 3;
+                
+                for (s = s0 + 2;
+                     s < s2 && (t = ninstr(s, s1, t0, t1));
+                     s = t + 4) {
+                     if (((U8)t[-1] == 0xB9 && (U8)t[-2] == 0xCE) ||
+                         ((U8)t[-1] == 0x85 && (U8)t[-2] == 0xCF))
+                          min -= 4;
+                }
+           }
+
 #ifdef DEBUGGING
            /* Allow dumping */
            n = scan + NODE_SZ_STR(scan);
@@ -1848,7 +1892,7 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
            first = NEXTOPER(first);
            goto again;
        }
-       else if ((OP(first) == STAR &&
+       else if (!sawopen && (OP(first) == STAR &&
            PL_regkind[(U8)OP(NEXTOPER(first))] == REG_ANY) &&
            !(r->reganch & ROPT_ANCH) )
        {
@@ -2361,9 +2405,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp)
     }
     else if (paren != '?')             /* Not Conditional */
        ret = br;
-    if (flags&HASWIDTH)
-       *flagp |= HASWIDTH;
-    *flagp |= flags&SPSTART;
+    *flagp |= flags & (SPSTART | HASWIDTH);
     lastbr = br;
     while (*RExC_parse == '|') {
        if (!SIZE_ONLY && RExC_extralen) {
@@ -3459,8 +3501,9 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state)
     if (!SIZE_ONLY && ckWARN(WARN_REGEXP) && POSIXCC(nextvalue))
        checkposixcc(pRExC_state);
 
-    if (UCHARAT(RExC_parse) == ']' || UCHARAT(RExC_parse) == '-')
-       goto charclassloop;             /* allow 1st char to be ] or - */
+    /* allow 1st char to be ] (allowing it to be - is dealt with later) */
+    if (UCHARAT(RExC_parse) == ']')
+       goto charclassloop;
 
     while (RExC_parse < RExC_end && UCHARAT(RExC_parse) != ']') {
 
@@ -4557,9 +4600,13 @@ Perl_regprop(pTHX_ SV *sv, regnode *o)
 
     if (k == EXACT) {
         SV *dsv = sv_2mortal(newSVpvn("", 0));
-       bool do_utf8 = DO_UTF8(sv);
+       /* Using is_utf8_string() is a crude hack but it may
+        * be the best for now since we have no flag "this EXACTish
+        * node was UTF-8" --jhi */
+       bool do_utf8 = is_utf8_string((U8*)STRING(o), STR_LEN(o));
        char *s    = do_utf8 ?
-         pv_uni_display(dsv, (U8*)STRING(o), STR_LEN(o), 60, 0) :
+         pv_uni_display(dsv, (U8*)STRING(o), STR_LEN(o), 60,
+                        UNI_DISPLAY_REGEX) :
          STRING(o);
        int len = do_utf8 ?
          strlen(s) :
@@ -4750,7 +4797,7 @@ Perl_pregfree(pTHX_ struct regexp *r)
        return;
     DEBUG_r({
          char *s = pv_uni_display(dsv, (U8*)r->precomp, r->prelen, 60,
-                                 UNI_DISPLAY_ISPRINT);
+                                 UNI_DISPLAY_REGEX);
         int len = SvCUR(dsv);
         if (!PL_colorset)
              reginitcolors();