ext/Unicode-Collate/t/contract.t

   1 BEGIN {
   2     unless ("A" eq pack('U', 0x41)) {
   3         print "1..0 # Unicode::Collate " .
   4             "cannot stringify a Unicode code point\n";
   5         exit 0;
   6     }
   7     if ($ENV{PERL_CORE}) {
   8         chdir('t') if -d 't';
   9         @INC = $^O eq 'MacOS' ? qw(::lib) : qw(../lib);
  10     }
  11 }
  12
  13 use Test;
  14 BEGIN { plan tests => 40 };
  15
  16 use strict;
  17 use warnings;
  18 use Unicode::Collate;
  19
  20 our $kjeEntry = <<'ENTRIES';
  21 0301  ; [.0000.0032.0002.0301] # COMBINING ACUTE ACCENT
  22 0334  ; [.0000.008B.0002.0334] # COMBINING TILDE OVERLAY
  23 043A  ; [.0D31.0020.0002.043A] # CYRILLIC SMALL LETTER KA
  24 041A  ; [.0D31.0020.0008.041A] # CYRILLIC CAPITAL LETTER KA
  25 045C  ; [.0DA1.0020.0002.045C] # CYRILLIC SMALL LETTER KJE
  26 043A 0301 ; [.0DA1.0020.0002.045C] # CYRILLIC SMALL LETTER KJE
  27 040C  ; [.0DA1.0020.0008.040C] # CYRILLIC CAPITAL LETTER KJE
  28 041A 0301 ; [.0DA1.0020.0008.040C] # CYRILLIC CAPITAL LETTER KJE
  29 ENTRIES
  30
  31 our $aaEntry = <<'ENTRIES';
  32 0304  ; [.0000.005A.0002.0304] # COMBINING MACRON (cc = 230)
  33 030A  ; [.0000.0043.0002.030A] # COMBINING RING ABOVE (cc = 230)
  34 0327  ; [.0000.0055.0002.0327] # COMBINING CEDILLA (cc = 202)
  35 031A  ; [.0000.006B.0002.031A] # COMBINING LEFT ANGLE ABOVE (cc = 232)
  36 0061  ; [.0A15.0020.0002.0061] # LATIN SMALL LETTER A
  37 0041  ; [.0A15.0020.0008.0041] # LATIN CAPITAL LETTER A
  38 007A  ; [.0C13.0020.0002.007A] # LATIN SMALL LETTER Z
  39 005A  ; [.0C13.0020.0008.005A] # LATIN CAPITAL LETTER Z
  40 00E5  ; [.0C25.0020.0002.00E5] # LATIN SMALL LETTER A WITH RING ABOVE; QQCM
  41 00C5  ; [.0C25.0020.0008.00C5] # LATIN CAPITAL LETTER A WITH RING ABOVE; QQCM
  42 0061 030A ; [.0C25.0020.0002.0061] # LATIN SMALL LETTER A WITH RING ABOVE
  43 0041 030A ; [.0C25.0020.0008.0041] # LATIN CAPITAL LETTER A WITH RING ABOVE
  44 ENTRIES
  45
  46 #########################
  47
  48 ok(1);
  49
  50 my $kjeNoN = Unicode::Collate->new(
  51     level => 1,
  52     table => undef,
  53     normalization => undef,
  54     entry => $kjeEntry,
  55 );
  56
  57 ok($kjeNoN->lt("\x{043A}", "\x{043A}\x{0301}"));
  58 ok($kjeNoN->gt("\x{045C}", "\x{043A}\x{0334}\x{0301}"));
  59 ok($kjeNoN->eq("\x{043A}", "\x{043A}\x{0334}\x{0301}"));
  60 ok($kjeNoN->eq("\x{045C}", "\x{043A}\x{0301}\x{0334}"));
  61
  62 our %sortkeys;
  63
  64 $sortkeys{'KAac'} = $kjeNoN->viewSortKey("\x{043A}\x{0301}");
  65 $sortkeys{'KAta'} = $kjeNoN->viewSortKey("\x{043A}\x{0334}\x{0301}");
  66 $sortkeys{'KAat'} = $kjeNoN->viewSortKey("\x{043A}\x{0301}\x{0334}");
  67
  68 eval { require Unicode::Normalize };
  69 if (!$@) {
  70     my $kjeNFD = Unicode::Collate->new(
  71         level => 1,
  72         table => undef,
  73         entry => $kjeEntry,
  74     );
  75 ok($kjeNFD->lt("\x{043A}", "\x{043A}\x{0301}"));
  76 ok($kjeNFD->eq("\x{045C}", "\x{043A}\x{0334}\x{0301}"));
  77 ok($kjeNFD->lt("\x{043A}", "\x{043A}\x{0334}\x{0301}"));
  78 ok($kjeNFD->eq("\x{045C}", "\x{043A}\x{0301}\x{0334}"));
  79
  80     my $aaNFD = Unicode::Collate->new(
  81         level => 1,
  82         table => undef,
  83         entry => $aaEntry,
  84     );
  85
  86 ok($aaNFD->lt("Z", "A\x{30A}\x{304}"));
  87 ok($aaNFD->eq("A", "A\x{304}\x{30A}"));
  88 ok($aaNFD->eq(pack('U', 0xE5), "A\x{30A}\x{304}"));
  89 ok($aaNFD->eq("A\x{304}", "A\x{304}\x{30A}"));
  90 ok($aaNFD->lt("Z", "A\x{327}\x{30A}"));
  91 ok($aaNFD->lt("Z", "A\x{30A}\x{327}"));
  92 ok($aaNFD->lt("Z", "A\x{31A}\x{30A}"));
  93 ok($aaNFD->lt("Z", "A\x{30A}\x{31A}"));
  94
  95     my $aaPre = Unicode::Collate->new(
  96         level => 1,
  97         normalization => "prenormalized",
  98         table => undef,
  99         entry => $aaEntry,
 100     );
 101
 102 ok($aaPre->lt("Z", "A\x{30A}\x{304}"));
 103 ok($aaPre->eq("A", "A\x{304}\x{30A}"));
 104 ok($aaPre->eq(pack('U', 0xE5), "A\x{30A}\x{304}"));
 105 ok($aaPre->eq("A\x{304}", "A\x{304}\x{30A}"));
 106 ok($aaPre->lt("Z", "A\x{327}\x{30A}"));
 107 ok($aaPre->lt("Z", "A\x{30A}\x{327}"));
 108 ok($aaPre->lt("Z", "A\x{31A}\x{30A}"));
 109 ok($aaPre->lt("Z", "A\x{30A}\x{31A}"));
 110 }
 111 else {
 112   ok(1) for 1..20;
 113 }
 114
 115 # again: loading Unicode::Normalize should not affect $kjeNoN.
 116 ok($kjeNoN->lt("\x{043A}", "\x{043A}\x{0301}"));
 117 ok($kjeNoN->gt("\x{045C}", "\x{043A}\x{0334}\x{0301}"));
 118 ok($kjeNoN->eq("\x{043A}", "\x{043A}\x{0334}\x{0301}"));
 119 ok($kjeNoN->eq("\x{045C}", "\x{043A}\x{0301}\x{0334}"));
 120
 121 ok($sortkeys{'KAac'}, $kjeNoN->viewSortKey("\x{043A}\x{0301}"));
 122 ok($sortkeys{'KAta'}, $kjeNoN->viewSortKey("\x{043A}\x{0334}\x{0301}"));
 123 ok($sortkeys{'KAat'}, $kjeNoN->viewSortKey("\x{043A}\x{0301}\x{0334}"));
 124
 125 my $aaNoN = Unicode::Collate->new(
 126     level => 1,
 127     table => undef,
 128     entry => $aaEntry,
 129     normalization => undef,
 130 );
 131
 132 ok($aaNoN->lt("Z", "A\x{30A}\x{304}"));
 133 ok($aaNoN->eq("A", "A\x{304}\x{30A}"));
 134 ok($aaNoN->eq(pack('U', 0xE5), "A\x{30A}\x{304}"));
 135 ok($aaNoN->eq("A\x{304}", "A\x{304}\x{30A}"));
 136 ok($aaNoN->eq("A", "A\x{327}\x{30A}"));
 137 ok($aaNoN->lt("Z", "A\x{30A}\x{327}"));
 138 ok($aaNoN->eq("A", "A\x{31A}\x{30A}"));
 139 ok($aaNoN->lt("Z", "A\x{30A}\x{31A}"));
 140