X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Fopen.t;h=5bc4b6d18493dbce4d690641981518a48bf202cf;hb=e7ec2331900cd22a50f48dd01fa18bd3026f6253;hp=07fde4d7456e7e18697b067848e7ad24315abfbc;hpb=e111333b72ffd26648b6fa15ed174f2b75d8b62c;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/open.t b/lib/open.t index 07fde4d..5bc4b6d 100644 --- a/lib/open.t +++ b/lib/open.t @@ -6,7 +6,7 @@ BEGIN { require Config; import Config; } -use Test::More tests => 16; +use Test::More tests => 15; # open::import expects 'open' as its first argument, but it clashes with open() sub import { @@ -26,14 +26,6 @@ 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}' ); -} - my $warn; local $SIG{__WARN__} = sub { $warn .= shift; @@ -71,8 +63,9 @@ is( ${^OPEN}, ":raw :crlf\0:raw :crlf", is( $^H{'open_IO'}, 'crlf', 'should record last layer set in %^H' ); SKIP: { - skip("no perlio, no :utf8", 1) unless $Config{'useperlio'}; -# the special :utf8 layer + skip("no perlio, no :utf8", 4) unless $Config{'useperlio'}; + + eval <utf8"); print O chr(0x100); @@ -80,92 +73,93 @@ SKIP: { open(I, "), 0x100, ":utf8 single wide character round-trip"); close I; -} +EOE -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; + 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); -} + 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; + 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++; } - $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; + 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++; } - $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; + 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++; } - $ok++; + close G; + ok($ok == @a, + "checking syswrite() output on :utf8 streams by reading it back in"); } -close G; -ok($ok == @a, - "checking syswrite() output on :utf8 streams by reading it back in"); END { 1 while unlink "utf8"; @@ -181,7 +175,7 @@ eval { open::_get_locale_encoding() }; like( $@, qr/too ambiguous/, 'should die with ambiguous locale encoding' ); %%% # the special :locale layer -$ENV{LANG} = 'ru_RU.KOI8-R'; +$ENV{LC_ALL} = $ENV{LANG} = 'ru_RU.KOI8-R'; # the :locale will probe the locale environment variables like LANG use open OUT => ':locale'; open(O, ">koi8");