STRLEN != int.

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

diff --git a/regcomp.c b/regcomp.c
index 4455730..b5f7164 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -2879,9 +2879,10 @@ tryagain:
                  /* a lovely hack--pretend we saw [\pX] instead */
                    RExC_end = strchr(RExC_parse, '}');
                    if (!RExC_end) {
+                       U8 c = (U8)*RExC_parse;
                        RExC_parse += 2;
                        RExC_end = oldregxend;
-                       vFAIL("Missing right brace on \\p{}");
+                       vFAIL2("Missing right brace on \\%c{}", c);
                    }
                    RExC_end++;
                }
@@ -2961,6 +2962,8 @@ tryagain:
            register char *p;
            char *oldp, *s;
            STRLEN numlen;
+           STRLEN ulen;
+           U8 tmpbuf[UTF8_MAXLEN*2+1];
 
             parse_start = RExC_parse - 1;
 
@@ -3085,7 +3088,7 @@ tryagain:
                        /* FALL THROUGH */
                    default:
                        if (!SIZE_ONLY && ckWARN(WARN_REGEXP) && isALPHA(*p))
-                           vWARN2(p +1, "Unrecognized escape \\%c passed through", *p);
+                           vWARN2(p + 1, "Unrecognized escape \\%c passed through", UCHARAT(p));
                        goto normal_default;
                    }
                    break;
@@ -3103,10 +3106,8 @@ tryagain:
                if (RExC_flags16 & PMf_EXTENDED)
                    p = regwhite(p, RExC_end);
                if (UTF && FOLD) {
-                   if (LOC)
-                       ender = toLOWER_LC_uvchr(ender);
-                   else
-                       ender = toLOWER_uni(ender);
+                   toLOWER_uni(ender, tmpbuf, &ulen);
+                   ender = utf8_to_uvchr(tmpbuf, 0);
                }
                if (ISMULT2(p)) { /* Back off on ?+*. */
                    if (len)
@@ -3421,22 +3422,38 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state)
            case 'p':
            case 'P':
                if (*RExC_parse == '{') {
+                   U8 c = (U8)value;
                    e = strchr(RExC_parse++, '}');
                     if (!e)
-                        vFAIL("Missing right brace on \\p{}");
+                        vFAIL2("Missing right brace on \\%c{}", c);
+                   while (isSPACE(UCHARAT(RExC_parse)))
+                       RExC_parse++;
+                    if (e == RExC_parse)
+                        vFAIL2("Empty \\%c{}", c);
                    n = e - RExC_parse;
+                   while (isSPACE(UCHARAT(RExC_parse + n - 1)))
+                       n--;
                }
                else {
                    e = RExC_parse;
                    n = 1;
                }
                if (!SIZE_ONLY) {
+                   if (UCHARAT(RExC_parse) == '^') {
+                        RExC_parse++;
+                        n--;
+                        value = value == 'p' ? 'P' : 'p'; /* toggle */
+                        while (isSPACE(UCHARAT(RExC_parse))) {
+                             RExC_parse++;
+                             n--;
+                        }
+                   }
                    if (value == 'p')
-                       Perl_sv_catpvf(aTHX_ listsv,
-                                      "+utf8::%.*s\n", (int)n, RExC_parse);
+                        Perl_sv_catpvf(aTHX_ listsv,
+                                       "+utf8::%.*s\n", (int)n, RExC_parse);
                    else
-                       Perl_sv_catpvf(aTHX_ listsv,
-                                      "!utf8::%.*s\n", (int)n, RExC_parse);
+                        Perl_sv_catpvf(aTHX_ listsv,
+                                       "!utf8::%.*s\n", (int)n, RExC_parse);
                }
                RExC_parse = e + 1;
                ANYOF_FLAGS(ret) |= ANYOF_UNICODE;
@@ -4392,9 +4409,20 @@ Perl_regprop(pTHX_ SV *sv, regnode *o)
 
     k = PL_regkind[(U8)OP(o)];
 
-    if (k == EXACT)
-       Perl_sv_catpvf(aTHX_ sv, " <%s%.*s%s>", PL_colors[0],
-                      STR_LEN(o), STRING(o), PL_colors[1]);
+    if (k == EXACT) {
+        SV *dsv = sv_2mortal(newSVpvn("", 0));
+       bool do_utf8 = PL_reg_match_utf8;
+       char *s    = do_utf8 ?
+         pv_uni_display(dsv, (U8*)STRING(o), STR_LEN(o), 60, 0) :
+         STRING(o);
+       int len = do_utf8 ?
+         strlen(s) :
+         STR_LEN(o);
+       Perl_sv_catpvf(aTHX_ sv, " <%s%.*s%s>",
+                      PL_colors[0],
+                      len, s,
+                      PL_colors[1]);
+    }
     else if (k == CURLY) {
        if (OP(o) == CURLYM || OP(o) == CURLYN || OP(o) == CURLYX)
            Perl_sv_catpvf(aTHX_ sv, "[%d]", o->flags); /* Parenth number */
@@ -4475,7 +4503,7 @@ Perl_regprop(pTHX_ SV *sv, regnode *o)
        if (flags & ANYOF_UNICODE)
            sv_catpv(sv, "{unicode}");
        else if (flags & ANYOF_UNICODE_ALL)
-           sv_catpv(sv, "{all-unicode}");
+           sv_catpv(sv, "{unicode_all}");
 
        {
            SV *lv;