lib/Unicode/UCD.t

   1 #!perl -w
   2 BEGIN {
   3     if (ord("A") == 193) {
   4         print "1..0 # Skip: EBCDIC\n";
   5         exit 0;
   6     }
   7     chdir 't' if -d 't';
   8     @INC = '../lib';
   9     @INC = "::lib" if $^O eq 'MacOS'; # module parses @INC itself
  10     require Config; import Config;
  11     if ($Config{'extensions'} !~ /\bStorable\b/) {
  12         print "1..0 # Skip: Storable was not built; Unicode::UCD uses Storable\n";
  13         exit 0;
  14     }
  15 }
  16
  17 use strict;
  18 use Unicode::UCD;
  19 use Test::More;
  20
  21 BEGIN { plan tests => 194 };
  22
  23 use Unicode::UCD 'charinfo';
  24
  25 my $charinfo;
  26
  27 $charinfo = charinfo(0x41);
  28
  29 is($charinfo->{code},           '0041', 'LATIN CAPITAL LETTER A');
  30 is($charinfo->{name},           'LATIN CAPITAL LETTER A');
  31 is($charinfo->{category},       'Lu');
  32 is($charinfo->{combining},      '0');
  33 is($charinfo->{bidi},           'L');
  34 is($charinfo->{decomposition},  '');
  35 is($charinfo->{decimal},        '');
  36 is($charinfo->{digit},          '');
  37 is($charinfo->{numeric},        '');
  38 is($charinfo->{mirrored},       'N');
  39 is($charinfo->{unicode10},      '');
  40 is($charinfo->{comment},        '');
  41 is($charinfo->{upper},          '');
  42 is($charinfo->{lower},          '0061');
  43 is($charinfo->{title},          '');
  44 is($charinfo->{block},          'Basic Latin');
  45 is($charinfo->{script},         'Latin');
  46
  47 $charinfo = charinfo(0x100);
  48
  49 is($charinfo->{code},           '0100', 'LATIN CAPITAL LETTER A WITH MACRON');
  50 is($charinfo->{name},           'LATIN CAPITAL LETTER A WITH MACRON');
  51 is($charinfo->{category},       'Lu');
  52 is($charinfo->{combining},      '0');
  53 is($charinfo->{bidi},           'L');
  54 is($charinfo->{decomposition},  '0041 0304');
  55 is($charinfo->{decimal},        '');
  56 is($charinfo->{digit},          '');
  57 is($charinfo->{numeric},        '');
  58 is($charinfo->{mirrored},       'N');
  59 is($charinfo->{unicode10},      'LATIN CAPITAL LETTER A MACRON');
  60 is($charinfo->{comment},        '');
  61 is($charinfo->{upper},          '');
  62 is($charinfo->{lower},          '0101');
  63 is($charinfo->{title},          '');
  64 is($charinfo->{block},          'Latin Extended-A');
  65 is($charinfo->{script},         'Latin');
  66
  67 # 0x0590 is in the Hebrew block but unused.
  68
  69 $charinfo = charinfo(0x590);
  70
  71 is($charinfo->{code},          undef,   '0x0590 - unused Hebrew');
  72 is($charinfo->{name},          undef);
  73 is($charinfo->{category},      undef);
  74 is($charinfo->{combining},     undef);
  75 is($charinfo->{bidi},          undef);
  76 is($charinfo->{decomposition}, undef);
  77 is($charinfo->{decimal},       undef);
  78 is($charinfo->{digit},         undef);
  79 is($charinfo->{numeric},       undef);
  80 is($charinfo->{mirrored},      undef);
  81 is($charinfo->{unicode10},     undef);
  82 is($charinfo->{comment},       undef);
  83 is($charinfo->{upper},         undef);
  84 is($charinfo->{lower},         undef);
  85 is($charinfo->{title},         undef);
  86 is($charinfo->{block},         undef);
  87 is($charinfo->{script},        undef);
  88
  89 # 0x05d0 is in the Hebrew block and used.
  90
  91 $charinfo = charinfo(0x5d0);
  92
  93 is($charinfo->{code},           '05D0', '05D0 - used Hebrew');
  94 is($charinfo->{name},           'HEBREW LETTER ALEF');
  95 is($charinfo->{category},       'Lo');
  96 is($charinfo->{combining},      '0');
  97 is($charinfo->{bidi},           'R');
  98 is($charinfo->{decomposition},  '');
  99 is($charinfo->{decimal},        '');
 100 is($charinfo->{digit},          '');
 101 is($charinfo->{numeric},        '');
 102 is($charinfo->{mirrored},       'N');
 103 is($charinfo->{unicode10},      '');
 104 is($charinfo->{comment},        '');
 105 is($charinfo->{upper},          '');
 106 is($charinfo->{lower},          '');
 107 is($charinfo->{title},          '');
 108 is($charinfo->{block},          'Hebrew');
 109 is($charinfo->{script},         'Hebrew');
 110
 111 # An open syllable in Hangul.
 112
 113 $charinfo = charinfo(0xAC00);
 114
 115 is($charinfo->{code},           'AC00', 'HANGUL SYLLABLE-AC00');
 116 is($charinfo->{name},           'HANGUL SYLLABLE-AC00');
 117 is($charinfo->{category},       'Lo');
 118 is($charinfo->{combining},      '0');
 119 is($charinfo->{bidi},           'L');
 120 is($charinfo->{decomposition},  undef);
 121 is($charinfo->{decimal},        '');
 122 is($charinfo->{digit},          '');
 123 is($charinfo->{numeric},        '');
 124 is($charinfo->{mirrored},       'N');
 125 is($charinfo->{unicode10},      '');
 126 is($charinfo->{comment},        '');
 127 is($charinfo->{upper},          '');
 128 is($charinfo->{lower},          '');
 129 is($charinfo->{title},          '');
 130 is($charinfo->{block},          'Hangul Syllables');
 131 is($charinfo->{script},         'Hangul');
 132
 133 # A closed syllable in Hangul.
 134
 135 $charinfo = charinfo(0xAE00);
 136
 137 is($charinfo->{code},           'AE00', 'HANGUL SYLLABLE-AE00');
 138 is($charinfo->{name},           'HANGUL SYLLABLE-AE00');
 139 is($charinfo->{category},       'Lo');
 140 is($charinfo->{combining},      '0');
 141 is($charinfo->{bidi},           'L');
 142 is($charinfo->{decomposition},  undef);
 143 is($charinfo->{decimal},        '');
 144 is($charinfo->{digit},          '');
 145 is($charinfo->{numeric},        '');
 146 is($charinfo->{mirrored},       'N');
 147 is($charinfo->{unicode10},      '');
 148 is($charinfo->{comment},        '');
 149 is($charinfo->{upper},          '');
 150 is($charinfo->{lower},          '');
 151 is($charinfo->{title},          '');
 152 is($charinfo->{block},          'Hangul Syllables');
 153 is($charinfo->{script},         'Hangul');
 154
 155 $charinfo = charinfo(0x1D400);
 156
 157 is($charinfo->{code},           '1D400', 'MATHEMATICAL BOLD CAPITAL A');
 158 is($charinfo->{name},           'MATHEMATICAL BOLD CAPITAL A');
 159 is($charinfo->{category},       'Lu');
 160 is($charinfo->{combining},      '0');
 161 is($charinfo->{bidi},           'L');
 162 is($charinfo->{decomposition},  '<font> 0041');
 163 is($charinfo->{decimal},        '');
 164 is($charinfo->{digit},          '');
 165 is($charinfo->{numeric},        '');
 166 is($charinfo->{mirrored},       'N');
 167 is($charinfo->{unicode10},      '');
 168 is($charinfo->{comment},        '');
 169 is($charinfo->{upper},          '');
 170 is($charinfo->{lower},          '');
 171 is($charinfo->{title},          '');
 172 is($charinfo->{block},          'Mathematical Alphanumeric Symbols');
 173 is($charinfo->{script},         'Common');
 174
 175 use Unicode::UCD qw(charblock charscript);
 176
 177 # 0x0590 is in the Hebrew block but unused.
 178
 179 is(charblock(0x590),          'Hebrew', '0x0590 - Hebrew unused charblock');
 180 is(charscript(0x590),         undef,    '0x0590 - Hebrew unused charscript');
 181
 182 $charinfo = charinfo(0xbe);
 183
 184 is($charinfo->{code},           '00BE', 'VULGAR FRACTION THREE QUARTERS');
 185 is($charinfo->{name},           'VULGAR FRACTION THREE QUARTERS');
 186 is($charinfo->{category},       'No');
 187 is($charinfo->{combining},      '0');
 188 is($charinfo->{bidi},           'ON');
 189 is($charinfo->{decomposition},  '<fraction> 0033 2044 0034');
 190 is($charinfo->{decimal},        '');
 191 is($charinfo->{digit},          '');
 192 is($charinfo->{numeric},        '3/4');
 193 is($charinfo->{mirrored},       'N');
 194 is($charinfo->{unicode10},      'FRACTION THREE QUARTERS');
 195 is($charinfo->{comment},        '');
 196 is($charinfo->{upper},          '');
 197 is($charinfo->{lower},          '');
 198 is($charinfo->{title},          '');
 199 is($charinfo->{block},          'Latin-1 Supplement');
 200 is($charinfo->{script},         'Common');
 201
 202 use Unicode::UCD qw(charblocks charscripts);
 203
 204 my $charblocks = charblocks();
 205
 206 ok(exists $charblocks->{Thai}, 'Thai charblock exists');
 207 is($charblocks->{Thai}->[0]->[0], hex('0e00'));
 208 ok(!exists $charblocks->{PigLatin}, 'PigLatin charblock does not exist');
 209
 210 my $charscripts = charscripts();
 211
 212 ok(exists $charscripts->{Armenian}, 'Armenian charscript exists');
 213 is($charscripts->{Armenian}->[0]->[0], hex('0531'));
 214 ok(!exists $charscripts->{PigLatin}, 'PigLatin charscript does not exist');
 215
 216 my $charscript;
 217
 218 $charscript = charscript("12ab");
 219 is($charscript, 'Ethiopic', 'Ethiopic charscript');
 220
 221 $charscript = charscript("0x12ab");
 222 is($charscript, 'Ethiopic');
 223
 224 $charscript = charscript("U+12ab");
 225 is($charscript, 'Ethiopic');
 226
 227 my $ranges;
 228
 229 $ranges = charscript('Ogham');
 230 is($ranges->[1]->[0], hex('1681'), 'Ogham charscript');
 231 is($ranges->[1]->[1], hex('169a'));
 232
 233 use Unicode::UCD qw(charinrange);
 234
 235 $ranges = charscript('Cherokee');
 236 ok(!charinrange($ranges, "139f"), 'Cherokee charscript');
 237 ok( charinrange($ranges, "13a0"));
 238 ok( charinrange($ranges, "13f4"));
 239 ok(!charinrange($ranges, "13f5"));
 240
 241 use Unicode::UCD qw(general_categories);
 242
 243 my $gc = general_categories();
 244
 245 ok(exists $gc->{L}, 'has L');
 246 is($gc->{L}, 'Letter', 'L is Letter');
 247 is($gc->{Lu}, 'UppercaseLetter', 'Lu is UppercaseLetter');
 248
 249 use Unicode::UCD qw(bidi_types);
 250
 251 my $bt = bidi_types();
 252
 253 ok(exists $bt->{L}, 'has L');
 254 is($bt->{L}, 'Left-to-Right', 'L is Left-to-Right');
 255 is($bt->{AL}, 'Right-to-Left Arabic', 'AL is Right-to-Left Arabic');
 256
 257 is(Unicode::UCD::UnicodeVersion, '5.1.0', 'UnicodeVersion');
 258
 259 use Unicode::UCD qw(compexcl);
 260
 261 ok(!compexcl(0x0100), 'compexcl');
 262 ok( compexcl(0x0958));
 263
 264 use Unicode::UCD qw(casefold);
 265
 266 my $casefold;
 267
 268 $casefold = casefold(0x41);
 269
 270 ok($casefold->{code} eq '0041' &&
 271    $casefold->{status} eq 'C'  &&
 272    $casefold->{mapping} eq '0061', 'casefold 0x41');
 273
 274 $casefold = casefold(0xdf);
 275
 276 ok($casefold->{code} eq '00DF' &&
 277    $casefold->{status} eq 'F'  &&
 278    $casefold->{mapping} eq '0073 0073', 'casefold 0xDF');
 279
 280 ok(!casefold(0x20));
 281
 282 use Unicode::UCD qw(casespec);
 283
 284 my $casespec;
 285
 286 ok(!casespec(0x41));
 287
 288 $casespec = casespec(0xdf);
 289
 290 ok($casespec->{code} eq '00DF' &&
 291    $casespec->{lower} eq '00DF'  &&
 292    $casespec->{title} eq '0053 0073'  &&
 293    $casespec->{upper} eq '0053 0053' &&
 294    !defined $casespec->{condition}, 'casespec 0xDF');
 295
 296 $casespec = casespec(0x307);
 297
 298 ok($casespec->{az}->{code} eq '0307' &&
 299    !defined $casespec->{az}->{lower} &&
 300    $casespec->{az}->{title} eq '0307'  &&
 301    $casespec->{az}->{upper} eq '0307' &&
 302    $casespec->{az}->{condition} eq 'az After_I',
 303    'casespec 0x307');
 304
 305 # perl #7305 UnicodeCD::compexcl is weird
 306
 307 for (1) {my $a=compexcl $_}
 308 ok(1, 'compexcl read-only $_: perl #7305');
 309 map {compexcl $_} %{{1=>2}};
 310 ok(1, 'compexcl read-only hash: perl #7305');
 311
 312 is(Unicode::UCD::_getcode('123'),     123, "_getcode(123)");
 313 is(Unicode::UCD::_getcode('0123'),  0x123, "_getcode(0123)");
 314 is(Unicode::UCD::_getcode('0x123'), 0x123, "_getcode(0x123)");
 315 is(Unicode::UCD::_getcode('0X123'), 0x123, "_getcode(0X123)");
 316 is(Unicode::UCD::_getcode('U+123'), 0x123, "_getcode(U+123)");
 317 is(Unicode::UCD::_getcode('u+123'), 0x123, "_getcode(u+123)");
 318 is(Unicode::UCD::_getcode('U+1234'),   0x1234, "_getcode(U+1234)");
 319 is(Unicode::UCD::_getcode('U+12345'), 0x12345, "_getcode(U+12345)");
 320 is(Unicode::UCD::_getcode('123x'),    undef, "_getcode(123x)");
 321 is(Unicode::UCD::_getcode('x123'),    undef, "_getcode(x123)");
 322 is(Unicode::UCD::_getcode('0x123x'),  undef, "_getcode(x123)");
 323 is(Unicode::UCD::_getcode('U+123x'),  undef, "_getcode(x123)");
 324
 325 {
 326     my $r1 = charscript('Latin');
 327     my $n1 = @$r1;
 328     is($n1, 42, "number of ranges in Latin script (Unicode 5.1.0)");
 329     shift @$r1 while @$r1;
 330     my $r2 = charscript('Latin');
 331     is(@$r2, $n1, "modifying results should not mess up internal caches");
 332 }
 333
 334 {
 335         is(charinfo(0xdeadbeef), undef, "[perl #23273] warnings in Unicode::UCD");
 336 }
 337
 338 use Unicode::UCD qw(namedseq);
 339
 340 is(namedseq("KATAKANA LETTER AINU P"), "\x{31F7}\x{309A}", "namedseq");
 341 is(namedseq("KATAKANA LETTER AINU Q"), undef);
 342 is(namedseq(), undef);
 343 is(namedseq(qw(foo bar)), undef);
 344 my @ns = namedseq("KATAKANA LETTER AINU P");
 345 is(scalar @ns, 2);
 346 is($ns[0], 0x31F7);
 347 is($ns[1], 0x309A);
 348 my %ns = namedseq();
 349 is($ns{"KATAKANA LETTER AINU P"}, "\x{31F7}\x{309A}");
 350 @ns = namedseq(42);
 351 is(@ns, 0);
 352