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