Commit | Line | Data |
---|---|---|
91ae00cb NC |
1 | |
2 | BEGIN { | |
3 | unless ("A" eq pack('U', 0x41)) { | |
4 | print "1..0 # Unicode::Collate " . | |
5 | "cannot stringify a Unicode code point\n"; | |
6 | exit 0; | |
7 | } | |
456a1446 CBW |
8 | if ($ENV{PERL_CORE}) { |
9 | chdir('t') if -d 't'; | |
10 | @INC = $^O eq 'MacOS' ? qw(::lib) : qw(../lib); | |
11 | } | |
91ae00cb NC |
12 | } |
13 | ||
14 | use Test; | |
15 | BEGIN { plan tests => 37 }; | |
16 | ||
17 | use strict; | |
18 | use warnings; | |
19 | use Unicode::Collate; | |
20 | ||
21 | ok(1); | |
22 | ||
23 | ######################### | |
24 | ||
25 | sub _pack_U { Unicode::Collate::pack_U(@_) } | |
26 | sub _unpack_U { Unicode::Collate::unpack_U(@_) } | |
27 | ||
28 | my $A_acute = _pack_U(0xC1); | |
29 | my $acute = _pack_U(0x0301); | |
30 | ||
31 | my $Collator = Unicode::Collate->new( | |
32 | table => 'keys.txt', | |
33 | normalization => undef, | |
34 | ); | |
35 | ||
36 | my %origVar = $Collator->change(variable => 'Blanked'); | |
37 | ||
38 | ok($Collator->lt("death", "de luge")); | |
39 | ok($Collator->lt("de luge", "de-luge")); | |
40 | ok($Collator->lt("de-luge", "deluge")); | |
41 | ok($Collator->lt("deluge", "de\x{2010}luge")); | |
42 | ok($Collator->lt("deluge", "de Luge")); | |
43 | ||
44 | $Collator->change(variable => 'Non-ignorable'); | |
45 | ||
46 | ok($Collator->lt("de luge", "de Luge")); | |
47 | ok($Collator->lt("de Luge", "de-luge")); | |
48 | ok($Collator->lt("de-Luge", "de\x{2010}luge")); | |
49 | ok($Collator->lt("de-luge", "death")); | |
50 | ok($Collator->lt("death", "deluge")); | |
51 | ||
52 | $Collator->change(variable => 'Shifted'); | |
53 | ||
54 | ok($Collator->lt("death", "de luge")); | |
55 | ok($Collator->lt("de luge", "de-luge")); | |
56 | ok($Collator->lt("de-luge", "deluge")); | |
57 | ok($Collator->lt("deluge", "de Luge")); | |
58 | ok($Collator->lt("de Luge", "deLuge")); | |
59 | ||
60 | $Collator->change(variable => 'Shift-Trimmed'); | |
61 | ||
62 | ok($Collator->lt("death", "deluge")); | |
63 | ok($Collator->lt("deluge", "de luge")); | |
64 | ok($Collator->lt("de luge", "de-luge")); | |
65 | ok($Collator->lt("de-luge", "deLuge")); | |
66 | ok($Collator->lt("deLuge", "de Luge")); | |
67 | ||
68 | $Collator->change(%origVar); | |
69 | ||
70 | ok($Collator->{variable}, 'shifted'); | |
71 | ||
72 | ############## | |
73 | ||
74 | # ignorable after variable | |
75 | ||
76 | # Shifted; | |
77 | ok($Collator->eq("?\x{300}!\x{301}\x{315}", "?!")); | |
78 | ok($Collator->eq("?\x{300}A\x{301}", "?$A_acute")); | |
79 | ok($Collator->eq("?\x{300}", "?")); | |
80 | ok($Collator->eq("?\x{344}", "?")); # U+0344 has two CEs. | |
81 | ||
82 | $Collator->change(level => 3); | |
83 | ok($Collator->eq("\cA", "?")); | |
84 | ||
85 | $Collator->change(variable => 'blanked', level => 4); | |
86 | ok($Collator->eq("?\x{300}!\x{301}\x{315}", "?!")); | |
87 | ok($Collator->eq("?\x{300}A\x{301}", "?$A_acute")); | |
88 | ok($Collator->eq("?\x{300}", "?")); | |
89 | ok($Collator->eq("?\x{344}", "?")); # U+0344 has two CEs. | |
90 | ||
91 | $Collator->change(level => 3); | |
92 | ok($Collator->eq("\cA", "?")); | |
93 | ||
94 | $Collator->change(variable => 'Non-ignorable', level => 4); | |
95 | ||
96 | ok($Collator->lt("?\x{300}", "?!")); | |
97 | ok($Collator->gt("?\x{300}A$acute", "?$A_acute")); | |
98 | ok($Collator->gt("?\x{300}", "?")); | |
99 | ok($Collator->gt("?\x{344}", "?")); | |
100 | ||
101 | $Collator->change(level => 3); | |
102 | ok($Collator->lt("\cA", "?")); | |
103 | ||
104 | $Collator->change(variable => 'Shifted', level => 4); | |
105 |