(retracted by #12951)

[perl5.git] / regcomp.c

diff --git a/regcomp.c b/regcomp.c
index 6095aac..12e0395 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -1764,7 +1764,7 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
     r->reganch = pm->op_pmflags & PMf_COMPILETIME; /* Again? */
     pm->op_pmflags = RExC_flags16;
     if (UTF)
-       r->reganch |= ROPT_UTF8;
+        r->reganch |= ROPT_UTF8;       /* Unicode in it? */
     r->regstclass = NULL;
     if (RExC_naughty >= 10)    /* Probably an expensive pattern. */
        r->reganch |= ROPT_NAUGHTY;
@@ -3155,6 +3155,22 @@ tryagain:
        break;
     }
 
+    if (PL_encoding && PL_regkind[(U8)OP(ret)] == EXACT && !RExC_utf8) {
+        STRLEN oldlen = STR_LEN(ret);
+        SV *sv        = sv_2mortal(newSVpvn(STRING(ret), oldlen));
+        char *s       = Perl_sv_recode_to_utf8(aTHX_ sv, PL_encoding);
+        STRLEN newlen = SvCUR(sv);
+        if (!SIZE_ONLY) {
+             DEBUG_r(PerlIO_printf(Perl_debug_log, "recode %*s to %*s\n",
+                                   oldlen, STRING(ret), newlen, s));
+             Copy(s, STRING(ret), newlen, char);
+             STR_LEN(ret) += newlen - oldlen;
+             RExC_emit += STR_SZ(newlen) - STR_SZ(oldlen);
+        } else
+             RExC_size += STR_SZ(newlen) - STR_SZ(oldlen);
+        RExC_utf8 = 1;
+    }
+
     return(ret);
 }
 
@@ -3179,7 +3195,12 @@ S_regwhite(pTHX_ char *p, char *e)
    Character classes ([:foo:]) can also be negated ([:^foo:]).
    Returns a named class id (ANYOF_XXX) if successful, -1 otherwise.
    Equivalence classes ([=foo=]) and composites ([.foo.]) are parsed,
-   but trigger warnings because they are currently unimplemented. */
+   but trigger failures because they are currently unimplemented. */
+
+#define POSIXCC_DONE(c)   ((c) == ':')
+#define POSIXCC_NOTYET(c) ((c) == '=' || (c) == '.')
+#define POSIXCC(c) (POSIXCC_DONE(c) || POSIXCC_NOTYET(c))
+
 STATIC I32
 S_regpposixcc(pTHX_ RExC_state_t *pRExC_state, I32 value)
 {
@@ -3188,13 +3209,11 @@ S_regpposixcc(pTHX_ RExC_state_t *pRExC_state, I32 value)
 
     if (value == '[' && RExC_parse + 1 < RExC_end &&
        /* I smell either [: or [= or [. -- POSIX has been here, right? */
-       (*RExC_parse == ':' ||
-        *RExC_parse == '=' ||
-        *RExC_parse == '.')) {
-       char  c = *RExC_parse;
+       POSIXCC(UCHARAT(RExC_parse))) {
+       char  c = UCHARAT(RExC_parse);
        char* s = RExC_parse++;
        
-       while (RExC_parse < RExC_end && *RExC_parse != c)
+       while (RExC_parse < RExC_end && UCHARAT(RExC_parse) != c)
            RExC_parse++;
        if (RExC_parse == RExC_end)
            /* Grandfather lone [:, [=, [. */
@@ -3202,7 +3221,7 @@ S_regpposixcc(pTHX_ RExC_state_t *pRExC_state, I32 value)
        else {
            char* t = RExC_parse++; /* skip over the c */
 
-           if (*RExC_parse == ']') {
+           if (UCHARAT(RExC_parse) == ']') {
                RExC_parse++; /* skip over the ending ] */
                posixcc = s + 1;
                if (*s == ':') {
@@ -3291,7 +3310,7 @@ S_regpposixcc(pTHX_ RExC_state_t *pRExC_state, I32 value)
 
                    /* adjust RExC_parse so the warning shows after
                       the class closes */
-                   while (*RExC_parse && *RExC_parse != ']')
+                   while (UCHARAT(RExC_parse) && UCHARAT(RExC_parse) != ']')
                        RExC_parse++;
                    Simple_vFAIL3("POSIX syntax [%c %c] is reserved for future extensions", c, c);
                }
@@ -3310,9 +3329,7 @@ STATIC void
 S_checkposixcc(pTHX_ RExC_state_t *pRExC_state)
 {
     if (!SIZE_ONLY && ckWARN(WARN_REGEXP) &&
-       (*RExC_parse == ':' ||
-        *RExC_parse == '=' ||
-        *RExC_parse == '.')) {
+       POSIXCC(UCHARAT(RExC_parse))) {
        char *s = RExC_parse;
        char  c = *s++;
 
@@ -3322,11 +3339,10 @@ S_checkposixcc(pTHX_ RExC_state_t *pRExC_state)
            vWARN3(s+2, "POSIX syntax [%c %c] belongs inside character classes", c, c);
 
            /* [[=foo=]] and [[.foo.]] are still future. */
-           if (c == '=' || c == '.')
-           {
+           if (POSIXCC_NOTYET(c)) {
                /* adjust RExC_parse so the error shows after
                   the class closes */
-               while (*RExC_parse && *RExC_parse++ != ']')
+               while (UCHARAT(RExC_parse) && UCHARAT(RExC_parse++) != ']')
                    ;
                Simple_vFAIL3("POSIX syntax [%c %c] is reserved for future extensions", c, c);
            }
@@ -3338,6 +3354,7 @@ STATIC regnode *
 S_regclass(pTHX_ RExC_state_t *pRExC_state)
 {
     register UV value;
+    register UV nextvalue;
     register IV prevvalue = OOB_UNICODE;
     register IV range = 0;
     register regnode *ret;
@@ -3355,7 +3372,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state)
     if (!SIZE_ONLY)
        ANYOF_FLAGS(ret) = 0;
 
-    if (*RExC_parse == '^') {  /* Complement of range. */
+    if (UCHARAT(RExC_parse) == '^') {  /* Complement of range. */
        RExC_naughty++;
        RExC_parse++;
        if (!SIZE_ONLY)
@@ -3374,13 +3391,15 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state)
        listsv = newSVpvn("# comment\n", 10);
     }
 
-    if (!SIZE_ONLY && ckWARN(WARN_REGEXP))
+    nextvalue = RExC_parse < RExC_end ? UCHARAT(RExC_parse) : 0;
+
+    if (!SIZE_ONLY && ckWARN(WARN_REGEXP) && POSIXCC(nextvalue))
        checkposixcc(pRExC_state);
 
-    if (*RExC_parse == ']' || *RExC_parse == '-')
+    if (UCHARAT(RExC_parse) == ']' || UCHARAT(RExC_parse) == '-')
        goto charclassloop;             /* allow 1st char to be ] or - */
 
-    while (RExC_parse < RExC_end && *RExC_parse != ']') {
+    while (RExC_parse < RExC_end && UCHARAT(RExC_parse) != ']') {
 
     charclassloop:
 
@@ -3396,7 +3415,8 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state)
        }
        else
            value = UCHARAT(RExC_parse++);
-       if (value == '[')
+       nextvalue = RExC_parse < RExC_end ? UCHARAT(RExC_parse) : 0;
+       if (value == '[' && POSIXCC(nextvalue))
            namedclass = regpposixcc(pRExC_state, value);
        else if (value == '\\') {
            if (UTF) {
@@ -4411,11 +4431,11 @@ Perl_regprop(pTHX_ SV *sv, regnode *o)
 
     if (k == EXACT) {
         SV *dsv = sv_2mortal(newSVpvn("", 0));
-       bool do_utf8 = PL_reg_match_utf8;
+       bool do_utf8 = DO_UTF8(sv);
        char *s    = do_utf8 ?
          pv_uni_display(dsv, (U8*)STRING(o), STR_LEN(o), 60, 0) :
          STRING(o);
-       STRLEN len = do_utf8 ?
+       int len = do_utf8 ?
          strlen(s) :
          STR_LEN(o);
        Perl_sv_catpvf(aTHX_ sv, " <%s%.*s%s>",