From e111333b72ffd26648b6fa15ed174f2b75d8b62c Mon Sep 17 00:00:00 2001 From: Jarkko Hietaniemi Date: Mon, 19 Nov 2001 20:18:42 +0000 Subject: [PATCH] Move the sysio tests from io/utf8 to lib/open. p4raw-id: //depot/perl@13106 --- lib/open.t | 103 +++++++++++++++++++++++++++++++++++++++++++++++++++++++----- t/io/utf8.t | 74 +++---------------------------------------- 2 files changed, 100 insertions(+), 77 deletions(-) diff --git a/lib/open.t b/lib/open.t index 5ee8ab9..07fde4d 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, "), 0x100, ":utf8"); + is(ord(), 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 --- 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"; } + + -- 2.7.4