From: Andreas König <a.koenig@mind.de>
Date: Fri, 8 Mar 2002 16:36:01 +0000 (+0100)
Subject: UTF-8 bug (maybe alreayd known?)
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f272994b1ce9066a01ab0ed3d6c5353b37057838;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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
--- 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";
+}
+