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..36\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# 2..12 35{ 36 my $backLevel1 = Unicode::Collate->new( 37 table => "keys.txt", 38 normalization => undef, 39 backwards => [ 1 ], 40 ); 41 42 ok($backLevel1->gt("a\x{300}a", "aa\x{300}")); 43 ok($backLevel1->lt("Ca\x{300}ca\x{302}", "ca\x{302}ca\x{300}")); 44 ok($backLevel1->lt("ca\x{300}ca\x{302}", "Ca\x{302}ca\x{300}")); 45 46 # all strings are reversed at level 1. 47 ok($backLevel1->gt("AB", "BA")); 48 ok($backLevel1->gt("\x{3042}\x{3044}", "\x{3044}\x{3042}")); 49 50 $backLevel1->change(backwards => []); 51 ok($backLevel1->lt("AB", "BA")); 52 ok($backLevel1->lt("\x{3042}\x{3044}", "\x{3044}\x{3042}")); 53 54 $backLevel1->change(backwards => 1); 55 ok($backLevel1->gt("AB", "BA")); 56 ok($backLevel1->gt("\x{3042}\x{3044}", "\x{3044}\x{3042}")); 57 58 $backLevel1->change(backwards => undef); 59 ok($backLevel1->lt("AB", "BA")); 60 ok($backLevel1->lt("\x{3042}\x{3044}", "\x{3044}\x{3042}")); 61} 62 63# 13..26 64{ 65 my $backLevel2 = Unicode::Collate->new( 66 table => "keys.txt", 67 normalization => undef, 68 backwards => 2, 69 ); 70 71 ok($backLevel2->lt("AB", "BA")); 72 ok($backLevel2->lt("\x{3042}\x{3044}", "\x{3044}\x{3042}")); 73 74 # all strings are reversed at level 2. 75 ok($backLevel2->lt("a\x{300}a", "aa\x{300}")); 76 ok($backLevel2->gt("Ca\x{300}ca\x{302}", "ca\x{302}ca\x{300}")); 77 ok($backLevel2->gt("ca\x{300}ca\x{302}", "Ca\x{302}ca\x{300}")); 78 79 $backLevel2->change(backwards => undef); 80 ok($backLevel2->gt("a\x{300}a", "aa\x{300}")); 81 ok($backLevel2->lt("Ca\x{300}ca\x{302}", "ca\x{302}ca\x{300}")); 82 ok($backLevel2->lt("ca\x{300}ca\x{302}", "Ca\x{302}ca\x{300}")); 83 84 $backLevel2->change(backwards => [2]); 85 ok($backLevel2->lt("a\x{300}a", "aa\x{300}")); 86 ok($backLevel2->gt("Ca\x{300}ca\x{302}", "ca\x{302}ca\x{300}")); 87 ok($backLevel2->gt("ca\x{300}ca\x{302}", "Ca\x{302}ca\x{300}")); 88 89 $backLevel2->change(backwards => []); 90 ok($backLevel2->gt("a\x{300}a", "aa\x{300}")); 91 ok($backLevel2->lt("Ca\x{300}ca\x{302}", "ca\x{302}ca\x{300}")); 92 ok($backLevel2->lt("ca\x{300}ca\x{302}", "Ca\x{302}ca\x{300}")); 93} 94 95# 27..31 96{ 97 my $undef = Unicode::Collate->new( 98 table => "keys.txt", 99 normalization => undef, 100 backwards => undef, 101 ); 102 103 ok($undef->lt("AB", "BA")); 104 ok($undef->lt("\x{3042}\x{3044}", "\x{3044}\x{3042}")); 105 106 ok($undef->gt("a\x{300}a", "aa\x{300}")); 107 ok($undef->lt("Ca\x{300}ca\x{302}", "ca\x{302}ca\x{300}")); 108 ok($undef->lt("ca\x{300}ca\x{302}", "Ca\x{302}ca\x{300}")); 109} 110 111# 32..36 112{ 113 my $empty = Unicode::Collate->new( 114 table => "keys.txt", 115 normalization => undef, 116 backwards => [ ], 117 ); 118 119 ok($empty->lt("AB", "BA")); 120 ok($empty->lt("\x{3042}\x{3044}", "\x{3044}\x{3042}")); 121 122 ok($empty->gt("a\x{300}a", "aa\x{300}")); 123 ok($empty->lt("Ca\x{300}ca\x{302}", "ca\x{302}ca\x{300}")); 124 ok($empty->lt("ca\x{300}ca\x{302}", "Ca\x{302}ca\x{300}")); 125} 126 127