Commit | Line | Data |
ef175861 |
1 | BEGIN { |
2 | if ($ENV{'PERL_CORE'}){ |
3 | chdir 't'; |
4 | unshift @INC, '../lib'; |
5 | } |
6 | require Config; import Config; |
7 | if ($Config{'extensions'} !~ /\bEncode\b/) { |
8 | print "1..0 # Skip: Encode was not built\n"; |
9 | exit 0; |
10 | } |
11 | if (ord("A") == 193) { |
12 | print "1..0 # Skip: EBCDIC\n"; |
13 | exit 0; |
14 | } |
15 | # should work w/o PerlIO now! |
16 | # unless (PerlIO::Layer->find('perlio')){ |
17 | # print "1..0 # Skip: PerlIO required\n"; |
18 | # exit 0; |
19 | # } |
20 | $| = 1; |
21 | } |
22 | use strict; |
23 | use Test::More tests => 73; |
24 | #use Test::More qw(no_plan); |
25 | use Encode; |
26 | use File::Basename; |
27 | use File::Spec; |
28 | use File::Compare qw(compare_text); |
29 | our $DEBUG; |
30 | |
31 | my %Charset = |
32 | ( |
33 | 'big5-eten' => [qw(big5-eten cp950 MacChineseTrad)], |
34 | 'big5-hkscs' => [qw(big5-hkscs)], |
35 | gb2312 => [qw(euc-cn gb2312-raw cp936 MacChineseSimp)], |
36 | jisx0201 => [qw(euc-jp shiftjis 7bit-jis jis0201-raw |
37 | cp932 MacJapanese)], |
38 | jisx0212 => [qw(euc-jp 7bit-jis iso-2022-jp-1 jis0208-raw)], |
39 | jisx0208 => [qw(euc-jp shiftjis 7bit-jis cp932 MacJapanese |
40 | iso-2022-jp iso-2022-jp-1 jis0212-raw)], |
41 | ksc5601 => [qw(euc-kr iso-2022-kr ksc5601-raw cp949 MacKorean)], |
42 | ); |
43 | |
44 | my $dir = dirname(__FILE__); |
45 | |
46 | for my $charset (sort keys %Charset){ |
47 | my ($src, $uni, $dst, $txt); |
48 | |
49 | my $transcoder = find_encoding($Charset{$charset}[0]) or die; |
50 | |
51 | my $src_enc = File::Spec->catfile($dir,"$charset.enc"); |
52 | my $src_utf = File::Spec->catfile($dir,"$charset.utf"); |
53 | my $dst_enc = File::Spec->catfile($dir,"$$.enc"); |
54 | my $dst_utf = File::Spec->catfile($dir,"$$.utf"); |
55 | |
56 | |
57 | open $src, "<$src_enc" or die "$src_enc : $!"; |
ef175861 |
58 | $txt = join('',<$src>); |
59 | close($src); |
60 | |
61 | eval{ $uni = $transcoder->decode($txt, 1) }; |
62 | $@ and print $@; |
63 | ok(defined($uni), "decode $charset"); |
64 | is(length($txt),0, "decode $charset completely"); |
65 | |
66 | open $dst, ">$dst_utf" or die "$dst_utf : $!"; |
67 | if (PerlIO::Layer->find('perlio')){ |
68 | binmode($dst, ":utf8"); |
69 | print $dst $uni; |
70 | }else{ # ugh! |
71 | binmode($dst); |
72 | my $raw = $uni; Encode::_utf8_off($raw); |
73 | print $dst $raw; |
74 | } |
75 | |
76 | close($dst); |
77 | is(compare_text($dst_utf, $src_utf), 0, "$dst_utf eq $src_utf"); |
78 | |
79 | open $src, "<$src_utf" or die "$src_utf : $!"; |
80 | if (PerlIO::Layer->find('perlio')){ |
81 | binmode($src, ":utf8"); |
82 | $uni = join('', <$src>); |
83 | }else{ # ugh! |
84 | binmode($src); |
85 | $uni = join('', <$src>); |
86 | Encode::_utf8_on($uni); |
87 | } |
88 | close $src; |
89 | |
90 | eval{ $txt = $transcoder->encode($uni,1) }; |
91 | $@ and print $@; |
92 | ok(defined($txt), "encode $charset"); |
93 | is(length($uni), 0, "encode $charset completely"); |
94 | |
95 | open $dst,">$dst_enc" or die "$dst_utf : $!"; |
96 | binmode($dst); |
97 | print $dst $txt; |
98 | close($dst); |
99 | is(compare_text($src_enc, $dst_enc), 0 => "$dst_enc eq $src_enc"); |
100 | |
101 | for my $canon (@{$Charset{$charset}}){ |
102 | is($uni, decode($canon, encode($canon, $uni)), |
103 | "RT/$charset/$canon"); |
104 | } |
105 | $DEBUG or unlink($dst_utf, $dst_enc); |
106 | } |