avoid sysread()/syswrite() warnings from the default :utf8 from PERL_UNICODE

In a UTF-8 locale, if the PERL_UNICODE environment variable is set,
perl may add a :utf8 layer.

v5.23.1-197-gfb10a8a deprecated using sysread(), syswrite() etc on such
handles, which meant that a test run under PERL_UNICODE could produce
a significant number of deprecation warnings.

Prevent those warnings, typically by binmode(), but in one case by
disabling the warning.

9 files changed, 56 insertions, 22 deletions

diff --git a/ext/Fcntl/t/fcntl.t b/ext/Fcntl/t/fcntl.t
index b689f781cc..af649b52ce 100644
--- a/ext/Fcntl/t/fcntl.t
+++ b/ext/Fcntl/t/fcntl.t
@@ -12,11 +12,13 @@ print "1..7\n";
 print "ok 1\n";
 
 if (sysopen(my $wo, "fcntl$$", O_WRONLY|O_CREAT)) {
+    binmode $wo;
     print "ok 2\n";
     if (syswrite($wo, "foo") == 3) {
 	print "ok 3\n";
 	close($wo);
 	if (sysopen(my $ro, "fcntl$$", O_RDONLY)) {
+            binmode $ro;
 	    print "ok 4\n";
 	    if (sysread($ro, my $read, 3)) {
 		print "ok 5\n";
diff --git a/ext/Fcntl/t/syslfs.t b/ext/Fcntl/t/syslfs.t
index 00e072ba60..7537d54876 100644
--- a/ext/Fcntl/t/syslfs.t
+++ b/ext/Fcntl/t/syslfs.t
@@ -72,6 +72,7 @@ if ($^O eq 'unicos') {
 
 sysopen(BIG, $big1, O_WRONLY|O_CREAT|O_TRUNC) or
     die "sysopen $big1 failed: $!";
+binmode BIG;
 sysseek(BIG, 1_000_000, SEEK_SET) or
     die "sysseek $big1 failed: $!";
 syswrite(BIG, "big") or
@@ -85,6 +86,7 @@ print "# s1 = @s1\n";
 
 sysopen(BIG, $big2, O_WRONLY|O_CREAT|O_TRUNC) or
     die "sysopen $big2 failed: $!";
+binmode BIG;
 sysseek(BIG, 2_000_000, SEEK_SET) or
     die "sysseek $big2 failed: $!";
 syswrite(BIG, "big") or
@@ -127,6 +129,7 @@ EOF
 
 sysopen(BIG, $big0, O_WRONLY|O_CREAT|O_TRUNC) or
     die "sysopen $big0 failed: $!";
+binmode BIG;
 my $sysseek = sysseek(BIG, 5_000_000_000, SEEK_SET);
 unless (! $r && defined $sysseek && $sysseek == 5_000_000_000) {
     $sysseek = 'undef' unless defined $sysseek;
@@ -192,7 +195,7 @@ is(-e $big0, 1);
 is(-f $big0, 1);
 
 sysopen(BIG, $big0, O_RDONLY) or die "sysopen failed: $!";
-
+binmode BIG;
 offset('sysseek(BIG, 4_500_000_000, SEEK_SET)', 4_500_000_000);
 
 offset('sysseek(BIG, 0, SEEK_CUR)', 4_500_000_000);
diff --git a/lib/File/Copy.t b/lib/File/Copy.t
index 05590b262f..25f340d1c0 100644
--- a/lib/File/Copy.t
+++ b/lib/File/Copy.t
@@ -66,12 +66,14 @@ for my $cross_partition_test (0..1) {
   unlink "copy-$$" or die "unlink: $!";
 
   open(F, "<", "file-$$");
+  binmode F;
   copy(*F, "copy-$$");
-  open(R, "<", "copy-$$") or die "open copy-$$: $!"; $foo = <R>; close(R);
+  open(R, "<:raw", "copy-$$") or die "open copy-$$: $!"; $foo = <R>; close(R);
   is $foo, "ok\n", 'copy(*F, fn): same contents';
   unlink "copy-$$" or die "unlink: $!";
 
   open(F, "<", "file-$$");
+  binmode F;
   copy(\*F, "copy-$$");
   close(F) or die "close: $!";
   open(R, "<", "copy-$$") or die; $foo = <R>; close(R) or die "close: $!";
@@ -345,6 +347,7 @@ SKIP: {
             chmod $c_perm3 => $copy6 or die $!;
 
             open my $fh => "<", $src or die $!;
+            binmode $fh;
 
             copy ($src, $copy1);
             copy ($fh,  $copy2);
@@ -465,6 +468,8 @@ SKIP: {
 
     open(my $IN, "-|") || exec $^X, '-e', 'print "Hello, world!\n"';
     open(my $OUT, "|-") || exec $^X, '-ne', 'exit(/Hello/ ? 55 : 0)';
+    binmode $IN;
+    binmode $OUT;
 
     ok(copy($IN, $OUT), "copy pipe to another");
     close($OUT);
diff --git a/t/io/socket.t b/t/io/socket.t
index 0629c64952..d1251d3a9e 100644
--- a/t/io/socket.t
+++ b/t/io/socket.t
@@ -70,7 +70,7 @@ SKIP: {
 	       "make accept tcp socket");
 	    ok(my $addr = accept($accept, $serv), "accept() works")
 		or diag "accept error: $!";
-
+            binmode $accept;
 	    my $sent_total = 0;
 	    while ($sent_total < length $send_data) {
 		my $sent = send($accept, substr($send_data, $sent_total), 0);
@@ -98,7 +98,7 @@ SKIP: {
 
 	    ok_child(connect($child, $bind_name), "connect() works")
 		or diag "connect error: $!";
-
+            binmode $child;
 	    my $buf;
 	    my $recv_peer = recv($child, $buf, 1000, 0);
 	    {
diff --git a/t/io/through.t b/t/io/through.t
index 65a64bbcaf..3d42a2594e 100644
--- a/t/io/through.t
+++ b/t/io/through.t
@@ -10,6 +10,8 @@ BEGIN {
 
 use strict;
 
+++$|;
+
 my $Perl = which_perl();
 
 my $data = <<'EOD';
@@ -35,8 +37,8 @@ $c += 6;	# Tests with sleep()...
 
 print "1..$c\n";
 
-my $set_out = '';
-$set_out = "binmode STDOUT, ':crlf'"
+my $set_out = "binmode STDOUT, ':raw'";
+$set_out = "binmode STDOUT, ':raw:crlf'"
     if defined  $main::use_crlf && $main::use_crlf == 1;
 
 sub testread ($$$$$$$) {
@@ -89,6 +91,7 @@ sub testpipe ($$$$$$) {
   } else {
     die "Unrecognized write: '$how_w'";
   }
+  binmode $fh; # remove any :utf8 set by PERL_UNICODE
   binmode $fh, ':crlf'
       if defined $main::use_crlf && $main::use_crlf == 1;
   testread($fh, $str, $read_c, $how_r, $write_c, $how_w, "pipe$why");
@@ -101,6 +104,7 @@ sub testfile ($$$$$$) {
   my $filename = tempfile();
   open my $fh, '>', $filename or die "open: > $filename: $!";
   select $fh;
+  binmode $fh; # remove any :utf8 set by PERL_UNICODE
   binmode $fh, ':crlf' 
       if defined $main::use_crlf && $main::use_crlf == 1;
   if ($how_w eq 'print') {	# AUTOFLUSH???
@@ -116,6 +120,7 @@ sub testfile ($$$$$$) {
   }
   close $fh or die "close: $!";
   open $fh, '<', $filename or die "open: < $filename: $!";
+  binmode $fh;
   binmode $fh, ':crlf'
       if defined $main::use_crlf && $main::use_crlf == 1;
   testread($fh, $str, $read_c, $how_r, $write_c, $how_w, "file$why");
diff --git a/t/op/gmagic.t b/t/op/gmagic.t
index 1226e3a785..5b2845bab4 100644
--- a/t/op/gmagic.t
+++ b/t/op/gmagic.t
@@ -64,11 +64,13 @@ expected_tie_calls(tied $c, 1, 2, 'chomping a ref');
 {
     my $outfile = tempfile();
     open my $h, ">$outfile" or die  "$0 cannot close $outfile: $!";
+    binmode $h;
     print $h "bar\n";
     close $h or die "$0 cannot close $outfile: $!";    
 
     $c = *foo;                                         # 1 write
     open $h, $outfile;
+    binmode $h;
     sysread $h, $c, 3, 7;                              # 1 read; 1 write
     is $c, "*main::bar", 'what sysread wrote';         # 1 read
     expected_tie_calls(tied $c, 2, 2, 'calling sysread with tied buf');
diff --git a/t/op/readline.t b/t/op/readline.t
index 2ee153442c..c2727fe829 100644
--- a/t/op/readline.t
+++ b/t/op/readline.t
@@ -63,7 +63,7 @@ foreach my $l (1, 21) {
 
 use strict;
 
-open F, '.' and sysread F, $_, 1;
+open F, '.' and binmode F and sysread F, $_, 1;
 my $err = $! + 0;
 close F;
 
@@ -148,6 +148,9 @@ SKIP: {
 	skip( 2, 'The pipe function is unimplemented' );
     }
 
+    binmode $out;
+    binmode $in;
+
     # Make the pipe autoflushing
     {
 	my $old_fh = select $out;
diff --git a/t/op/sysio.t b/t/op/sysio.t
index b95def0ecb..ebcf821d37 100644
--- a/t/op/sysio.t
+++ b/t/op/sysio.t
@@ -9,6 +9,7 @@ BEGIN {
 plan tests => 48;
 
 open(I, 'op/sysio.t') || die "sysio.t: cannot find myself: $!";
+binmode I;
 
 $reopen = ($^O eq 'VMS' ||
            $^O eq 'os2' ||
@@ -55,6 +56,7 @@ is($a, "#!.\0\0erl");
 $outfile = tempfile();
 
 open(O, ">$outfile") || die "sysio.t: cannot write $outfile: $!";
+binmode O;
 
 select(O); $|=1; select(STDOUT);
 
@@ -82,6 +84,7 @@ syswrite(O, $x, 1, 3);
 # $outfile still intact
 if ($reopen) {  # must close file to update EOF marker for stat
   close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!";
+  binmode O;
 }
 ok(!-s $outfile);
 
@@ -96,6 +99,7 @@ is($x, 'abc');
 # $outfile still intact
 if ($reopen) {  # must close file to update EOF marker for stat
   close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!";
+  binmode O;
 }
 ok(!-s $outfile);
 
@@ -109,6 +113,7 @@ is($x, 'abc');
 # $outfile still intact
 if ($reopen) {  # must close file to update EOF marker for stat
   close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!";
+  binmode O;
 }
 ok(!-s $outfile);
 
@@ -121,6 +126,7 @@ is($x, 'abc');
 # $outfile still intact
 if ($reopen) {  # must close file to update EOF marker for stat
   close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!";
+  binmode O;
 }
 ok(!-s $outfile);
 
@@ -141,6 +147,7 @@ is($a, "#!.\0\0erl");
 # $outfile should have grown now
 if ($reopen) {  # must close file to update EOF marker for stat
   close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!";
+  binmode O;
 }
 is(-s $outfile, 2);
 
@@ -153,6 +160,7 @@ is($a, "#!.\0\0erl");
 # $outfile should have grown now
 if ($reopen) {  # must close file to update EOF marker for stat
   close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!";
+  binmode O;
 }
 is(-s $outfile, 4);
 
@@ -165,6 +173,7 @@ is($a, "#!.\0\0erl");
 # $outfile should have grown now
 if ($reopen) {  # must close file to update EOF marker for stat
   close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!";
+  binmode O;
 }
 is(-s $outfile, 7);
 
@@ -177,12 +186,14 @@ is($x, "abc");
 # $outfile should have grown now
 if ($reopen) {  # must close file to update EOF marker for stat
   close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!";
+  binmode O;
 }
 is(-s $outfile, 10);
 
 close(O);
 
 open(I, $outfile) || die "sysio.t: cannot read $outfile: $!";
+binmode I;
 
 $b = 'xyz';
 
@@ -211,26 +222,29 @@ close(I);
 unlink_all $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/;
+{
+    no warnings 'deprecated';
+    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;
+    # y diaresis is \w when UTF8
+    $a = chr 255;
 
-unlike($a, qr/\w/);
+    unlike($a, qr/\w/);
 
-syswrite I, $a;
+    syswrite I, $a;
 
-# Should not be upgraded as a side effect of syswrite.
-unlike($a, qr/\w/);
+    # Should not be upgraded as a side effect of syswrite.
+    unlike($a, qr/\w/);
 
-# This should work
-eval {syswrite I, 2;};
-is($@, '');
+    # This should work
+    eval {syswrite I, 2;};
+    is($@, '');
 
-close(I);
+    close(I);
+}
 unlink_all $outfile;
 
 chdir('..');
diff --git a/t/op/taint.t b/t/op/taint.t
index 0988c7e0e0..1c6eceaf8a 100644
--- a/t/op/taint.t
+++ b/t/op/taint.t
@@ -1065,7 +1065,7 @@ SKIP: {
 # Reading from a file should be tainted
 {
     ok(open my $fh, '<', $TEST) or diag("Couldn't open '$TEST': $!");
-
+    binmode $fh;
     my $block;
     sysread($fh, $block, 100);
     my $line = <$fh>;