Move the sysio tests from io/utf8 to lib/open.

p4raw-id: //depot/perl@13106

1 files changed, 96 insertions, 7 deletions

diff --git a/lib/open.t b/lib/open.t
index 5ee8ab9de0..07fde4d745 100644
--- a/lib/open.t
+++ b/lib/open.t
@@ -6,7 +6,7 @@ BEGIN {
 	require Config; import Config;
 }
 
-use Test::More tests => 13;
+use Test::More tests => 16;
 
 # open::import expects 'open' as its first argument, but it clashes with open()
 sub import {
@@ -26,11 +26,13 @@ is( $^H & $open::hint_bits, 0,
 	'hint bits should not be set in $^H before open import' );
 
 # prevent it from loading I18N::Langinfo, so we can test encoding failures
-local @INC;
-$ENV{LC_ALL} = $ENV{LANG} = '';
-eval { import( 'IN', 'locale' ) };
-like( $@, qr/Cannot figure out an encoding/, 
-	'no encoding should be found without $ENV{LANG} or $ENV{LC_ALL}' );
+{
+    local @INC;
+    $ENV{LC_ALL} = $ENV{LANG} = '';
+    eval { import( 'IN', 'locale' ) };
+    like( $@, qr/Cannot figure out an encoding/, 
+	  'no encoding should be found without $ENV{LANG} or $ENV{LC_ALL}' );
+}
 
 my $warn;
 local $SIG{__WARN__} = sub {
@@ -76,12 +78,99 @@ SKIP: {
     print O chr(0x100);
     close O;
     open(I, "<utf8");
-    is(ord(<I>), 0x100, ":utf8");
+    is(ord(<I>), 0x100, ":utf8 single wide character round-trip");
     close I;
 }
 
+open F, ">a";
+@a = map { chr(1 << ($_ << 2)) } 0..5; # 0x1, 0x10, .., 0x100000
+unshift @a, chr(0); # ... and a null byte in front just for fun
+print F @a;
+close F;
+
+sub systell {
+    use Fcntl 'SEEK_CUR';
+    sysseek($_[0], 0, SEEK_CUR);
+}
+
+require bytes; # not use
+
+my $ok;
+
+open F, "<:utf8", "a";
+$ok = $a = 0;
+for (@a) {
+    unless (
+	    ($c = sysread(F, $b, 1)) == 1  &&
+            length($b)               == 1  &&
+            ord($b)                  == ord($_) &&
+	    systell(F)               == ($a += bytes::length($b))
+	    ) {
+        print '# ord($_)           == ', ord($_), "\n";
+        print '# ord($b)           == ', ord($b), "\n";
+        print '# length($b)        == ', length($b), "\n";
+        print '# bytes::length($b) == ', bytes::length($b), "\n";
+        print '# systell(F)        == ', systell(F), "\n";
+        print '# $a                == ', $a, "\n";
+        print '# $c                == ', $c, "\n";
+        last;
+    }
+    $ok++;
+}
+close F;
+ok($ok == @a,
+   "on :utf8 streams sysread() should work on characters, not bytes");
+
+# syswrite() on should work on characters, not bytes
+open G, ">:utf8", "b";
+$ok = $a = 0;
+for (@a) {
+    unless (
+	    ($c = syswrite(G, $_, 1)) == 1 &&
+            systell(G)                == ($a += bytes::length($_))
+	    ) {
+        print '# ord($_)           == ', ord($_), "\n";
+        print '# bytes::length($_) == ', bytes::length($_), "\n";
+        print '# systell(G)        == ', systell(G), "\n";
+        print '# $a                == ', $a, "\n";
+        print '# $c                == ', $c, "\n";
+        print "not ";
+        last;
+    }
+    $ok++;
+}
+close G;
+ok($ok == @a,
+   "on :utf8 streams syswrite() should work on characters, not bytes");
+
+open G, "<:utf8", "b";
+$ok = $a = 0;
+for (@a) {
+    unless (
+	    ($c = sysread(G, $b, 1)) == 1 &&
+	    length($b)               == 1 &&
+	    ord($b)                  == ord($_) &&
+	    systell(G)               == ($a += bytes::length($_))
+	    ) {
+        print '# ord($_)           == ', ord($_), "\n";
+        print '# ord($b)           == ', ord($b), "\n";
+        print '# length($b)        == ', length($b), "\n";
+        print '# bytes::length($b) == ', bytes::length($b), "\n";
+        print '# systell(G)        == ', systell(G), "\n";
+        print '# $a                == ', $a, "\n";
+        print '# $c                == ', $c, "\n";
+        last;
+    }
+    $ok++;
+}
+close G;
+ok($ok == @a,
+   "checking syswrite() output on :utf8 streams by reading it back in");
+
 END {
     1 while unlink "utf8";
+    1 while unlink "a";
+    1 while unlink "b";
 }
 
 # the test cases beyond __DATA__ need to be executed separately