1
2BEGIN {
3    if ($ENV{PERL_CORE}) {
4	chdir('t') if -d 't';
5	@INC = $^O eq 'MacOS' ? qw(::lib) : qw(../lib);
6    }
7}
8
9use strict;
10use warnings;
11BEGIN { $| = 1; print "1..58\n"; }
12my $count = 0;
13sub ok ($;$) {
14    my $p = my $r = shift;
15    if (@_) {
16	my $x = shift;
17	$p = !defined $x ? !defined $r : !defined $r ? 0 : $r eq $x;
18    }
19    print $p ? "ok" : "not ok", ' ', ++$count, "\n";
20}
21
22use Unicode::Collate;
23
24ok(1);
25
26sub _pack_U   { Unicode::Collate::pack_U(@_) }
27sub _unpack_U { Unicode::Collate::unpack_U(@_) }
28
29#########################
30
31# a standard collator (3.1.1)
32my $Collator = Unicode::Collate->new(
33  level => 1,
34  table => 'keys.txt',
35  normalization => undef,
36
37  entry => <<'ENTRIES',
38326E  ; [.1831.0020.0006.326E][.188D.0020.0006.326E] # c.h.s. GA
39326F  ; [.1833.0020.0006.326F][.188D.0020.0006.326F] # c.h.s. NA
403270  ; [.1834.0020.0006.3270][.188D.0020.0006.3270] # c.h.s. DA
413271  ; [.1836.0020.0006.3271][.188D.0020.0006.3271] # c.h.s. RA
423272  ; [.1837.0020.0006.3272][.188D.0020.0006.3272] # c.h.s. MA
433273  ; [.1838.0020.0006.3273][.188D.0020.0006.3273] # c.h.s. BA
443274  ; [.183A.0020.0006.3274][.188D.0020.0006.3274] # c.h.s. SA
453275  ; [.183C.0020.0006.3275][.188D.0020.0006.3275] # c.h.s. A
463276  ; [.183D.0020.0006.3276][.188D.0020.0006.3276] # c.h.s. JA
473277  ; [.183F.0020.0006.3277][.188D.0020.0006.3277] # c.h.s. CA
483278  ; [.1840.0020.0006.3278][.188D.0020.0006.3278] # c.h.s. KA
493279  ; [.1841.0020.0006.3279][.188D.0020.0006.3279] # c.h.s. TA
50327A  ; [.1842.0020.0006.327A][.188D.0020.0006.327A] # c.h.s. PA
51327B  ; [.1843.0020.0006.327B][.188D.0020.0006.327B] # c.h.s. HA
52ENTRIES
53);
54
55my $hangul = Unicode::Collate->new(
56  level => 1,
57  table => 'keys.txt',
58  normalization => undef,
59  hangul_terminator => 16,
60
61  entry => <<'ENTRIES',
62326E  ; [.1831.0020.0006.326E][.188D.0020.0006.326E] # c.h.s. GA
63326F  ; [.1833.0020.0006.326F][.188D.0020.0006.326F] # c.h.s. NA
643270  ; [.1834.0020.0006.3270][.188D.0020.0006.3270] # c.h.s. DA
653271  ; [.1836.0020.0006.3271][.188D.0020.0006.3271] # c.h.s. RA
663272  ; [.1837.0020.0006.3272][.188D.0020.0006.3272] # c.h.s. MA
673273  ; [.1838.0020.0006.3273][.188D.0020.0006.3273] # c.h.s. BA
683274  ; [.183A.0020.0006.3274][.188D.0020.0006.3274] # c.h.s. SA
693275  ; [.183C.0020.0006.3275][.188D.0020.0006.3275] # c.h.s. A
703276  ; [.183D.0020.0006.3276][.188D.0020.0006.3276] # c.h.s. JA
713277  ; [.183F.0020.0006.3277][.188D.0020.0006.3277] # c.h.s. CA
723278  ; [.1840.0020.0006.3278][.188D.0020.0006.3278] # c.h.s. KA
733279  ; [.1841.0020.0006.3279][.188D.0020.0006.3279] # c.h.s. TA
74327A  ; [.1842.0020.0006.327A][.188D.0020.0006.327A] # c.h.s. PA
75327B  ; [.1843.0020.0006.327B][.188D.0020.0006.327B] # c.h.s. HA
76ENTRIES
77);
78
79ok(ref $hangul, "Unicode::Collate");
80
81#########################
82
83# LVX vs LVV: /GAA/ vs /GA/.latinA
84ok($Collator->gt("\x{1100}\x{1161}\x{1161}", "\x{1100}\x{1161}A"));
85ok($hangul  ->gt("\x{1100}\x{1161}\x{1161}", "\x{1100}\x{1161}A"));
86
87# LVX vs LVV: /GAA/ vs /GA/.hiraganaA
88ok($Collator->lt("\x{1100}\x{1161}\x{1161}", "\x{1100}\x{1161}\x{3042}"));
89ok($hangul  ->gt("\x{1100}\x{1161}\x{1161}", "\x{1100}\x{1161}\x{3042}"));
90
91# LVX vs LVV: /GAA/ vs /GA/.hanja
92ok($Collator->lt("\x{1100}\x{1161}\x{1161}", "\x{1100}\x{1161}\x{4E00}"));
93ok($hangul  ->gt("\x{1100}\x{1161}\x{1161}", "\x{1100}\x{1161}\x{4E00}"));
94
95# LVL vs LVT: /GA/./G/ vs /GAG/
96ok($Collator->lt("\x{1100}\x{1161}\x{1100}", "\x{1100}\x{1161}\x{11A8}"));
97ok($hangul  ->lt("\x{1100}\x{1161}\x{1100}", "\x{1100}\x{1161}\x{11A8}"));
98
99# LVT vs LVX: /GAG/ vs /GA/.latinA
100ok($Collator->gt("\x{1100}\x{1161}\x{11A8}", "\x{1100}\x{1161}A"));
101ok($hangul  ->gt("\x{1100}\x{1161}\x{11A8}", "\x{1100}\x{1161}A"));
102
103# LVT vs LVX: /GAG/ vs /GA/.hiraganaA
104ok($Collator->lt("\x{1100}\x{1161}\x{11A8}", "\x{1100}\x{1161}\x{3042}"));
105ok($hangul  ->gt("\x{1100}\x{1161}\x{11A8}", "\x{1100}\x{1161}\x{3042}"));
106
107# LVT vs LVX: /GAG/ vs /GA/.hanja
108ok($Collator->lt("\x{1100}\x{1161}\x{11A8}", "\x{1100}\x{1161}\x{4E00}"));
109ok($hangul  ->gt("\x{1100}\x{1161}\x{11A8}", "\x{1100}\x{1161}\x{4E00}"));
110
111# LV vs Syl(LV): /GA/ vs /[GA]/
112ok($Collator->eq("\x{1100}\x{1161}", "\x{AC00}"));
113ok($hangul  ->eq("\x{1100}\x{1161}", "\x{AC00}"));
114
115# LVT vs Syl(LV)T: /GAG/ vs /[GA]G/
116ok($Collator->eq("\x{1100}\x{1161}\x{11A8}", "\x{AC00}\x{11A8}"));
117ok($hangul  ->eq("\x{1100}\x{1161}\x{11A8}", "\x{AC00}\x{11A8}"));
118
119# LVT vs Syl(LVT): /GAG/ vs /[GAG]/
120ok($Collator->eq("\x{1100}\x{1161}\x{11A8}", "\x{AC01}"));
121ok($hangul  ->eq("\x{1100}\x{1161}\x{11A8}", "\x{AC01}"));
122
123# LVTT vs Syl(LVTT): /GAGG/ vs /[GAGG]/
124ok($Collator->eq("\x{1100}\x{1161}\x{11A9}", "\x{AC02}"));
125ok($hangul  ->eq("\x{1100}\x{1161}\x{11A9}", "\x{AC02}"));
126
127# Syl(LVT) vs : /GAG/ vs /[GAG]/
128ok($Collator->eq("\x{1100}\x{1161}\x{11A8}", "\x{AC01}"));
129ok($hangul  ->eq("\x{1100}\x{1161}\x{11A8}", "\x{AC01}"));
130
131#########################
132
133my $hangcirc = Unicode::Collate->new(
134  level => 1,
135  table => 'keys.txt',
136  normalization => undef,
137  hangul_terminator => 16,
138
139  entry => <<'ENTRIES',
140326E  ; [.1831.0020.0006.326E][.188D.0020.0006.326E][.10.0.0.0] # c.h.s. GA
141326F  ; [.1833.0020.0006.326F][.188D.0020.0006.326F][.10.0.0.0] # c.h.s. NA
1423270  ; [.1834.0020.0006.3270][.188D.0020.0006.3270][.10.0.0.0] # c.h.s. DA
1433271  ; [.1836.0020.0006.3271][.188D.0020.0006.3271][.10.0.0.0] # c.h.s. RA
1443272  ; [.1837.0020.0006.3272][.188D.0020.0006.3272][.10.0.0.0] # c.h.s. MA
1453273  ; [.1838.0020.0006.3273][.188D.0020.0006.3273][.10.0.0.0] # c.h.s. BA
1463274  ; [.183A.0020.0006.3274][.188D.0020.0006.3274][.10.0.0.0] # c.h.s. SA
1473275  ; [.183C.0020.0006.3275][.188D.0020.0006.3275][.10.0.0.0] # c.h.s. A
1483276  ; [.183D.0020.0006.3276][.188D.0020.0006.3276][.10.0.0.0] # c.h.s. JA
1493277  ; [.183F.0020.0006.3277][.188D.0020.0006.3277][.10.0.0.0] # c.h.s. CA
1503278  ; [.1840.0020.0006.3278][.188D.0020.0006.3278][.10.0.0.0] # c.h.s. KA
1513279  ; [.1841.0020.0006.3279][.188D.0020.0006.3279][.10.0.0.0] # c.h.s. TA
152327A  ; [.1842.0020.0006.327A][.188D.0020.0006.327A][.10.0.0.0] # c.h.s. PA
153327B  ; [.1843.0020.0006.327B][.188D.0020.0006.327B][.10.0.0.0] # c.h.s. HA
154ENTRIES
155);
156
157# LV vs Circled Syl(LV): /GA/ vs /(GA)/
158ok($Collator->eq("\x{1100}\x{1161}", "\x{326E}"));
159ok($hangul  ->gt("\x{1100}\x{1161}", "\x{326E}"));
160ok($hangcirc->eq("\x{1100}\x{1161}", "\x{326E}"));
161
162# LV vs Circled Syl(LV): followed by latin A
163ok($Collator->eq("\x{1100}\x{1161}A", "\x{326E}A"));
164ok($hangul  ->lt("\x{1100}\x{1161}A", "\x{326E}A"));
165ok($hangcirc->eq("\x{1100}\x{1161}A", "\x{326E}A"));
166
167# LV vs Circled Syl(LV): followed by hiragana A
168ok($Collator->eq("\x{1100}\x{1161}\x{3042}", "\x{326E}\x{3042}"));
169ok($hangul  ->lt("\x{1100}\x{1161}\x{3042}", "\x{326E}\x{3042}"));
170ok($hangcirc->eq("\x{1100}\x{1161}\x{3042}", "\x{326E}\x{3042}"));
171
172# LVT vs LVX: /GAG/ vs /GA/.hanja
173ok($Collator->eq("\x{1100}\x{1161}\x{4E00}", "\x{326E}\x{4E00}"));
174ok($hangul  ->lt("\x{1100}\x{1161}\x{4E00}", "\x{326E}\x{4E00}"));
175ok($hangcirc->eq("\x{1100}\x{1161}\x{4E00}", "\x{326E}\x{4E00}"));
176
177#########################
178
179# checks contraction in LVT:
180# weights of these contractions may be non-sense.
181
182my $hangcont = Unicode::Collate->new(
183  level => 1,
184  table => 'keys.txt',
185  normalization => undef,
186  hangul_terminator => 16,
187
188  entry => <<'ENTRIES',
1891100 1161 ; [.1831.0020.0002.1100][.188D.0020.0002.1161] # KIYEOK+A
1901161 11A8 ; [.188D.0020.0002.1161][.18CF.0020.0002.11A8] # A+KIYEOK
191ENTRIES
192);
193
194# cont<LV> vs Syl(LV): /<GA>/ vs /[GA]/
195ok($Collator->eq("\x{1100}\x{1161}", "\x{AC00}"));
196ok($hangcont->eq("\x{1100}\x{1161}", "\x{AC00}"));
197
198# cont<LV>.T vs Syl(LV).T: /<GA>G/ vs /[GA]G/
199ok($Collator->eq("\x{1100}\x{1161}\x{11A8}", "\x{AC00}\x{11A8}"));
200ok($hangcont->eq("\x{1100}\x{1161}\x{11A8}", "\x{AC00}\x{11A8}"));
201
202# cont<LV>.T vs Syl(LVT): /<GA>G/ vs /[GAG]/
203ok($Collator->eq("\x{1100}\x{1161}\x{11A8}", "\x{AC01}"));
204ok($hangcont->eq("\x{1100}\x{1161}\x{11A8}", "\x{AC01}"));
205
206# L.cont<VT> vs Syl(LV).T: /D<AG>/ vs /[DA]G/
207ok($Collator->eq("\x{1103}\x{1161}\x{11A8}", "\x{B2E4}\x{11A8}"));
208ok($hangcont->eq("\x{1103}\x{1161}\x{11A8}", "\x{B2E4}\x{11A8}"));
209
210# L.cont<VT> vs Syl(LVT): /D<AG>/ vs /[DAG]/
211ok($Collator->eq("\x{1103}\x{1161}\x{11A8}", "\x{B2E5}"));
212ok($hangcont->eq("\x{1103}\x{1161}\x{11A8}", "\x{B2E5}"));
213
214#####
215
216$Collator->change(hangul_terminator => 16);
217
218ok($Collator->gt("\x{1100}\x{1161}\x{11A8}", "\x{1100}\x{1161}\x{4E00}"));
219ok($Collator->gt("\x{1100}\x{1161}", "\x{326E}"));
220ok($Collator->lt("\x{1100}\x{1161}A", "\x{326E}A"));
221ok($Collator->lt("\x{1100}\x{1161}\x{3042}", "\x{326E}\x{3042}"));
222ok($Collator->lt("\x{1100}\x{1161}\x{4E00}", "\x{326E}\x{4E00}"));
223
224$Collator->change(hangul_terminator => 0);
225
226ok($Collator->lt("\x{1100}\x{1161}\x{11A8}", "\x{1100}\x{1161}\x{4E00}"));
227ok($Collator->eq("\x{1100}\x{1161}", "\x{326E}"));
228ok($Collator->eq("\x{1100}\x{1161}A", "\x{326E}A"));
229ok($Collator->eq("\x{1100}\x{1161}\x{3042}", "\x{326E}\x{3042}"));
230ok($Collator->eq("\x{1100}\x{1161}\x{4E00}", "\x{326E}\x{4E00}"));
231
232