From: Nicholas Clark <nick@ccl4.org>
Date: Tue, 9 Mar 2004 16:11:37 +0000 (+0000)
Subject: Make a temporary copy of the input buffer in pp_send, so that send
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6aa2f6a7a4e2a0d061a689b227dcf063d93806a6;p=p5sagit%2Fp5-mst-13.2.git

Make a temporary copy of the input buffer in pp_send, so that send
and syswrite don't gratuitously upgrade their input to UTF8

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

diff --git a/pp_sys.c b/pp_sys.c
index d6f095b..ebc85d3 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1820,7 +1820,11 @@ PP(pp_send)
     }
 
     if (PerlIO_isutf8(IoIFP(io))) {
-	buffer = SvPVutf8(bufsv, blen);
+	if (!SvUTF8(bufsv)) {
+	    bufsv = sv_2mortal(newSVsv(bufsv));
+	    buffer = sv_2pvutf8(bufsv, &blen);
+	} else
+	    buffer = SvPV(bufsv, blen);
     }
     else {
 	 if (DO_UTF8(bufsv)) {
diff --git a/t/op/sysio.t b/t/op/sysio.t
index 473a3f0..435be12 100755
--- a/t/op/sysio.t
+++ b/t/op/sysio.t
@@ -1,8 +1,9 @@
 #!./perl
 
-print "1..39\n";
+print "1..42\n";
 
 chdir('op') || chdir('t/op') || die "sysio.t: cannot look for myself: $!";
+@INC = '../../lib';
 
 open(I, 'sysio.t') || die "sysio.t: cannot find myself: $!";
 
@@ -213,6 +214,29 @@ close(I);
 
 unlink $outfile;
 
+# Check that utf8 IO doesn't upgrade the scalar
+open(I, ">$outfile") || die "sysio.t: cannot write $outfile: $!";
+# Will skip harmlessly on stdioperl
+eval {binmode STDOUT, ":utf8"};
+die $@ if $@ and $@ !~ /^IO layers \(like ':utf8'\) unavailable/;
+
+# y diaresis is \w when UTF8
+$a = chr 255;
+
+print $a =~ /\w/ ? "not ok 40\n" : "ok 40\n";
+
+syswrite I, $a;
+
+# Should not be upgraded as a side effect of syswrite.
+print $a =~ /\w/ ? "not ok 41\n" : "ok 41\n";
+
+# This should work
+eval {syswrite I, 2;};
+print $@ eq "" ? "ok 42\n" : "not ok 42 # $@";
+
+close(I);
+unlink $outfile;
+
 chdir('..');
 
 1;