diff options
-rw-r--r-- | ext/PerlIO-encoding/t/encoding.t | 110 |
1 files changed, 35 insertions, 75 deletions
diff --git a/ext/PerlIO-encoding/t/encoding.t b/ext/PerlIO-encoding/t/encoding.t index 75c5e145d6..4642bd8e8c 100644 --- a/ext/PerlIO-encoding/t/encoding.t +++ b/ext/PerlIO-encoding/t/encoding.t @@ -11,7 +11,7 @@ BEGIN { } } -print "1..15\n"; +use Test::More tests => 18; my $grk = "grk$$"; my $utf = "utf$$"; @@ -28,12 +28,9 @@ if (open(GRK, ">$grk")) { } { - open(my $i,'<:encoding(iso-8859-7)',$grk); - print "ok 1\n"; - open(my $o,'>:utf8',$utf); - print "ok 2\n"; - print $o readline($i); - print "ok 3\n"; + is(open(my $i,'<:encoding(iso-8859-7)',$grk), 1); + is(open(my $o,'>:utf8',$utf), 1); + is((print $o readline $i), 1); close($o) or die "Could not close: $!"; close($i); } @@ -42,93 +39,58 @@ if (open(UTF, "<$utf")) { binmode(UTF, ":bytes"); if (ord('A') == 193) { # EBCDIC # alpha beta gamma in UTF-EBCDIC Unicode (0x3b1 0x3b2 0x3b3) - print "not " unless <UTF> eq "\xb4\x58\xb4\x59\xb4\x62"; + is(scalar <UTF>, "\xb4\x58\xb4\x59\xb4\x62"); } else { # alpha beta gamma in UTF-8 Unicode (0x3b1 0x3b2 0x3b3) - print "not " unless <UTF> eq "\xce\xb1\xce\xb2\xce\xb3"; + is(scalar <UTF>, "\xce\xb1\xce\xb2\xce\xb3"); } - print "ok 4\n"; close UTF; } { use Encode; - open(my $i,'<:utf8',$utf); - print "ok 5\n"; - open(my $o,'>:encoding(iso-8859-7)',$grk); - print "ok 6\n"; - print $o readline($i); - print "ok 7\n"; + is (open(my $i,'<:utf8',$utf), 1); + is (open(my $o,'>:encoding(iso-8859-7)',$grk), 1); + is ((scalar print $o readline $i), 1); close($o) or die "Could not close: $!"; close($i); } if (open(GRK, "<$grk")) { binmode(GRK, ":bytes"); - print "not " unless <GRK> eq "\xe1\xe2\xe3"; - print "ok 8\n"; + is(scalar <GRK>, "\xe1\xe2\xe3"); close GRK; } $SIG{__WARN__} = sub {$warn .= $_[0]}; -if (open(FAIL, ">:encoding(NoneSuch)", $fail1)) { - print "not ok 9 # Open should fail\n"; -} else { - print "ok 9\n"; -} -if (!defined $warn) { - print "not ok 10 # warning is undef\n"; -} elsif ($warn =~ /^Cannot find encoding "NoneSuch" at/) { - print "ok 10\n"; -} else { - print "not ok 10 # warning is '$warn'"; -} - -if (open(RUSSKI, ">$russki")) { - print RUSSKI "\x3c\x3f\x78"; - close RUSSKI or die "Could not close: $!"; - open(RUSSKI, "$russki"); - binmode(RUSSKI, ":raw"); - my $buf1; - read(RUSSKI, $buf1, 1); - # eof(RUSSKI); - binmode(RUSSKI, ":encoding(koi8-r)"); - my $buf2; - read(RUSSKI, $buf2, 1); - my $offset = tell(RUSSKI); - if (ord($buf1) == 0x3c && - ord($buf2) == (ord('A') == 193) ? 0x6f : 0x3f && - $offset == 2) { - print "ok 11\n"; - } else { - printf "not ok 11 # [%s] [%s] %d\n", - join(" ", unpack("H*", $buf1)), - join(" ", unpack("H*", $buf2)), $offset; - } - close(RUSSKI); -} else { - print "not ok 11 # open failed: $!\n"; -} +is (open(FAIL, ">:encoding(NoneSuch)", $fail1), undef, 'Open should fail'); +like($warn, qr/^Cannot find encoding "NoneSuch" at/); + +is(open(RUSSKI, ">$russki"), 1); +print RUSSKI "\x3c\x3f\x78"; +close RUSSKI or die "Could not close: $!"; +open(RUSSKI, "$russki"); +binmode(RUSSKI, ":raw"); +my $buf1; +read(RUSSKI, $buf1, 1); +# eof(RUSSKI); +binmode(RUSSKI, ":encoding(koi8-r)"); +my $buf2; +read(RUSSKI, $buf2, 1); +my $offset = tell(RUSSKI); +is(ord $buf1, 0x3c); +is(ord $buf2, (ord('A') == 193) ? 0x6f : 0x3f); +is($offset, 2); +close RUSSKI; undef $warn; # Check there is no Use of uninitialized value in concatenation (.) warning # due to the way @latin2iso_num was used to make aliases. -if (open(FAIL, ">:encoding(latin42)", $fail2)) { - print "not ok 12 # Open should fail\n"; -} else { - print "ok 12\n"; -} -if (!defined $warn) { - print "not ok 13 # warning is undef\n"; -} elsif ($warn =~ /^Cannot find encoding "latin42" at.*line \d+\.$/) { - print "ok 13\n"; -} else { - print "not ok 13 # warning is: \n"; - $warn =~ s/^/# /mg; - print "$warn"; -} +is(open(FAIL, ">:encoding(latin42)", $fail2), undef, 'Open should fail'); + +like($warn, qr/^Cannot find encoding "latin42" at.*line \d+\.$/); # Create a string of chars that are 3 bytes in UTF-8 my $str = "\x{1f80}" x 2048; @@ -142,8 +104,7 @@ close(F); open(F,'<:encoding(utf-8)',$threebyte) || die "Cannot open $threebyte:$!"; my $dstr = <F>; close(F); -print "not " unless ($dstr eq $str); -print "ok 14\n"; +is($dstr, $str); # Try decoding some bad stuff open(F,'>:raw',$threebyte) || die "Cannot open $threebyte:$!"; @@ -158,11 +119,10 @@ open(F,'<:encoding(utf-8)',$threebyte) || die "Cannot open $threebyte:$!"; $dstr = join(":", <F>); close(F); if (ord('A') == 193) { # EBCDIC - print "not " unless $dstr eq "foo\\x8C\\x80\\x80\\x80bar\n:\\x80foo\n"; + is($dstr, "foo\\x8C\\x80\\x80\\x80bar\n:\\x80foo\n"); } else { - print "not " unless $dstr eq "foo\\xF0\\x80\\x80\\x80bar\n:\\x80foo\n"; + is($dstr, "foo\\xF0\\x80\\x80\\x80bar\n:\\x80foo\n"); } -print "ok 15\n"; END { 1 while unlink($grk, $utf, $fail1, $fail2, $russki, $threebyte); |