From: Jarkko Hietaniemi <jhi@iki.fi>
Date: Wed, 26 Jun 2002 14:37:12 +0000 (+0000)
Subject: Another Unicode s/// buglet, from SADAHIRO Tomoyuki.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8514a05ad77d06390899752b405c952ef7bae9d5;p=p5sagit%2Fp5-mst-13.2.git

Another Unicode s/// buglet, from SADAHIRO Tomoyuki.

p4raw-id: //depot/perl@17358
---

diff --git a/pp_hot.c b/pp_hot.c
index 22c54fc..526468d 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1985,6 +1985,15 @@ PP(pp_subst)
     if (dstr) {
         c = SvPV(dstr, clen);
 	doutf8 = DO_UTF8(dstr);
+	/* replacement needing upgrading? */
+	if (DO_UTF8(TARG) && !doutf8) {
+	     SV *nsv = newSVpvn(c, clen);
+	     if (PL_encoding)
+		  sv_recode_to_utf8(nsv, PL_encoding);
+	     else
+		  sv_utf8_upgrade(nsv);
+	     c = SvPV(nsv, clen);
+	}
     }
     else {
         c = Nullch;
diff --git a/t/op/subst.t b/t/op/subst.t
index e80ab23..026a940 100755
--- a/t/op/subst.t
+++ b/t/op/subst.t
@@ -7,7 +7,7 @@ BEGIN {
 }
 
 require './test.pl';
-plan( tests => 92 );
+plan( tests => 108 );
 
 $x = 'foo';
 $_ = "x";
@@ -381,6 +381,7 @@ substr($pv2,0,1) = "\x{100}";
 is($pv1, $pv2);
 
 {   
+    # Gregor Chrupala <gregor.chrupala@star-group.net>
     use utf8;
     $a = 'Espa&ntilde;a';
     $a =~ s/&ntilde;/ñ/;
@@ -401,3 +402,46 @@ is($pv1, $pv2);
     like($a, qr/ñ/, "use utf8 LHS and RHS");
 }
 
+{
+    # SADAHIRO Tomoyuki <bqw10602@nifty.com>
+
+    $a = "\x{100}\x{101}";
+    $a =~ s/\x{101}/\xFF/;
+    like($a, qr/\xFF/);
+    is(length($a), 2);
+
+    $a = "\x{100}\x{101}";
+    $a =~ s/\x{101}/"\xFF"/e;
+    like($a, qr/\xFF/);
+    is(length($a), 2);
+
+    $a = "\x{100}\x{101}";
+    $a =~ s/\x{101}/\xFF\xFF\xFF/;
+    like($a, qr/\xFF\xFF\xFF/);
+    is(length($a), 4);
+
+    $a = "\x{100}\x{101}";
+    $a =~ s/\x{101}/"\xFF\xFF\xFF"/e;
+    like($a, qr/\xFF\xFF\xFF/);
+    is(length($a), 4);
+
+    $a = "\xFF\x{101}";
+    $a =~ s/\xFF/\x{100}/;
+    like($a, qr/\x{100}/);
+    is(length($a), 2);
+
+    $a = "\xFF\x{101}";
+    $a =~ s/\xFF/"\x{100}"/e;
+    like($a, qr/\x{100}/);
+    is(length($a), 2);
+
+    $a = "\xFF";
+    $a =~ s/\xFF/\x{100}/;
+    like($a, qr/\x{100}/);
+    is(length($a), 1);
+
+    $a = "\xFF";
+    $a =~ s/\xFF/"\x{100}"/e;
+    like($a, qr/\x{100}/);
+    is(length($a), 1);
+}