1
2BEGIN {
3    unless ('A' eq pack('U', 0x41)) {
4	print "1..0 # Unicode::Collate cannot pack a Unicode code point\n";
5	exit 0;
6    }
7    unless (0x41 == unpack('U', 'A')) {
8	print "1..0 # Unicode::Collate cannot get a Unicode code point\n";
9	exit 0;
10    }
11    if ($ENV{PERL_CORE}) {
12	chdir('t') if -d 't';
13	@INC = $^O eq 'MacOS' ? qw(::lib) : qw(../lib);
14    }
15}
16
17use strict;
18use warnings;
19BEGIN { $| = 1; print "1..70\n"; }
20my $count = 0;
21sub ok ($;$) {
22    my $p = my $r = shift;
23    if (@_) {
24	my $x = shift;
25	$p = !defined $x ? !defined $r : !defined $r ? 0 : $r eq $x;
26    }
27    print $p ? "ok" : "not ok", ' ', ++$count, "\n";
28}
29
30use Unicode::Collate;
31
32ok(1);
33
34#########################
35
36sub _pack_U   { Unicode::Collate::pack_U(@_) }
37sub _unpack_U { Unicode::Collate::unpack_U(@_) }
38
39my $A_acute = _pack_U(0xC1);
40my $a_acute = _pack_U(0xE1);
41my $acute   = _pack_U(0x0301);
42
43my $hiragana = "\x{3042}\x{3044}";
44my $katakana = "\x{30A2}\x{30A4}";
45
46my $Collator = Unicode::Collate->new(
47  normalization => undef,
48);
49
50ok(ref $Collator, "Unicode::Collate");
51
52ok($Collator->version,   Unicode::Collate::Base_Unicode_Version);
53ok($Collator->version(), Unicode::Collate->Base_Unicode_Version);
54ok($Collator->version,          $Collator->Base_Unicode_Version);
55ok($Collator->version(),        $Collator->Base_Unicode_Version());
56
57# 6
58
59ok($Collator->cmp("", ""), 0);
60ok($Collator->eq("", ""));
61ok($Collator->cmp("", "perl"), -1);
62
63ok(
64  join(':', $Collator->sort( qw/ acha aca ada acia acka / ) ),
65  join(':',                  qw/ aca acha acia acka ada / ),
66);
67
68ok(
69  join(':', $Collator->sort( qw/ ACHA ACA ADA ACIA ACKA / ) ),
70  join(':',                  qw/ ACA ACHA ACIA ACKA ADA / ),
71);
72
73# 11
74
75ok($Collator->cmp("A$acute", $A_acute), 0); # @version 3.1.1 (prev: -1)
76ok($Collator->cmp($a_acute, $A_acute), -1);
77ok($Collator->eq("A\cA$acute", $A_acute)); # UCA v9. \cA is invariant.
78
79my %old_level = $Collator->change(level => 1);
80ok($Collator->eq("A$acute", $A_acute));
81ok($Collator->eq("A", $A_acute));
82
83ok($Collator->change(level => 2)->eq($a_acute, $A_acute));
84ok($Collator->lt("A", $A_acute));
85
86ok($Collator->change(%old_level)->lt("A", $A_acute));
87ok($Collator->lt("A", $A_acute));
88ok($Collator->lt("A", $a_acute));
89ok($Collator->lt($a_acute, $A_acute));
90
91# 22
92
93$Collator->change(level => 2);
94
95ok($Collator->{level}, 2);
96
97ok( $Collator->cmp("ABC","abc"), 0);
98ok( $Collator->eq("ABC","abc") );
99ok( $Collator->le("ABC","abc") );
100ok( $Collator->cmp($hiragana, $katakana), 0);
101ok( $Collator->eq($hiragana, $katakana) );
102ok( $Collator->ge($hiragana, $katakana) );
103
104# 29
105
106# hangul
107ok( $Collator->eq("a\x{AC00}b", "a\x{1100}\x{1161}b") );
108ok( $Collator->eq("a\x{AE00}b", "a\x{1100}\x{1173}\x{11AF}b") );
109ok( $Collator->gt("a\x{AE00}b", "a\x{1100}\x{1173}b\x{11AF}") );
110ok( $Collator->lt("a\x{AC00}b", "a\x{AE00}b") );
111ok( $Collator->gt("a\x{D7A3}b", "a\x{C544}b") );
112ok( $Collator->lt("a\x{C544}b", "a\x{30A2}b") ); # hangul < hiragana
113
114# 35
115
116$Collator->change(%old_level, katakana_before_hiragana => 1);
117
118ok($Collator->{level}, 4);
119
120ok( $Collator->cmp("abc", "ABC"), -1);
121ok( $Collator->ne("abc", "ABC") );
122ok( $Collator->lt("abc", "ABC") );
123ok( $Collator->le("abc", "ABC") );
124ok( $Collator->cmp($hiragana, $katakana), 1);
125ok( $Collator->ne($hiragana, $katakana) );
126ok( $Collator->gt($hiragana, $katakana) );
127ok( $Collator->ge($hiragana, $katakana) );
128
129# 44
130
131$Collator->change(upper_before_lower => 1);
132
133ok( $Collator->cmp("abc", "ABC"), 1);
134ok( $Collator->ge("abc", "ABC"), 1);
135ok( $Collator->gt("abc", "ABC"), 1);
136ok( $Collator->cmp($hiragana, $katakana), 1);
137ok( $Collator->ge($hiragana, $katakana), 1);
138ok( $Collator->gt($hiragana, $katakana), 1);
139
140# 50
141
142$Collator->change(katakana_before_hiragana => 0);
143
144ok( $Collator->cmp("abc", "ABC"), 1);
145ok( $Collator->cmp($hiragana, $katakana), -1);
146
147# 52
148
149$Collator->change(upper_before_lower => 0);
150
151ok( $Collator->cmp("abc", "ABC"), -1);
152ok( $Collator->le("abc", "ABC") );
153ok( $Collator->cmp($hiragana, $katakana), -1);
154ok( $Collator->lt($hiragana, $katakana) );
155
156# 56
157
158$Collator->change(level => 1);
159
160my $Tailored = Unicode::Collate->new(
161  normalization => undef,
162  suppress => [0x400..0x4FF],
163  level => 1,
164  entry => '0000 ; [.FFFE.0020.0005.0000]',
165);
166
167# Ka vs Kje
168ok($Collator->gt("\x{45C}", "\x{43A}"));
169ok($Collator->gt("\x{40C}", "\x{41A}"));
170ok($Tailored->gt("\x{45C}", "\x{43A}"));
171ok($Tailored->gt("\x{40C}", "\x{41A}"));
172
173# 60
174
175ok($Collator->eq("abc\0", "abc"));
176ok($Tailored->gt("abc\0", "abc\x{4E00}"));
177ok($Tailored->gt("abc\0", "abc\x{FFFD}"));
178ok($Tailored->gt("abc\0", "abc\x{FFFD}"));
179
180# 64
181
182$Tailored->change(UCA_Version => 9);
183
184ok($Tailored->gt("abc\0", "abc\x{4E00}"));
185ok($Tailored->gt("abc\0", "abc\x{FFFD}"));
186ok($Tailored->gt("abc\0", "abc\x{FFFD}"));
187
188# 67
189
190$Tailored->change(UCA_Version => 8);
191
192ok($Tailored->gt("abc\0", "abc\x{4E00}"));
193ok($Tailored->gt("abc\0", "abc\x{FFFD}"));
194ok($Tailored->gt("abc\0", "abc\x{FFFD}"));
195
196# 70
197