diff options
author | Jarkko Hietaniemi <jhi@iki.fi> | 2002-03-28 01:43:52 +0000 |
---|---|---|
committer | Jarkko Hietaniemi <jhi@iki.fi> | 2002-03-28 01:43:52 +0000 |
commit | 7b89fb7c72364d7463347df7574856cfc24b94f9 (patch) | |
tree | 6ac7f226c94b539ad9a4a267bde744cab05f1d58 /t/io | |
parent | 29d6d7d54cac14b9377112773969cf75bbe7780f (diff) | |
download | perl-7b89fb7c72364d7463347df7574856cfc24b94f9.tar.gz |
More UTF-8 locale sensitivity.
p4raw-id: //depot/perl@15568
Diffstat (limited to 't/io')
-rwxr-xr-x | t/io/utf8.t | 153 |
1 files changed, 77 insertions, 76 deletions
diff --git a/t/io/utf8.t b/t/io/utf8.t index 01ebe7ec80..af356fc88f 100755 --- a/t/io/utf8.t +++ b/t/io/utf8.t @@ -64,92 +64,93 @@ print "ok 13\n"; close(F); { -$a = chr(300); # This *is* UTF-encoded -$b = chr(130); # This is not. - -open F, ">:utf8", 'a' or die $!; -print F $a,"\n"; -close F; - -open F, "<:utf8", 'a' or die $!; -$x = <F>; -chomp($x); -print "not " unless $x eq chr(300); -print "ok 14\n"; - -open F, "a" or die $!; # Not UTF -binmode(F, ":bytes"); -$x = <F>; -chomp($x); -$chr = chr(196).chr(172); -if (ord('A') == 193) { $chr = chr(141).chr(83); } # EBCDIC -print "not " unless $x eq $chr; -print "ok 15\n"; -close F; - -open F, ">:utf8", 'a' or die $!; -binmode(F); # we write a "\n" and then tell() - avoid CRLF issues. -print F $a; -my $y; -{ my $x = tell(F); - { use bytes; $y = length($a);} - print "not " unless $x == $y; - print "ok 16\n"; -} - -{ # Check byte length of $b -use bytes; my $y = length($b); -print "not " unless $y == 1; -print "ok 17\n"; -} - -print F $b,"\n"; # Don't upgrades $b - -{ # Check byte length of $b -use bytes; my $y = length($b); -print "not ($y) " unless $y == 1; -print "ok 18\n"; -} - -{ my $x = tell(F); - { use bytes; if (ord('A')==193){$y += 2;}else{$y += 3;}} # EBCDIC ASCII - print "not ($x,$y) " unless $x == $y; - print "ok 19\n"; -} - -close F; - -open F, "a" or die $!; # Not UTF -binmode(F, ":bytes"); -$x = <F>; -chomp($x); -$chr = v196.172.194.130; -if (ord('A') == 193) { $chr = v141.83.130; } # EBCDIC -printf "not (%vd) ", $x unless $x eq $chr; -print "ok 20\n"; - -open F, "<:utf8", "a" or die $!; -$x = <F>; -chomp($x); -close F; -printf "not (%vd) ", $x unless $x eq chr(300).chr(130); -print "ok 21\n"; - -if (${^OPEN} =~ /:utf8/) { + $a = chr(300); # This *is* UTF-encoded + $b = chr(130); # This is not. + + open F, ">:utf8", 'a' or die $!; + print F $a,"\n"; + close F; + + open F, "<:utf8", 'a' or die $!; + $x = <F>; + chomp($x); + print "not " unless $x eq chr(300); + print "ok 14\n"; + + open F, "a" or die $!; # Not UTF + binmode(F, ":bytes"); + $x = <F>; + chomp($x); + $chr = chr(196).chr(172); + if (ord('A') == 193) { $chr = chr(141).chr(83); } # EBCDIC + print "not " unless $x eq $chr; + print "ok 15\n"; + close F; + + open F, ">:utf8", 'a' or die $!; + binmode(F); # we write a "\n" and then tell() - avoid CRLF issues. + print F $a; + my $y; + { my $x = tell(F); + { use bytes; $y = length($a);} + print "not " unless $x == $y; + print "ok 16\n"; + } + + { # Check byte length of $b + use bytes; my $y = length($b); + print "not " unless $y == 1; + print "ok 17\n"; + } + + print F $b,"\n"; # Don't upgrades $b + + { # Check byte length of $b + use bytes; my $y = length($b); + print "not ($y) " unless $y == 1; + print "ok 18\n"; + } + + { + my $x = tell(F); + { use bytes; if (ord('A')==193){$y += 2;}else{$y += 3;}} # EBCDIC ASCII + print "not ($x,$y) " unless $x == $y; + print "ok 19\n"; + } + + close F; + + open F, "a" or die $!; # Not UTF + binmode(F, ":bytes"); + $x = <F>; + chomp($x); + $chr = v196.172.194.130; + if (ord('A') == 193) { $chr = v141.83.130; } # EBCDIC + printf "not (%vd) ", $x unless $x eq $chr; + print "ok 20\n"; + + open F, "<:utf8", "a" or die $!; + $x = <F>; + chomp($x); + close F; + printf "not (%vd) ", $x unless $x eq chr(300).chr(130); + print "ok 21\n"; -} else { - # Now let's make it suffer. open F, ">", "a" or die $!; + if (${^OPEN} =~ /:utf8/) { + binmode(F, ":bytes:"); + } + + # Now let's make it suffer. my $w; { use warnings 'utf8'; local $SIG{__WARN__} = sub { $w = $_[0] }; print F $a; + print "not " if ($@ || $w !~ /Wide character in print/i); } - print "not " if ($@ || $w !~ /Wide character in print/i); print "ok 22\n"; } -} # Hm. Time to get more evil. open F, ">:utf8", "a" or die $!; |