Commit | Line | Data |
71a18b0f |
1 | BEGIN { |
2 | chdir 't' if -d 't'; |
3 | @INC = '../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 | } |
10 | use Test; |
11 | use Encode qw(encode decode); |
12 | use Encode::Tcl; |
13 | |
14 | my @encodings = qw(euc-cn euc-jp euc-kr big5 shiftjis); # CJK |
15 | my $n = 2; |
16 | |
17 | my %greek = ( |
18 | 'euc-cn' => [0xA6A1..0xA6B8,0xA6C1..0xA6D8], |
19 | 'euc-jp' => [0xA6A1..0xA6B8,0xA6C1..0xA6D8], |
20 | 'euc-kr' => [0xA5C1..0xA5D8,0xA5E1..0xA5F8], |
21 | 'big5' => [0xA344..0xA35B,0xA35C..0xA373], |
22 | 'shiftjis' => [0x839F..0x83B6,0x83BF..0x83D6], |
23 | 'utf8' => [0x0391..0x03A1,0x03A3..0x03A9,0x03B1..0x03C1,0x03C3..0x03C9], |
24 | ); |
25 | my @greek = qw( |
26 | ALPHA BETA GAMMA DELTA EPSILON ZETA ETA |
27 | THETA IOTA KAPPA LAMBDA MU NU XI OMICRON |
28 | PI RHO SIGMA TAU UPSILON PHI CHI PSI OMEGA |
29 | alpha beta gamma delta epsilon zeta eta |
30 | theta iota kappa lambda mu nu xi omicron |
31 | pi rho sigma tau upsilon phi chi psi omega |
32 | ); |
33 | |
34 | my %ideodigit = ( # cjk ideograph 'one' to 'ten' |
35 | 'euc-cn' => [qw(d2bb b6fe c8fd cbc4 cee5 c1f9 c6df b0cb bec5 caae)], |
36 | 'euc-jp' => [qw(b0ec c6f3 bbb0 bbcd b8de cfbb bcb7 c8ac b6e5 bdbd)], |
37 | 'euc-kr' => [qw(ece9 eca3 dfb2 decc e7e9 d7bf f6d2 f8a2 cefa e4a8)], |
38 | 'big5' => [qw(a440 a447 a454 a57c a4ad a4bb a443 a44b a445 a451)], |
39 | 'shiftjis' => [qw(88ea 93f1 8e4f 8e6c 8cdc 985a 8eb5 94aa 8be3 8f5c)], |
40 | 'utf8' => [qw(4e00 4e8c 4e09 56db 4e94 516d 4e03 516b 4e5d 5341)], |
41 | ); |
42 | my @ideodigit = qw(one two three four five six seven eight nine ten); |
43 | |
33f2f539 |
44 | my $jis = '7bit-jis'; |
45 | my $kr = '7bit-kr'; |
46 | my %esc_str; |
47 | |
48 | $esc_str{$jis} = {qw( |
49 | 1b24422422242424262428242a1b2842 |
50 | 3042304430463048304a |
51 | 1b284931323334355d1b2842 |
52 | ff71ff72ff73ff74ff75ff9d |
53 | 1b2442467c4b5c1b2842 |
54 | 65e5672c |
55 | 3132331b244234413b7a1b28425065726c |
56 | 0031003200336f225b57005000650072006c |
57 | 546573740a1b24422546253925481b28420a |
58 | 0054006500730074000a30c630b930c8000a |
59 | )}; |
60 | |
61 | $esc_str{$kr} = {qw( |
62 | 1b2429430e2a22213e0f410d0a |
63 | 304200b10041000d000a |
64 | 1b2429430e3021332a34593673383639593b673e46405a0f0d0a |
65 | ac00b098b2e4b77cb9c8bc14c0acc544c790000d000a |
66 | 1b2429434142430d0a |
67 | 004100420043000d000a |
68 | )}; |
69 | |
70 | my $num_esc = $n * keys(%esc_str); |
71 | foreach (values %esc_str){ $num_esc += $n * keys %$_ } |
72 | |
73 | plan test => $n*@encodings + $n*@encodings*@greek |
74 | + $n*@encodings*@ideodigit + $num_esc; |
71a18b0f |
75 | |
76 | foreach my $enc (@encodings) |
77 | { |
78 | my $tab = Encode->getEncoding($enc); |
79 | ok(1,defined($tab),"Could not load $enc"); |
80 | my $str = join('',map(chr($_),0x20..0x7E)); |
81 | my $uni = $tab->decode($str); |
82 | my $cpy = $tab->encode($uni); |
83 | ok($cpy,$str,"$enc mangled translating to Unicode and back"); |
84 | } |
85 | |
86 | foreach my $enc (@encodings) |
87 | { |
88 | my $tab = Encode->getEncoding($enc); |
89 | foreach my $gk (0..$#greek) |
90 | { |
91 | my $uni = unpack 'U', $tab->decode(pack 'n', $greek{$enc}[$gk]); |
92 | ok($uni,$greek{'utf8'}[$gk], |
93 | "$enc mangled translating to Unicode GREEK $greek[$gk]"); |
94 | my $cpy = unpack 'n',$tab->encode(pack 'U',$uni); |
95 | ok($cpy,$greek{$enc}[$gk], |
96 | "$enc mangled translating from Unicode GREEK $greek[$gk]"); |
97 | } |
98 | } |
99 | |
100 | foreach my $enc (@encodings) |
101 | { |
102 | my $tab = Encode->getEncoding($enc); |
103 | foreach my $id (0..$#ideodigit) |
104 | { |
105 | my $uni = unpack 'U',$tab->decode(pack 'H*', $ideodigit{$enc}[$id]); |
106 | ok($uni,hex($ideodigit{'utf8'}[$id]), |
107 | "$enc mangled translating to Unicode CJK IDEOGRAPH $ideodigit[$id]"); |
108 | my $cpy = lc unpack 'H*', $tab->encode(pack 'U',$uni); |
109 | ok($cpy,$ideodigit{$enc}[$id], |
110 | "$enc mangled translating from Unicode CJK IDEOGRAPH $ideodigit[$id]"); |
111 | } |
112 | } |
113 | |
33f2f539 |
114 | { |
115 | sub to_unicode |
116 | { |
117 | my $enc = shift; |
118 | return unpack('H*', pack 'n*', unpack 'U*', |
119 | decode $enc, pack 'H*', join '', @_); |
120 | } |
121 | |
122 | sub from_unicode |
123 | { |
124 | my $enc = shift; |
125 | return unpack('H*', encode $enc, |
126 | pack 'U*', unpack 'n*', pack 'H*', join '', @_); |
127 | } |
128 | |
129 | foreach my $enc (sort keys %esc_str) |
130 | { |
131 | my $tab = Encode->getEncoding($enc); |
132 | ok(1,defined($tab),"Could not load $enc"); |
133 | my %strings = %{ $esc_str{$enc} }; |
134 | foreach my $estr (sort keys %strings) |
135 | { |
136 | my $ustr = to_unicode($enc, $estr); |
137 | ok($ustr, $strings{$estr}, |
138 | "$enc mangled translating to Unicode"); |
139 | ok(from_unicode($enc, $ustr), $estr, |
140 | "$enc mangled translating from Unicode"); |
141 | } |
142 | ok(to_unicode($enc, keys %strings), join('', values %strings), |
143 | "$enc mangled translating to Unicode"); |
144 | } |
145 | } |