UTF-8 bug (maybe alreayd known?)

Message-ID: <m3n0xjul5q.fsf@anima.de>

p4raw-id: //depot/perl@15270

diff --git a/pp_hot.c b/pp_hot.c
index 5380f88..ec18858 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1888,6 +1888,7 @@ PP(pp_subst)
     int force_on_match = 0;
     I32 oldsave = PL_savestack_ix;
     STRLEN slen;
+    bool doutf8 = FALSE;
 
     /* known replacement string? */
     dstr = (pm->op_pmflags & PMf_CONST) ? POPs : Nullsv;
@@ -1960,8 +1961,15 @@ PP(pp_subst)
     once = !(rpm->op_pmflags & PMf_GLOBAL);
 
     /* known replacement string? */
-    c = dstr ? SvPV(dstr, clen) : Nullch;
-
+    if (dstr) {
+        c = SvPV(dstr, clen);
+       doutf8 = DO_UTF8(dstr);
+    }
+    else {
+        c = Nullch;
+       doutf8 = FALSE;
+    }
+    
     /* can do inplace substitution? */
     if (c && clen <= rx->minlen && (once || !(r_flags & REXEC_COPY_STR))
        && !(rx->reganch & ROPT_LOOKBEHIND_SEEN)) {
@@ -2067,8 +2075,6 @@ PP(pp_subst)
     if (CALLREGEXEC(aTHX_ rx, s, strend, orig, 0, TARG, NULL,
                    r_flags | REXEC_CHECKED))
     {
-       bool isutf8;
-
        if (force_on_match) {
            force_on_match = 0;
            s = SvPV_force(TARG, len);
@@ -2114,7 +2120,7 @@ PP(pp_subst)
        SvPVX(TARG) = SvPVX(dstr);
        SvCUR_set(TARG, SvCUR(dstr));
        SvLEN_set(TARG, SvLEN(dstr));
-       isutf8 = DO_UTF8(dstr);
+       doutf8 |= DO_UTF8(dstr);
        SvPVX(dstr) = 0;
        sv_free(dstr);
 
@@ -2123,7 +2129,7 @@ PP(pp_subst)
        PUSHs(sv_2mortal(newSViv((I32)iters)));
 
        (void)SvPOK_only(TARG);
-       if (isutf8)
+       if (doutf8)
            SvUTF8_on(TARG);
        TAINT_IF(rxtainted);
        SvSETMAGIC(TARG);

diff --git a/t/op/pat.t b/t/op/pat.t
index 67ca765..a00e624 100755 (executable)
--- a/t/op/pat.t
+++ b/t/op/pat.t
@@ -6,7 +6,7 @@
 
 $| = 1;
 
-print "1..861\n";
+print "1..864\n";
 
 BEGIN {
     chdir 't' if -d 't';
@@ -2713,3 +2713,20 @@ print "# some Unicode properties\n";
     $s =~ s/[^\w]/ /g;
     print $s eq "s \x{100}" x 4 ? "ok 861\n" : "not ok 861\n";
 }
+
+{
+    print "# UTF-8 bug (maybe alreayd known?)\n";
+    my $u;
+
+    $u = "foo";
+    $u =~ s/./\x{100}/g;
+    print $u eq "\x{100}\x{100}\x{100}" ? "ok 862\n" : "not ok 862\n";
+
+    $u = "foobar";
+    $u =~ s/[ao]/\x{100}/g;
+    print $u eq "f\x{100}\x{100}b\x{100}r" ? "ok 863\n" : "not ok 863\n";
+
+    $u =~ s/\x{100}/e/g;
+    print $u eq "feeber" ? "ok 864\n" : "not ok 864\n";
+}
+