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..134\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::Locale;
31
32ok(1);
33
34#########################
35
36our (@listEs, @listEsT, @listFr);
37
38@listEs = qw(
39    cambio camella camello camelo Camer�n
40    chico chile Chile CHILE chocolate
41    cielo curso espacio espanto espa�ol esperanza lama l�quido
42    llama Llama LLAMA llamar luz nos nueve �u ojo
43);
44
45@listEsT = qw(
46    cambio camelo camella camello Camer�n cielo curso
47    chico chile Chile CHILE chocolate
48    espacio espanto espa�ol esperanza lama l�quido luz
49    llama Llama LLAMA llamar nos nueve �u ojo
50);
51
52@listFr = (
53  qw(
54    cadurcien c�cum c�CUM C�CUM C�CUM caennais c�sium cafard
55    coercitif cote c�te C�te cot� Cot� c�t� C�t� coter
56    �l�ve �lev� g�ne g�ne M�CON ma�on
57    p�che P�CHE p�che P�CHE p�ch� P�CH� p�cher p�cher
58    rel�ve relev� r�v�le r�v�l�
59    sur�l�vation s�rement sur�minent s�ret�
60    vice-consul vicennal vice-pr�sident vice-roi vic�simal),
61  "vice versa", "vice-versa",
62);
63
64ok(@listEs,  27);
65ok(@listEsT, 27);
66ok(@listFr,  46);
67
68ok(Unicode::Collate::Locale::_locale('es_MX'), 'es');
69ok(Unicode::Collate::Locale::_locale('en_CA'), 'default');
70
71# 6
72
73my $Collator = Unicode::Collate::Locale->
74    new(normalization => undef);
75ok($Collator->getlocale, 'default');
76
77ok(
78  join(':', $Collator->sort(
79    qw/ lib strict Carp ExtUtils CGI Time warnings Math overload Pod CPAN /
80  ) ),
81  join(':',
82    qw/ Carp CGI CPAN ExtUtils lib Math overload Pod strict Time warnings /
83  ),
84);
85
86ok($Collator->cmp("", ""), 0);
87ok($Collator->eq("", ""));
88ok($Collator->cmp("", "perl"), -1);
89ok($Collator->gt("PERL", "perl"));
90
91# 12
92
93$Collator->change(level => 2);
94
95ok($Collator->eq("PERL", "perl"));
96
97my $objEs  = Unicode::Collate::Locale->new
98    (normalization => undef, locale => 'ES');
99ok($objEs->getlocale, 'es');
100
101my $objEsT = Unicode::Collate::Locale->new
102    (normalization => undef, locale => 'es_ES_traditional');
103ok($objEsT->getlocale, 'es__traditional');
104
105my $objFr  = Unicode::Collate::Locale->new
106    (normalization => undef, locale => 'FR_CA');
107ok($objFr->getlocale, 'fr_CA');
108
109# 16
110
111sub randomize { my %hash; @hash{@_} = (); keys %hash; } # ?!
112
113for (my $i = 0; $i < $#listEs; $i++) {
114    ok($objEs->lt($listEs[$i], $listEs[$i+1]));
115}
116# 42
117
118for (my $i = 0; $i < $#listEsT; $i++) {
119    ok($objEsT->lt($listEsT[$i], $listEsT[$i+1]));
120}
121# 68
122
123for (my $i = 0; $i < $#listFr; $i++) {
124    ok($objFr->lt($listFr[$i], $listFr[$i+1]));
125}
126# 113
127
128our @randEs = randomize(@listEs);
129our @sortEs = $objEs->sort(@randEs);
130ok("@sortEs" eq "@listEs");
131
132our @randEsT = randomize(@listEsT);
133our @sortEsT = $objEsT->sort(@randEsT);
134ok("@sortEsT" eq "@listEsT");
135
136our @randFr = randomize(@listFr);
137our @sortFr = $objFr->sort(@randFr);
138ok("@sortFr" eq "@listFr");
139
140# 116
141
142{
143    my $keyXS = '__useXS'; # see Unicode::Collate internal
144    my $noLoc = Unicode::Collate->new(normalization => undef);
145    my $UseXS = ref($noLoc->{$keyXS});
146    ok(ref($Collator->{$keyXS}), $UseXS);
147    ok(ref($objFr   ->{$keyXS}), $UseXS);
148    ok(ref($objEs   ->{$keyXS}), $UseXS);
149    ok(ref($objEsT  ->{$keyXS}), $UseXS);
150}
151# 120
152
153ok(Unicode::Collate::Locale::_locale('sr'),            'sr');
154ok(Unicode::Collate::Locale::_locale('sr_Cyrl'),       'sr');
155ok(Unicode::Collate::Locale::_locale('sr_Latn'),       'sr_Latn');
156ok(Unicode::Collate::Locale::_locale('sr_LATN'),       'sr_Latn');
157ok(Unicode::Collate::Locale::_locale('sr_latn'),       'sr_Latn');
158ok(Unicode::Collate::Locale::_locale('de'),            'default');
159ok(Unicode::Collate::Locale::_locale('de_phone'),      'de__phonebook');
160ok(Unicode::Collate::Locale::_locale('de__phonebook'), 'de__phonebook');
161ok(Unicode::Collate::Locale::_locale('de-phonebk'),    'de__phonebook');
162ok(Unicode::Collate::Locale::_locale('de--phonebk'),   'de__phonebook');
163
164# 130
165
166my $objEs2  = Unicode::Collate::Locale->new
167    (normalization => undef, locale => 'ES',
168     level => 1,
169     entry => << 'ENTRIES',
1700000      ; [.FFFE.0020.0005.0000]
17100F1      ; [.0010.0020.0002.00F1] # LATIN SMALL LETTER N WITH TILDE
172006E 0303 ; [.0010.0020.0002.00F1] # LATIN SMALL LETTER N WITH TILDE
173ENTRIES
174);
175
176ok($objEs2->lt("abc\x{4E00}", "abc\0"));
177ok($objEs2->lt("abc\x{FFFD}", "abc\0"));
178ok($objEs2->lt("abc\x{FFFD}", "abc\0"));
179ok($objEs2->lt("n\x{303}", "N\x{303}"));
180
181# 134
182
183