Commit | Line | Data |
---|---|---|
00a464f7 | 1 | BEGIN { |
6d1c0808 JH |
2 | if (! -d 'blib' and -d 't'){ chdir 't' }; |
3 | unshift @INC, '../lib'; | |
00a464f7 JH |
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 | } | |
6d1c0808 | 9 | unless (find PerlIO::Layer 'perlio') { |
d1256cb1 RGS |
10 | print "1..0 # Skip: PerlIO was not built\n"; |
11 | exit 0; | |
6d1c0808 | 12 | } |
00a464f7 | 13 | if (ord("A") == 193) { |
d1256cb1 RGS |
14 | print "1..0 # Skip: EBCDIC\n"; |
15 | exit 0; | |
00a464f7 JH |
16 | } |
17 | $| = 1; | |
18 | } | |
19 | ||
20 | use strict; | |
21 | use Test::More tests => 17; | |
22 | use Encode; | |
23 | ||
e99a46ca JH |
24 | no utf8; # we have raw Chinese encodings here |
25 | ||
15f5e486 SH |
26 | BEGIN { |
27 | use_ok('Encode::TW'); | |
28 | } | |
00a464f7 | 29 | |
e99a46ca | 30 | # Since JP.t already tests basic file IO, we will just focus on |
00a464f7 JH |
31 | # internal encode / decode test here. Unfortunately, to test |
32 | # against all the UniHan characters will take a huge disk space, | |
33 | # not to mention the time it will take, and the fact that Perl | |
34 | # did not bundle UniHan.txt anyway. | |
35 | ||
36 | # So, here we just test a typical snippet spanning multiple Unicode | |
37 | # blocks, and hope it can point out obvious errors. | |
38 | ||
39 | run_tests('Basic Big5 range', { | |
40 | 'utf' => ( | |
7237418a RGS |
41 | 24093.39640.38525.20043.33495.35028.20846.65292. |
42 | 26389.30343.32771.26352.20271.24248.65108. | |
43 | 25885.25552.35998.20110.23391.38508.20846.65292. | |
44 | 24799.24218.23493.21566.20197.38477.65108 | |
00a464f7 JH |
45 | ), |
46 | ||
6d1c0808 | 47 | 'big5' => (join('', |
00a464f7 JH |
48 | '«Ò°ª¶§¤§]¸Ç¤¼¡A®Ó¬Ó¦Ò¤ê§B±e¡Q', |
49 | 'Äá´£s¤_©s³µ¤¼¡A±©©°±G§^¥H°¡Q', | |
50 | )), | |
51 | ||
52 | 'big5-hkscs'=> (join('', | |
53 | '«Ò°ª¶§¤§]¸Ç¤¼¡A®Ó¬Ó¦Ò¤ê§B±e¡Q', | |
54 | 'Äá´£s¤_©s³µ¤¼¡A±©©°±G§^¥H°¡Q', | |
55 | )), | |
56 | ||
57 | 'cp950' => (join('', | |
58 | '«Ò°ª¶§¤§]¸Ç¤¼¡A®Ó¬Ó¦Ò¤ê§B±e¡Q', | |
59 | 'Äá´£s¤_©s³µ¤¼¡A±©©°±G§^¥H°¡Q', | |
60 | )), | |
61 | }); | |
62 | ||
63 | run_tests('Hong Kong Extensions', { | |
64 | 'utf' => ( | |
7237418a RGS |
65 | 24863.35613.25152.26377.20351.29992.32.80.101.114.108.32. |
66 | 22021.26379.21451.65292.32102.25105.21707.22021. | |
67 | 25903.25345.12289.24847.35211.21644.40723.21237. | |
68 | 22914.26524.32232.30908.26377.20219.20309.37679.28431. | |
69 | 65292.35531.21578.35380.25105.21707.12290 | |
00a464f7 JH |
70 | ), |
71 | ||
6d1c0808 JH |
72 | 'big5-hkscs' => join('', |
73 | '·PÁ©Ҧ³¨Ï¥Î Perl \9dïªB¤Í¡Aµ¹§Ú\92]\9dï¤ä«ù¡B·N¨£©M¹ªÀy', | |
00a464f7 JH |
74 | '¦pªG½s½X¦³¥ô¦ó¿ùº|¡A½Ð§i¶D§Ú\92]¡C' |
75 | ), | |
76 | }); | |
77 | ||
78 | sub run_tests { | |
79 | my ($title, $tests) = @_; | |
80 | my $utf = delete $tests->{'utf'}; | |
81 | ||
82 | # $enc = encoding, $str = content | |
83 | foreach my $enc (sort keys %{$tests}) { | |
d1256cb1 | 84 | my $str = $tests->{$enc}; |
00a464f7 | 85 | |
d1256cb1 RGS |
86 | is(Encode::decode($enc, $str), $utf, "[$enc] decode - $title"); |
87 | is(Encode::encode($enc, $utf), $str, "[$enc] encode - $title"); | |
00a464f7 | 88 | |
d1256cb1 RGS |
89 | my $str2 = $str; |
90 | my $utf8 = Encode::encode('utf-8', $utf); | |
00a464f7 | 91 | |
d1256cb1 RGS |
92 | Encode::from_to($str2, $enc, 'utf-8'); |
93 | is($str2, $utf8, "[$enc] from_to => utf8 - $title"); | |
00a464f7 | 94 | |
d1256cb1 RGS |
95 | Encode::from_to($utf8, 'utf-8', $enc); # convert $utf8 as $enc |
96 | is($utf8, $str, "[$enc] utf8 => from_to - $title"); | |
00a464f7 JH |
97 | } |
98 | } |