Commit | Line | Data |
---|---|---|
ef175861 JH |
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; | |
5b7ea690 JH |
23 | use Test::More tests => 42; |
24 | #use Test::More tests => 73; | |
ef175861 JH |
25 | #use Test::More qw(no_plan); |
26 | use Encode; | |
27 | use File::Basename; | |
28 | use File::Spec; | |
29 | use File::Compare qw(compare_text); | |
b7a5c9de | 30 | our $DEBUG = shift || 0; |
ef175861 JH |
31 | |
32 | my %Charset = | |
33 | ( | |
34 | 'big5-eten' => [qw(big5-eten cp950 MacChineseTrad)], | |
35 | 'big5-hkscs' => [qw(big5-hkscs)], | |
36 | gb2312 => [qw(euc-cn gb2312-raw cp936 MacChineseSimp)], | |
37 | jisx0201 => [qw(euc-jp shiftjis 7bit-jis jis0201-raw | |
38 | cp932 MacJapanese)], | |
39 | jisx0212 => [qw(euc-jp 7bit-jis iso-2022-jp-1 jis0208-raw)], | |
40 | jisx0208 => [qw(euc-jp shiftjis 7bit-jis cp932 MacJapanese | |
41 | iso-2022-jp iso-2022-jp-1 jis0212-raw)], | |
42 | ksc5601 => [qw(euc-kr iso-2022-kr ksc5601-raw cp949 MacKorean)], | |
43 | ); | |
44 | ||
45 | my $dir = dirname(__FILE__); | |
b7a5c9de | 46 | my $seq = 1; |
ef175861 | 47 | |
cb3fb9b7 | 48 | for my $charset (sort keys %Charset){ |
ef175861 JH |
49 | my ($src, $uni, $dst, $txt); |
50 | ||
51 | my $transcoder = find_encoding($Charset{$charset}[0]) or die; | |
52 | ||
53 | my $src_enc = File::Spec->catfile($dir,"$charset.enc"); | |
54 | my $src_utf = File::Spec->catfile($dir,"$charset.utf"); | |
55 | my $dst_enc = File::Spec->catfile($dir,"$$.enc"); | |
56 | my $dst_utf = File::Spec->catfile($dir,"$$.utf"); | |
57 | ||
58 | ||
59 | open $src, "<$src_enc" or die "$src_enc : $!"; | |
7e19fb92 JH |
60 | # binmode($src); # not needed! |
61 | ||
ef175861 JH |
62 | $txt = join('',<$src>); |
63 | close($src); | |
64 | ||
65 | eval{ $uni = $transcoder->decode($txt, 1) }; | |
66 | $@ and print $@; | |
b7a5c9de JH |
67 | ok(defined($uni), "decode $charset"); $seq++; |
68 | is(length($txt),0, "decode $charset completely"); $seq++; | |
ef175861 JH |
69 | |
70 | open $dst, ">$dst_utf" or die "$dst_utf : $!"; | |
71 | if (PerlIO::Layer->find('perlio')){ | |
72 | binmode($dst, ":utf8"); | |
73 | print $dst $uni; | |
cb3fb9b7 | 74 | }else{ # ugh! |
ef175861 JH |
75 | binmode($dst); |
76 | my $raw = $uni; Encode::_utf8_off($raw); | |
77 | print $dst $raw; | |
78 | } | |
79 | ||
80 | close($dst); | |
b7a5c9de JH |
81 | is(compare_text($dst_utf, $src_utf), 0, "$dst_utf eq $src_utf") |
82 | or ($DEBUG and rename $dst_utf, "$dst_utf.$seq"); | |
83 | $seq++; | |
ef175861 JH |
84 | |
85 | open $src, "<$src_utf" or die "$src_utf : $!"; | |
86 | if (PerlIO::Layer->find('perlio')){ | |
87 | binmode($src, ":utf8"); | |
88 | $uni = join('', <$src>); | |
cb3fb9b7 | 89 | }else{ # ugh! |
ef175861 JH |
90 | binmode($src); |
91 | $uni = join('', <$src>); | |
92 | Encode::_utf8_on($uni); | |
93 | } | |
94 | close $src; | |
95 | ||
5b7ea690 | 96 | my $unisave = $uni; |
ef175861 JH |
97 | eval{ $txt = $transcoder->encode($uni,1) }; |
98 | $@ and print $@; | |
b7a5c9de JH |
99 | ok(defined($txt), "encode $charset"); $seq++; |
100 | is(length($uni), 0, "encode $charset completely"); $seq++; | |
5b7ea690 | 101 | $uni = $unisave; |
ef175861 JH |
102 | |
103 | open $dst,">$dst_enc" or die "$dst_utf : $!"; | |
104 | binmode($dst); | |
105 | print $dst $txt; | |
106 | close($dst); | |
b7a5c9de JH |
107 | is(compare_text($src_enc, $dst_enc), 0 => "$dst_enc eq $src_enc") |
108 | or ($DEBUG and rename $dst_enc, "$dst_enc.$seq"); | |
109 | $seq++; | |
110 | ||
b7a5c9de | 111 | unlink($dst_utf, $dst_enc); |
ef175861 | 112 | } |