cpan/Unicode-Collate/t/nonchar.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 use strict;
  16 use warnings;
  17
  18 BEGIN {
  19     use Unicode::Collate;
  20
  21     unless (exists &Unicode::Collate::bootstrap or 5.008 <= $]) {
  22         print "1..0 # skipped: XSUB, or Perl 5.8.0 or later".
  23                 " needed for this test\n";
  24         print $@;
  25         exit;
  26     }
  27 }
  28
  29 BEGIN { plan tests => 61 }; # 1 + 30 * 2
  30
  31 ok(1);
  32
  33 #########################
  34
  35 no warnings 'utf8';
  36
  37 # Unicode 6.0 Sorting
  38 #
  39 # Special Database Values. The data files for CLDR provide
  40 # special weights for two noncharacters:
  41 #
  42 # 1. A special noncharacter <HIGH> (U+FFFF) for specification of a range
  43 #    in a database, allowing "Sch" <= X <= "Sch<HIGH>" to pick all strings
  44 #    starting with "sch" plus those that sort equivalently.
  45 # 2. A special noncharacter <LOW> (U+FFFE) for merged database fields,
  46 #    allowing "Disi\x{301}lva<LOW>John" to sort next to "Disilva<LOW>John".
  47
  48 my $entry = <<'ENTRIES';
  49 FFFE  ; [*0001.0020.0005.FFFE] # <noncharacter-FFFE>
  50 FFFF  ; [.FFFE.0020.0005.FFFF] # <noncharacter-FFFF>
  51 ENTRIES
  52
  53 my @disilva = ("di Silva", "diSilva", "di Si\x{301}lva", "diSi\x{301}lva");
  54 my @dsf = map "$_\x{FFFE}Fred", @disilva;
  55 my @dsj = map "$_\x{FFFE}John", @disilva;
  56 my @dsJ = map        "$_ John", @disilva;
  57
  58 for my $norm (undef, 'NFD') {
  59     if (defined $norm) {
  60         eval { require Unicode::Normalize };
  61         if ($@) {
  62             ok(1) for 1..30; # silent skip
  63             next;
  64         }
  65     }
  66
  67     my $coll = Unicode::Collate->new(
  68         table => 'keys.txt',
  69         level => 1,
  70         normalization => $norm,
  71         UCA_Version => 22,
  72         entry => $entry,
  73     );
  74
  75     # 1..4
  76     ok($coll->lt("\x{FFFD}",   "\x{FFFF}"));
  77     ok($coll->lt("\x{1FFFD}",  "\x{1FFFF}"));
  78     ok($coll->lt("\x{2FFFD}",  "\x{2FFFF}"));
  79     ok($coll->lt("\x{10FFFD}", "\x{10FFFF}"));
  80
  81     # 5..14
  82     ok($coll->lt("perl\x{FFFD}",   "perl\x{FFFF}"));
  83     ok($coll->lt("perl\x{1FFFD}",  "perl\x{FFFF}"));
  84     ok($coll->lt("perl\x{1FFFE}",  "perl\x{FFFF}"));
  85     ok($coll->lt("perl\x{1FFFF}",  "perl\x{FFFF}"));
  86     ok($coll->lt("perl\x{2FFFD}",  "perl\x{FFFF}"));
  87     ok($coll->lt("perl\x{2FFFE}",  "perl\x{FFFF}"));
  88     ok($coll->lt("perl\x{2FFFF}",  "perl\x{FFFF}"));
  89     ok($coll->lt("perl\x{10FFFD}", "perl\x{FFFF}"));
  90     ok($coll->lt("perl\x{10FFFE}", "perl\x{FFFF}"));
  91     ok($coll->lt("perl\x{10FFFF}", "perl\x{FFFF}"));
  92
  93     # 15..16
  94     ok($coll->gt("perl\x{FFFF}AB", "perl\x{FFFF}"));
  95     ok($coll->lt("perl\x{FFFF}\x{10FFFF}", "perl\x{FFFF}\x{FFFF}"));
  96
  97     $coll->change(level => 4);
  98
  99     # 17..25
 100     for my $i (0 .. $#disilva - 1) {
 101         ok($coll->lt($dsf[$i], $dsf[$i+1]));
 102         ok($coll->lt($dsj[$i], $dsj[$i+1]));
 103         ok($coll->lt($dsJ[$i], $dsJ[$i+1]));
 104     }
 105
 106     # 26
 107     ok($coll->lt($dsf[-1], $dsj[0]));
 108
 109     # 27..30
 110     for my $i (0 .. $#disilva) {
 111         ok($coll->lt($dsj[$i], $dsJ[$i]));
 112     }
 113 }
 114