Fix the syswrite downgrade bug of

[perl #23428] Somethings rotten in unicode semantics

p4raw-id: //depot/perl@20804

diff --git a/pp_sys.c b/pp_sys.c
index d8dc103..f35bc8a 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1807,9 +1807,12 @@ PP(pp_send)
        buffer = SvPVutf8(bufsv, blen);
     }
     else {
-       if (DO_UTF8(bufsv))
-           sv_utf8_downgrade(bufsv, FALSE);
-       buffer = SvPV(bufsv, blen);
+        if (DO_UTF8(bufsv)) {
+             /* Not modifying source SV, so making a temporary copy. */
+             bufsv = sv_2mortal(newSVsv(bufsv));
+             sv_utf8_downgrade(bufsv, FALSE);
+        }
+        buffer = SvPV(bufsv, blen);
     }
 
     if (PL_op->op_type == OP_SYSWRITE) {

diff --git a/t/io/utf8.t b/t/io/utf8.t
index 6a24c51..6b189ee 100755 (executable)
--- a/t/io/utf8.t
+++ b/t/io/utf8.t
@@ -13,7 +13,7 @@ no utf8; # needed for use utf8 not griping about the raw octets
 
 require "./test.pl";
 
-plan(tests => 49);
+plan(tests => 51);
 
 $| = 1;
 
@@ -301,6 +301,15 @@ ok( 1 );
     # last test here 49
 }
 
+{
+    # [perl #23428] Somethings rotten in unicode semantics
+    open F, ">a";
+    binmode F, ":utf8";
+    syswrite(F, $a = chr(0x100));
+    is( ord($a), 0x100, '23428 syswrite should not downgrade scalar' );
+    like( $a, qr/^\w+/, '23428 syswrite should not downgrade scalar' );
+}
+
 # sysread() and syswrite() tested in lib/open.t since Fcntl is used
 
 END {