This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
(retracted by #12951)
[perl5.git] / regcomp.c
index 0a63f22..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);
 }
 
@@ -4415,7 +4431,7 @@ 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);