This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add test for Japanese encoding (well euc-jp anyway).
[perl5.git] / ext / Encode / t / Japanese.t
CommitLineData
0a95303c
NIS
1BEGIN {
2# chdir 't' if -d 't';
3# @INC = (-d '../../lib' ? '../lib';
4 require Config; import Config;
5 if ($Config{'extensions'} !~ /\bEncode\b/) {
6 print "1..0 # Skip: Encode was not built\n";
7 exit 0;
8 }
9 $| = 1;
10}
11use Test::More tests => 22;
12use Encode;
13use File::Basename;
14use File::Spec;
15use File::Compare;
16require_ok "Encode::Japanese";
17
18ok(defined(my $enc = find_encoding('euc-jp')));
19ok($enc->isa('Encode::XS'));
20is($enc->name,'euc-jp');
21my $dir = dirname(__FILE__);
22my $euc = File::Spec->catfile($dir,"table.euc");
23my $utf = File::Spec->catfile($dir,"table.utf8");
24my $ref = File::Spec->catfile($dir,"table.ref");
25my $rnd = File::Spec->catfile($dir,"table.rnd");
26print "# Basic decode test\n";
27open(my $src,"<",$euc) || die "Cannot open $euc:$!";
28ok(defined($src) && fileno($src));
29my $txt = join('',<$src>);
30open(my $dst,">:utf8",$utf) || die "Cannot open $utf:$!";
31ok(defined($dst) && fileno($dst));
32my $uni = $enc->decode($txt,1);
33ok(defined($uni));
34is(length($txt),0);
35print $dst $uni;
36close($dst);
37close($src);
38ok(compare($utf,$ref) == 0);
39
40print "# Basic encode test\n";
41open(my $src,"<:utf8",$ref) || die "Cannot open $ref:$!";
42ok(defined($src) && fileno($src));
43my $uni = join('',<$src>);
44open(my $dst,">",$rnd) || die "Cannot open $rnd:$!";
45ok(defined($dst) && fileno($dst));
46my $txt = $enc->encode($uni,1);
47ok(defined($txt));
48is(length($uni),0);
49print $dst $txt;
50close($dst);
51close($src);
52ok(compare($euc,$rnd) == 0);
53
54is($enc->name,'euc-jp');
55
56print "# src :encoding test\n";
57open(my $src,"<encoding(euc-jp)",$euc) || die "Cannot open $euc:$!";
58ok(defined($src) && fileno($src));
59open(my $dst,">:utf8",$utf) || die "Cannot open $utf:$!";
60ok(defined($dst) || fileno($dst));
61$out = select($dst);
62while (<$src>)
63 {
64 print;
65 }
66close($dst);
67close($src);
68ok(compare($utf,$ref) == 0);
69select($out);
70
71SKIP:
72{
73 skip "Multi-byte write is broken",3;
74 print "# dst :encoding test\n";
75 open(my $src,"<:utf8",$ref) || die "Cannot open $ref:$!";
76 ok(defined($src) || fileno($src));
77 open(my $dst,">encoding(euc-jp)",$rnd) || die "Cannot open $rnd:$!";
78 ok(defined($dst) || fileno($dst));
79 my $out = select($dst);
80 while (<$src>)
81 {
82 print;
83 }
84 close($dst);
85 close($src);
86 ok(compare($euc,$rnd) == 0);
87 select($out);
88}
89
90is($enc->name,'euc-jp');
91END {
92# unlink($utf,$rnd);
93
94}