191f110e0Safresh1 291f110e0Safresh1BEGIN { 391f110e0Safresh1 if ($ENV{PERL_CORE}) { 491f110e0Safresh1 chdir('t') if -d 't'; 591f110e0Safresh1 @INC = $^O eq 'MacOS' ? qw(::lib) : qw(../lib); 691f110e0Safresh1 } 791f110e0Safresh1} 891f110e0Safresh1 991f110e0Safresh1use strict; 1091f110e0Safresh1use warnings; 1191f110e0Safresh1BEGIN { $| = 1; print "1..26\n"; } 1291f110e0Safresh1my $count = 0; 1391f110e0Safresh1sub ok ($;$) { 1491f110e0Safresh1 my $p = my $r = shift; 1591f110e0Safresh1 if (@_) { 1691f110e0Safresh1 my $x = shift; 1791f110e0Safresh1 $p = !defined $x ? !defined $r : !defined $r ? 0 : $r eq $x; 1891f110e0Safresh1 } 1991f110e0Safresh1 print $p ? "ok" : "not ok", ' ', ++$count, "\n"; 2091f110e0Safresh1} 2191f110e0Safresh1 2291f110e0Safresh1use Unicode::Collate; 2391f110e0Safresh1 2491f110e0Safresh1ok(1); 2591f110e0Safresh1 26*256a93a4Safresh1sub _pack_U { Unicode::Collate::pack_U(@_) } 27*256a93a4Safresh1sub _unpack_U { Unicode::Collate::unpack_U(@_) } 28*256a93a4Safresh1 2991f110e0Safresh1######################### 3091f110e0Safresh1 3191f110e0Safresh1use Unicode::Collate::CJK::Zhuyin; 3291f110e0Safresh1 3391f110e0Safresh1my $collator = Unicode::Collate->new( 3491f110e0Safresh1 table => undef, 3591f110e0Safresh1 normalization => undef, 3691f110e0Safresh1 overrideCJK => \&Unicode::Collate::CJK::Zhuyin::weightZhuyin 3791f110e0Safresh1); 3891f110e0Safresh1 3991f110e0Safresh1sub hex_sort { 40*256a93a4Safresh1 my @source = map _pack_U(hex $_), split ' ', shift; 4191f110e0Safresh1 my @sorted = $collator->sort(@source); 42*256a93a4Safresh1 return join " ", map sprintf("%04X", _unpack_U($_)), @sorted; 4391f110e0Safresh1} 4491f110e0Safresh1 4591f110e0Safresh1# 1 4691f110e0Safresh1 4791f110e0Safresh1$collator->change(level => 1); 4891f110e0Safresh1 4991f110e0Safresh1ok($collator->lt("\x{516B}", "\x{628A}")); 5091f110e0Safresh1ok($collator->lt("\x{628A}", "\x{5DF4}")); 5191f110e0Safresh1ok($collator->lt("\x{5DF4}", "\x{767D}")); 5291f110e0Safresh1ok($collator->lt("\x{767D}", "\x{5317}")); 5391f110e0Safresh1ok($collator->lt("\x{5317}", "\x{9F3B}")); 5491f110e0Safresh1ok($collator->lt("\x{9F3B}", "\x{4E0D}")); 5591f110e0Safresh1ok($collator->lt("\x{4E0D}", "\x{547D}")); 5691f110e0Safresh1ok($collator->lt("\x{547D}", "\x{6BCD}")); 5791f110e0Safresh1ok($collator->lt("\x{6BCD}", "\x{6253}")); 5891f110e0Safresh1ok($collator->lt("\x{6253}", "\x{7530}")); 5991f110e0Safresh1ok($collator->lt("\x{7530}", "\x{52AA}")); 6091f110e0Safresh1ok($collator->lt("\x{52AA}", "\x{529B}")); 6191f110e0Safresh1ok($collator->lt("\x{529B}", "\x{5375}")); 6291f110e0Safresh1ok($collator->lt("\x{5375}", "\x{5149}")); 6391f110e0Safresh1ok($collator->lt("\x{5149}", "\x{5915}")); 6491f110e0Safresh1ok($collator->lt("\x{5915}", "\x{4E09}")); 6591f110e0Safresh1ok($collator->lt("\x{4E09}", "\x{4E00}")); 6691f110e0Safresh1ok($collator->lt("\x{4E00}", "\x{7528}")); 6791f110e0Safresh1 6891f110e0Safresh1# Ext.B 6991f110e0Safresh1ok($collator->lt("\x{20000}", "\x{20001}")); 7091f110e0Safresh1ok($collator->lt("\x{20001}", "\x{20002}")); 7191f110e0Safresh1ok($collator->lt("\x{20002}", "\x{20003}")); 7291f110e0Safresh1ok($collator->lt("\x{20003}", "\x{20004}")); 7391f110e0Safresh1ok($collator->lt("\x{20004}", "\x{20005}")); 7491f110e0Safresh1 7591f110e0Safresh1# 24 7691f110e0Safresh1 7791f110e0Safresh1ok(hex_sort('4E00 4E8C 4E09 56DB 4E94 516D 4E03 516B 4E5D 5341'), 7891f110e0Safresh1 '516B 516D 4E5D 4E03 5341 56DB 4E09 4E8C 4E00 4E94'); 7991f110e0Safresh1 8091f110e0Safresh1 8191f110e0Safresh1 8291f110e0Safresh1ok(hex_sort('4E0C 4E8D 4F5C 5140 554A 5750 57C3 5EA7 963F 9F3D 9F3E 9F44'), 8391f110e0Safresh1 '9F3E 4E0C 9F3D 9F44 4E8D 4F5C 5750 5EA7 963F 554A 57C3 5140'); 8491f110e0Safresh1 8591f110e0Safresh1# 26 86