1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
|
BEGIN {
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 qw(no_plan);
use Encode;
use File::Basename;
use File::Spec;
use File::Compare;
require_ok "Encode::JP";
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');
my $dir = dirname(__FILE__);
my @subcodings = qw(jisx0212 jisx0208);
for my $subcoding (@subcodings){
$euc = File::Spec->catfile($dir,"$subcoding.euc");
$utf = File::Spec->catfile($dir,"$$.utf8");
$ref = File::Spec->catfile($dir,"$subcoding.ref");
$rnd = File::Spec->catfile($dir,"$$.rnd");
print "# Basic decode test\n";
open($src,"<",$euc) || 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);
}
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);
is($enc->name,'euc-jp');
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);
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);
}
is($enc->name,'euc-jp');
END {
1 while unlink($utf,$rnd);
}
|
