Commit | Line | Data |
5d030b67 |
1 | #!../perl |
2 | |
67d7b5ef |
3 | BEGIN { |
037b88d6 |
4 | if ($ENV{'PERL_CORE'}){ |
d1256cb1 |
5 | chdir 't'; |
6 | unshift @INC, '../lib'; |
037b88d6 |
7 | } |
67d7b5ef |
8 | require Config; import Config; |
9 | if ($Config{'extensions'} !~ /\bEncode\b/) { |
d1256cb1 |
10 | print "1..0 # Skip: Encode was not built\n"; |
11 | exit 0; |
67d7b5ef |
12 | } |
13 | } |
14 | |
5d030b67 |
15 | use strict; |
5129552c |
16 | use Encode; |
17 | use Encode::Alias; |
a63c962f |
18 | my %a2c; |
19 | my $ON_EBCDIC; |
5d030b67 |
20 | |
a999c27c |
21 | sub init_a2c{ |
a63c962f |
22 | %a2c = ( |
d1256cb1 |
23 | 'US-ascii' => 'ascii', |
24 | 'ISO-646-US' => 'ascii', |
25 | 'UTF-8' => 'utf-8-strict', |
26 | 'UCS-2' => 'UCS-2BE', |
27 | 'UCS2' => 'UCS-2BE', |
28 | 'iso-10646-1' => 'UCS-2BE', |
29 | 'ucs2-le' => 'UCS-2LE', |
30 | 'ucs2-be' => 'UCS-2BE', |
31 | 'utf16' => 'UTF-16', |
32 | 'utf32' => 'UTF-32', |
33 | 'utf16-be' => 'UTF-16BE', |
34 | 'utf32-be' => 'UTF-32BE', |
35 | 'utf16-le' => 'UTF-16LE', |
36 | 'utf32-le' => 'UTF-32LE', |
37 | 'UCS4-BE' => 'UTF-32BE', |
38 | 'UCS-4-LE' => 'UTF-32LE', |
39 | 'cyrillic' => 'iso-8859-5', |
40 | 'arabic' => 'iso-8859-6', |
41 | 'greek' => 'iso-8859-7', |
42 | 'hebrew' => 'iso-8859-8', |
43 | 'thai' => 'iso-8859-11', |
44 | 'tis620' => 'iso-8859-11', |
51e4e64d |
45 | 'tis-620' => 'iso-8859-11', |
d1256cb1 |
46 | 'WinLatin1' => 'cp1252', |
47 | 'WinLatin2' => 'cp1250', |
48 | 'WinCyrillic' => 'cp1251', |
49 | 'WinGreek' => 'cp1253', |
50 | 'WinTurkish' => 'cp1254', |
51 | 'WinHebrew' => 'cp1255', |
52 | 'WinArabic' => 'cp1256', |
53 | 'WinBaltic' => 'cp1257', |
54 | 'WinVietnamese' => 'cp1258', |
2fd0906e |
55 | 'Macintosh' => 'MacRoman', |
d1256cb1 |
56 | 'koi8r' => 'koi8-r', |
57 | 'koi8u' => 'koi8-u', |
58 | 'ja_JP.euc' => $ON_EBCDIC ? '' : 'euc-jp', |
59 | 'x-euc-jp' => $ON_EBCDIC ? '' : 'euc-jp', |
60 | 'zh_CN.euc' => $ON_EBCDIC ? '' : 'euc-cn', |
61 | 'x-euc-cn' => $ON_EBCDIC ? '' : 'euc-cn', |
62 | 'ko_KR.euc' => $ON_EBCDIC ? '' : 'euc-kr', |
63 | 'x-euc-kr' => $ON_EBCDIC ? '' : 'euc-kr', |
64 | 'ujis' => $ON_EBCDIC ? '' : 'euc-jp', |
65 | 'Shift_JIS' => $ON_EBCDIC ? '' : 'shiftjis', |
66 | 'x-sjis' => $ON_EBCDIC ? '' : 'shiftjis', |
67 | 'jis' => $ON_EBCDIC ? '' : '7bit-jis', |
68 | 'big-5' => $ON_EBCDIC ? '' : 'big5-eten', |
69 | 'zh_TW.Big5' => $ON_EBCDIC ? '' : 'big5-eten', |
70 | 'tca-big5' => $ON_EBCDIC ? '' : 'big5-eten', |
71 | 'big5-hk' => $ON_EBCDIC ? '' : 'big5-hkscs', |
72 | 'hkscs-big5' => $ON_EBCDIC ? '' : 'big5-hkscs', |
73 | 'GB_2312-80' => $ON_EBCDIC ? '' : 'euc-cn', |
74 | 'KS_C_5601-1987' => $ON_EBCDIC ? '' : 'cp949', |
75 | # |
76 | 'gb12345-raw' => $ON_EBCDIC ? '' : 'gb12345-raw', |
77 | 'gb2312-raw' => $ON_EBCDIC ? '' : 'gb2312-raw', |
78 | 'jis0201-raw' => $ON_EBCDIC ? '' : 'jis0201-raw', |
79 | 'jis0208-raw' => $ON_EBCDIC ? '' : 'jis0208-raw', |
80 | 'jis0212-raw' => $ON_EBCDIC ? '' : 'jis0212-raw', |
81 | 'ksc5601-raw' => $ON_EBCDIC ? '' : 'ksc5601-raw', |
82 | ); |
a63c962f |
83 | |
84 | for my $i (1..11,13..16){ |
d1256cb1 |
85 | $a2c{"ISO 8859 $i"} = "iso-8859-$i"; |
a63c962f |
86 | } |
87 | for my $i (1..10){ |
d1256cb1 |
88 | $a2c{"ISO Latin $i"} = "iso-8859-$Encode::Alias::Latin2iso[$i]"; |
a63c962f |
89 | } |
90 | for my $k (keys %Encode::Alias::Winlatin2cp){ |
d1256cb1 |
91 | my $v = $Encode::Alias::Winlatin2cp{$k}; |
92 | $a2c{"Win" . ucfirst($k)} = "cp" . $v; |
93 | $a2c{"IBM-$v"} = $a2c{"MS-$v"} = "cp" . $v; |
94 | $a2c{"cp-" . $v} = "cp" . $v; |
9d2ff094 |
95 | } |
a999c27c |
96 | my @a2c = keys %a2c; |
97 | for my $k (@a2c){ |
d1256cb1 |
98 | $a2c{uc($k)} = $a2c{$k}; |
99 | $a2c{lc($k)} = $a2c{$k}; |
100 | $a2c{lcfirst($k)} = $a2c{$k}; |
101 | $a2c{ucfirst($k)} = $a2c{$k}; |
a999c27c |
102 | } |
103 | } |
104 | |
105 | BEGIN{ |
106 | $ON_EBCDIC = ord("A") == 193; |
107 | @ARGV and $ON_EBCDIC = $ARGV[0] eq 'EBCDIC'; |
108 | $Encode::ON_EBCDIC = $ON_EBCDIC; |
109 | init_a2c(); |
9d2ff094 |
110 | } |
111 | |
a63c962f |
112 | if ($ON_EBCDIC){ |
113 | delete @Encode::ExtModule{ |
d1256cb1 |
114 | qw(euc-cn gb2312 gb12345 gbk cp936 iso-ir-165 MacChineseSimp |
115 | euc-jp iso-2022-jp 7bit-jis shiftjis MacJapanese cp932 |
116 | euc-kr ksc5601 cp949 MacKorean |
117 | big5 big5-hkscs cp950 MacChineseTrad |
118 | gb18030 big5plus euc-tw) |
119 | }; |
5d030b67 |
120 | } |
121 | |
a999c27c |
122 | use Test::More tests => (scalar keys %a2c) * 4; |
5d030b67 |
123 | |
a63c962f |
124 | print "# alias test; \$ON_EBCDIC == $ON_EBCDIC\n"; |
5d030b67 |
125 | |
eaac0a15 |
126 | foreach my $a (keys %a2c){ |
28d8d7f4 |
127 | print "# $a => $a2c{$a}\n"; |
5d030b67 |
128 | my $e = Encode::find_encoding($a); |
eaac0a15 |
129 | is((defined($e) and $e->name), $a2c{$a},$a) |
d1256cb1 |
130 | or warn "alias was $a";; |
5d030b67 |
131 | } |
132 | |
133 | # now we override some of the aliases and see if it works fine |
134 | |
a999c27c |
135 | define_alias( |
d1256cb1 |
136 | qr/ascii/i => 'WinLatin1', |
137 | qr/cyrillic/i => 'WinCyrillic', |
138 | qr/arabic/i => 'WinArabic', |
139 | qr/greek/i => 'WinGreek', |
140 | qr/hebrew/i => 'WinHebrew' |
141 | ); |
5d030b67 |
142 | |
143 | print "# alias test with alias overrides\n"; |
144 | |
eaac0a15 |
145 | foreach my $a (keys %a2c){ |
51e4e64d |
146 | print "# $a => $a2c{$a}\n"; |
5d030b67 |
147 | my $e = Encode::find_encoding($a); |
eaac0a15 |
148 | is((defined($e) and $e->name), $a2c{$a}, "Override $a") |
d1256cb1 |
149 | or warn "alias was $a"; |
5d030b67 |
150 | } |
151 | |
5129552c |
152 | print "# alias undef test\n"; |
153 | |
154 | Encode::Alias->undef_aliases; |
eaac0a15 |
155 | foreach my $a (keys %a2c){ |
5129552c |
156 | my $e = Encode::find_encoding($a); |
eaac0a15 |
157 | ok(!defined($e) || $e->name =~ /-raw$/o,"Undef $a") |
d1256cb1 |
158 | or warn "alias was $a"; |
5129552c |
159 | } |
160 | |
a999c27c |
161 | print "# alias reinit test\n"; |
162 | |
163 | Encode::Alias->init_aliases; |
164 | init_a2c(); |
eaac0a15 |
165 | foreach my $a (keys %a2c){ |
a999c27c |
166 | my $e = Encode::find_encoding($a); |
eaac0a15 |
167 | is((defined($e) and $e->name), $a2c{$a}, "Reinit $a") |
d1256cb1 |
168 | or warn "alias was $a"; |
a999c27c |
169 | } |
5d030b67 |
170 | __END__ |
a999c27c |
171 | for my $k (keys %a2c){ |
172 | $k =~ /[A-Z]/ and next; |
173 | print "$k => $a2c{$k}\n"; |
5d030b67 |
174 | } |
175 | |
176 | |
a999c27c |
177 | |