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..562\n"; } # 11 + 29 x @Versions 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..11 32 33my $overCJK = Unicode::Collate->new( 34 table => 'keys.txt', 35 normalization => undef, 36 entry => <<'ENTRIES', 374E01 ; [.B1FC.0030.0004.4E00] # Ideograph; B1FC = FFFF - 4E03. 38ENTRIES 39 overrideCJK => sub { 40 my $u = 0xFFFF - $_[0]; # reversed 41 [$u, 0x20, 0x2, $u]; 42 }, 43); 44 45ok($overCJK->gt("B", "A")); # diff. at level 1. 46ok($overCJK->lt("a", "A")); # diff. at level 3. 47ok($overCJK->lt( "\x{4E03}", "\x{4E01}")); # diff. at level 2. 48ok($overCJK->gt( "\x{4E03}B", "\x{4E01}A")); 49ok($overCJK->lt( "\x{4E03}A", "\x{4E01}B")); 50ok($overCJK->gt("B\x{4E03}", "A\x{4E01}")); 51ok($overCJK->lt("A\x{4E03}", "B\x{4E01}")); 52ok($overCJK->lt("A\x{4E03}", "A\x{4E01}")); 53ok($overCJK->lt("A\x{4E03}", "a\x{4E01}")); 54ok($overCJK->lt("a\x{4E03}", "A\x{4E01}")); 55 56##### 57 58# 4E00..9FA5 are CJK UI. 59# 9FA6..9FBB are CJK UI since UCA_Version 14 (Unicode 4.1). 60# 9FBC..9FC3 are CJK UI since UCA_Version 18 (Unicode 5.1). 61# 9FC4..9FCB are CJK UI since UCA_Version 20 (Unicode 5.2). 62# 9FCC is CJK UI since UCA_Version 24 (Unicode 6.1). 63# 9FCD..9FD5 are CJK UI since UCA_Version 32 (Unicode 8.0). 64# 9FD6..9FEA are CJK UI since UCA_Version 36 (Unicode 10.0). 65# 9FEB..9FEF are CJK UI since UCA_Version 38 (Unicode 11.0). 66# 9FF0..9FFC are CJK UI since UCA_Version 43 (Unicode 13.0). 67 68my @Versions = ( 8, 9, 11, 14, 16, 18, 20, 22, 24, 26, 69 28, 30, 32, 34, 36, 38, 40, 41, 43); 70 71for my $v (@Versions) { 72 $overCJK->change(UCA_Version => $v); 73 ok($overCJK->cmp("a\x{3400}", "A\x{4DB5}") == 1); 74 ok($overCJK->cmp("a\x{4DB5}", "A\x{4E00}") == 1); 75 ok($overCJK->cmp("a\x{4E00}", "A\x{9FA5}") == 1); 76 ok($overCJK->cmp("a\x{9FA5}", "A\x{9FA6}") == ($v >= 14 ? 1 : -1)); 77 ok($overCJK->cmp("a\x{9FA6}", "A\x{9FAF}") == ($v >= 14 ? 1 : -1)); 78 ok($overCJK->cmp("a\x{9FAF}", "A\x{9FB0}") == ($v >= 14 ? 1 : -1)); 79 ok($overCJK->cmp("a\x{9FB0}", "A\x{9FBB}") == ($v >= 14 ? 1 : -1)); 80 ok($overCJK->cmp("a\x{9FBB}", "A\x{9FBC}") == ($v >= 18 ? 1 : -1)); 81 ok($overCJK->cmp("a\x{9FBC}", "A\x{9FBF}") == ($v >= 18 ? 1 : -1)); 82 ok($overCJK->cmp("a\x{9FBF}", "A\x{9FC3}") == ($v >= 18 ? 1 : -1)); 83 ok($overCJK->cmp("a\x{9FC3}", "A\x{9FC4}") == ($v >= 20 ? 1 : -1)); 84 ok($overCJK->cmp("a\x{9FC4}", "A\x{9FCA}") == ($v >= 20 ? 1 : -1)); 85 ok($overCJK->cmp("a\x{9FCA}", "A\x{9FCB}") == ($v >= 20 ? 1 : -1)); 86 ok($overCJK->cmp("a\x{9FCB}", "A\x{9FCC}") == ($v >= 24 ? 1 : -1)); 87 ok($overCJK->cmp("a\x{9FCC}", "A\x{9FCD}") == ($v >= 32 ? 1 : -1)); 88 ok($overCJK->cmp("a\x{9FCD}", "A\x{9FCF}") == ($v >= 32 ? 1 : -1)); 89 ok($overCJK->cmp("a\x{9FCF}", "A\x{9FD5}") == ($v >= 32 ? 1 : -1)); 90 ok($overCJK->cmp("a\x{9FD5}", "A\x{9FD6}") == ($v >= 36 ? 1 : -1)); 91 ok($overCJK->cmp("a\x{9FD6}", "A\x{9FDF}") == ($v >= 36 ? 1 : -1)); 92 ok($overCJK->cmp("a\x{9FDF}", "A\x{9FEA}") == ($v >= 36 ? 1 : -1)); 93 ok($overCJK->cmp("a\x{9FEA}", "A\x{9FEB}") == ($v >= 38 ? 1 : -1)); 94 ok($overCJK->cmp("a\x{9FEB}", "A\x{9FEE}") == ($v >= 38 ? 1 : -1)); 95 ok($overCJK->cmp("a\x{9FEE}", "A\x{9FEF}") == ($v >= 38 ? 1 : -1)); 96 ok($overCJK->cmp("a\x{9FEF}", "A\x{9FF0}") == ($v >= 43 ? 1 : -1)); 97 ok($overCJK->cmp("a\x{9FF0}", "A\x{9FFB}") == ($v >= 43 ? 1 : -1)); 98 ok($overCJK->cmp("a\x{9FFB}", "A\x{9FFC}") == ($v >= 43 ? 1 : -1)); 99 ok($overCJK->cmp("a\x{9FFC}", "A\x{9FFD}") == -1); 100 ok($overCJK->cmp("a\x{9FFD}", "A\x{9FFE}") == -1); 101 ok($overCJK->cmp("a\x{9FFE}", "A\x{9FFF}") == -1); 102} 103 104