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

p4raw-id: //depot/perl@13106

diff --git a/lib/open.t b/lib/open.t
index 5ee8ab9..07fde4d 100644 (file)
--- 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

diff --git a/t/io/utf8.t b/t/io/utf8.t
index 0447603..e8caf72 100755 (executable)
--- a/t/io/utf8.t
+++ b/t/io/utf8.t
@@ -12,7 +12,7 @@ BEGIN {
 no utf8; # needed for use utf8 not griping about the raw octets
 
 $| = 1;
-print "1..29\n";
+print "1..26\n";
 
 open(F,"+>:utf8",'a');
 print F chr(0x100).'£';
@@ -216,77 +216,11 @@ for (@a) {
 close F;
 print "ok 26\n";
 
-sub systell { sysseek($_[0], 0, 1) }
-
-# sysread() should work on characters, not bytes
-open F, "<:utf8", "a";
-$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";
-        print "not ";
-        last;
-    }
-}
-close F;
-print "ok 27\n";
-
-# syswrite() on should work on characters, not bytes
-open G, ">:utf8", "b";
-$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;
-    }
-}
-close G;
-print "ok 28\n";
-
-# did syswrite() get it right?
-open G, "<:utf8", "b";
-$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";
-        print "not ";
-        last;
-    }
-}
-close G;
-print "ok 29\n";
+# sysread() and syswrite() tested in lib/open.t since Fnctl is used
 
 END {
     1 while unlink "a";
     1 while unlink "b";
 }
+
+