BEGIN {
- chdir 't' if -d 't' and $ENV{PWD} !~ m,/Encode[^/]*$,o;
- unshift @INC, '../lib';
+ if ($ENV{'PERL_CORE'}){
+ chdir 't';
+ unshift @INC, '../lib';
+ }
require Config; import Config;
if ($Config{'extensions'} !~ /\bEncode\b/) {
print "1..0 # Skip: Encode was not built\n";
exit 0;
}
- unless (find PerlIO::Layer 'perlio') {
- print "1..0 # Skip: PerlIO was not built\n";
- exit 0;
- }
if (ord("A") == 193) {
print "1..0 # Skip: EBCDIC\n";
exit 0;
$| = 1;
}
use strict;
-use Test::More tests => 27;
+use Test::More tests => 37;
+#use Test::More qw(no_plan);
use Encode;
use File::Basename;
use File::Spec;
my ($src, $uni, $dst, $txt, $euc, $utf, $ref, $rnd);
-ok(defined(my $enc = find_encoding('euc-jp')));
-ok($enc->isa('Encode::XS'));
-is($enc->name,'euc-jp');
+ok(defined(my $enc = find_encoding('euc-jp')), 'find_encoding');
+ok($enc->isa('Encode::XS'), 'ISA');
+is($enc->name,'euc-jp', '$enc->name');
my $dir = dirname(__FILE__);
-my @subcodings = qw(jisx0212 jisx0208);
-
-for my $subcoding (@subcodings){
- $euc = File::Spec->catfile($dir,"$subcoding.euc");
+for my $charset (qw(jisx0201 jisx0212 jisx0208)){
+ $euc = File::Spec->catfile($dir,"$charset.euc");
$utf = File::Spec->catfile($dir,"$$.utf8");
- $ref = File::Spec->catfile($dir,"$subcoding.ref");
+ $ref = File::Spec->catfile($dir,"$charset.ref");
$rnd = File::Spec->catfile($dir,"$$.rnd");
- print "# Basic decode test\n";
- open($src,"<",$euc) || die "Cannot open $euc:$!";
+
+ open($src,"<",$euc) or die "Cannot open $euc:$!";
binmode($src);
- ok(defined($src) && fileno($src));
$txt = join('',<$src>);
- open($dst,">:utf8",$utf) || die "Cannot open $utf:$!";
- binmode($dst);
- ok(defined($dst) && fileno($dst));
- eval{ $uni = $enc->decode($txt,1) };
- $@ and print $@;
- ok(defined($uni));
- is(length($txt),0);
- print $dst $uni;
- close($dst);
close($src);
- ok(compare($utf,$ref) == 0);
-}
+
+ eval{ $uni = $enc->decode($txt, 1) };
+ $@ and print $@;
+ ok(defined($uni), "decode $charset");
+ is(length($txt),0, "decode $charset completely");
-print "# Basic encode test\n";
-open($src,"<:utf8",$ref) || die "Cannot open $ref:$!";
-binmode($src);
-ok(defined($src) && fileno($src));
-$uni = join('',<$src>);
-open($dst,">",$rnd) || die "Cannot open $rnd:$!";
-binmode($dst);
-ok(defined($dst) && fileno($dst));
-$txt = $enc->encode($uni,1);
-ok(defined($txt));
-is(length($uni),0);
-print $dst $txt;
-close($dst);
-close($src);
-ok(compare($euc,$rnd) == 0);
+ open($dst,">:utf8",$utf) or die "Cannot open $utf:$!";
+ binmode($dst);
+ print $dst $uni;
+ close($dst);
+ is(compare($utf, $ref), 0, "$utf eq $ref");
+
+ open $src, "<:utf8", $ref or die "$ref : $!";
+ $uni = join('', <$src>);
+ close $src;
-is($enc->name,'euc-jp');
+ for my $canon (qw(euc-jp shiftjis
+ 7bit-jis iso-2022-jp iso-2022-jp-1)){
+ my $test = \&is;
+ if ($charset eq 'jisx0201'){
+ $canon eq 'iso-2022-jp' and $test = \&isnt;
+ $canon eq 'iso-2022-jp-1' and $test = \&isnt;
+ }elsif($charset eq 'jisx0212'){
+ $canon eq 'shiftjis' and $test = \&isnt;
+ $canon eq 'iso-2022-jp' and $test = \&isnt;
+ }
+ my $rt = ($test eq \&is) ? 'RT' : 'non-RT';
+ $test->($uni, decode($canon, encode($canon, $uni)),
+ "$rt $charset $canon");
+
+ }
-print "# src :encoding test\n";
-open($src,"<encoding(euc-jp)",$euc) || die "Cannot open $euc:$!";
-binmode($src);
-ok(defined($src) && fileno($src));
-open($dst,">:utf8",$utf) || die "Cannot open $utf:$!";
-binmode($dst);
-ok(defined($dst) || fileno($dst));
-my $out = select($dst);
-while (<$src>)
- {
- print;
- }
-close($dst);
-close($src);
-TODO:
-{
- local $TODO = 'needs debugging on VMS' if $^O eq 'VMS';
- ok(compare($utf,$ref) == 0);
-}
-select($out);
+ eval{ $txt = $enc->encode($uni,1) };
+ $@ and print $@;
+ ok(defined($txt), "encode $charset");
+ is(length($uni), 0, "encode $charset completely");
-SKIP:
-{
- #skip "Multi-byte write is broken",3;
- print "# dst :encoding test\n";
- open($src,"<:utf8",$ref) || die "Cannot open $ref:$!";
- binmode($src);
- ok(defined($src) || fileno($src));
- open($dst,">encoding(euc-jp)",$rnd) || die "Cannot open $rnd:$!";
- binmode($dst);
- ok(defined($dst) || fileno($dst));
- my $out = select($dst);
- while (<$src>)
- {
- print;
- }
- close($dst);
- close($src);
- ok(compare($euc,$rnd) == 0);
- select($out);
+ open($dst,">", $rnd) or die "Cannot open $utf:$!";
+ binmode($dst);
+ print $dst $txt;
+ close($dst);
+ is(compare($euc, $rnd), 0 => "$rnd eq $euc");
}
-is($enc->name,'euc-jp');
END {
1 while unlink($utf,$rnd);
}