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 (file)
--- 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 (executable)
--- 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);
+}