1 2BEGIN { 3 if ($ENV{PERL_CORE}) { 4 chdir('t') if -d 't'; 5 @INC = $^O eq 'MacOS' ? qw(::lib) : qw(../lib); 6 } 7} 8 9use strict; 10use warnings; 11BEGIN { $| = 1; print "1..36\n"; } 12my $count = 0; 13sub ok ($;$) { 14 my $p = my $r = shift; 15 if (@_) { 16 my $x = shift; 17 $p = !defined $x ? !defined $r : !defined $r ? 0 : $r eq $x; 18 } 19 print $p ? "ok" : "not ok", ' ', ++$count, "\n"; 20} 21 22use Unicode::Collate; 23 24ok(1); 25 26sub _pack_U { Unicode::Collate::pack_U(@_) } 27sub _unpack_U { Unicode::Collate::unpack_U(@_) } 28 29######################### 30 31# 2..12 32{ 33 my $backLevel1 = Unicode::Collate->new( 34 table => "keys.txt", 35 normalization => undef, 36 backwards => [ 1 ], 37 ); 38 39 ok($backLevel1->gt("a\x{300}a", "aa\x{300}")); 40 ok($backLevel1->lt("Ca\x{300}ca\x{302}", "ca\x{302}ca\x{300}")); 41 ok($backLevel1->lt("ca\x{300}ca\x{302}", "Ca\x{302}ca\x{300}")); 42 43 # all strings are reversed at level 1. 44 ok($backLevel1->gt("AB", "BA")); 45 ok($backLevel1->gt("\x{3042}\x{3044}", "\x{3044}\x{3042}")); 46 47 $backLevel1->change(backwards => []); 48 ok($backLevel1->lt("AB", "BA")); 49 ok($backLevel1->lt("\x{3042}\x{3044}", "\x{3044}\x{3042}")); 50 51 $backLevel1->change(backwards => 1); 52 ok($backLevel1->gt("AB", "BA")); 53 ok($backLevel1->gt("\x{3042}\x{3044}", "\x{3044}\x{3042}")); 54 55 $backLevel1->change(backwards => undef); 56 ok($backLevel1->lt("AB", "BA")); 57 ok($backLevel1->lt("\x{3042}\x{3044}", "\x{3044}\x{3042}")); 58} 59 60# 13..26 61{ 62 my $backLevel2 = Unicode::Collate->new( 63 table => "keys.txt", 64 normalization => undef, 65 backwards => 2, 66 ); 67 68 ok($backLevel2->lt("AB", "BA")); 69 ok($backLevel2->lt("\x{3042}\x{3044}", "\x{3044}\x{3042}")); 70 71 # all strings are reversed at level 2. 72 ok($backLevel2->lt("a\x{300}a", "aa\x{300}")); 73 ok($backLevel2->gt("Ca\x{300}ca\x{302}", "ca\x{302}ca\x{300}")); 74 ok($backLevel2->gt("ca\x{300}ca\x{302}", "Ca\x{302}ca\x{300}")); 75 76 $backLevel2->change(backwards => undef); 77 ok($backLevel2->gt("a\x{300}a", "aa\x{300}")); 78 ok($backLevel2->lt("Ca\x{300}ca\x{302}", "ca\x{302}ca\x{300}")); 79 ok($backLevel2->lt("ca\x{300}ca\x{302}", "Ca\x{302}ca\x{300}")); 80 81 $backLevel2->change(backwards => [2]); 82 ok($backLevel2->lt("a\x{300}a", "aa\x{300}")); 83 ok($backLevel2->gt("Ca\x{300}ca\x{302}", "ca\x{302}ca\x{300}")); 84 ok($backLevel2->gt("ca\x{300}ca\x{302}", "Ca\x{302}ca\x{300}")); 85 86 $backLevel2->change(backwards => []); 87 ok($backLevel2->gt("a\x{300}a", "aa\x{300}")); 88 ok($backLevel2->lt("Ca\x{300}ca\x{302}", "ca\x{302}ca\x{300}")); 89 ok($backLevel2->lt("ca\x{300}ca\x{302}", "Ca\x{302}ca\x{300}")); 90} 91 92# 27..31 93{ 94 my $undef = Unicode::Collate->new( 95 table => "keys.txt", 96 normalization => undef, 97 backwards => undef, 98 ); 99 100 ok($undef->lt("AB", "BA")); 101 ok($undef->lt("\x{3042}\x{3044}", "\x{3044}\x{3042}")); 102 103 ok($undef->gt("a\x{300}a", "aa\x{300}")); 104 ok($undef->lt("Ca\x{300}ca\x{302}", "ca\x{302}ca\x{300}")); 105 ok($undef->lt("ca\x{300}ca\x{302}", "Ca\x{302}ca\x{300}")); 106} 107 108# 32..36 109{ 110 my $empty = Unicode::Collate->new( 111 table => "keys.txt", 112 normalization => undef, 113 backwards => [ ], 114 ); 115 116 ok($empty->lt("AB", "BA")); 117 ok($empty->lt("\x{3042}\x{3044}", "\x{3044}\x{3042}")); 118 119 ok($empty->gt("a\x{300}a", "aa\x{300}")); 120 ok($empty->lt("Ca\x{300}ca\x{302}", "ca\x{302}ca\x{300}")); 121 ok($empty->lt("ca\x{300}ca\x{302}", "Ca\x{302}ca\x{300}")); 122} 123 124