Move Unicode::Collate from ext/ to dist/
[perl.git] / cpan / Unicode-Collate / t / altern.t
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     }
8     if ($ENV{PERL_CORE}) {
9         chdir('t') if -d 't';
10         @INC = $^O eq 'MacOS' ? qw(::lib) : qw(../lib);
11     }
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 %origAlt = $Collator->change(alternate => '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(alternate => '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(alternate => '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(alternate => '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(%origAlt);
69
70 ok($Collator->{alternate}, 'shifted');
71
72 ##############
73
74 # ignorable after alternate
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(alternate => '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(alternate => '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(alternate => 'Shifted', level => 4);
105