lib/Unicode/Collate/t/test.t

   1 # Before `make install' is performed this script should be runnable with
   2 # `make test'. After `make install' it should work as `perl test.pl'
   3
   4 #########################
   5
   6 use Test;
   7 BEGIN { plan tests => 22 };
   8 use Unicode::Collate;
   9 ok(1); # If we made it this far, we're ok.
  10
  11 #########################
  12
  13 my $UCA = Unicode::Collate->new(
  14   table => 'keys.txt',
  15   normalization => undef,
  16 );
  17
  18 ok(ref $UCA, "Unicode::Collate");
  19
  20 ok(
  21   join(':', $UCA->sort(
  22     qw/ lib strict Carp ExtUtils CGI Time warnings Math overload Pod CPAN /
  23   ) ),
  24   join(':',
  25     qw/ Carp CGI CPAN ExtUtils lib Math overload Pod strict Time warnings /
  26   ),
  27 );
  28
  29 my $A_acute = pack('U', 0x00C1);
  30 my $acute   = pack('U', 0x0301);
  31
  32 ok($UCA->cmp("A$acute", $A_acute), -1);
  33
  34 ok($UCA->cmp("", ""), 0);
  35 ok($UCA->cmp("", "perl"), -1);
  36
  37 eval "use Unicode::Normalize";
  38
  39 if(!$@){
  40   my $NFD = Unicode::Collate->new(
  41     table => 'keys.txt',
  42   );
  43   ok($NFD->cmp("A$acute", $A_acute), 0);
  44 }
  45 else{
  46   ok(1);
  47 }
  48
  49 my $tr = Unicode::Collate->new(
  50   table => 'keys.txt',
  51   normalization => undef,
  52   ignoreName => qr/^(?:HANGUL|HIRAGANA|KATAKANA|BOPOMOFO)$/,
  53   entry => <<'ENTRIES',
  54 0063 0068 ; [.0893.0020.0002.0063]  # "ch" in traditional Spanish
  55 0043 0068 ; [.0893.0020.0008.0043]  # "Ch" in traditional Spanish
  56 ENTRIES
  57 );
  58
  59 ok(
  60   join(':', $tr->sort(
  61     qw/ acha aca ada acia acka /
  62   ) ),
  63   join(':',
  64     qw/ aca acia acka acha ada /
  65   ),
  66 );
  67
  68 ok(
  69   join(':', $UCA->sort(
  70     qw/ acha aca ada acia acka /
  71   ) ),
  72   join(':',
  73     qw/ aca acha acia acka ada /
  74   ),
  75 );
  76
  77 my $old_level = $UCA->{level};
  78 my $hiragana = "\x{3042}\x{3044}";
  79 my $katakana = "\x{30A2}\x{30A4}";
  80
  81 $UCA->{level} = 2;
  82
  83 ok( $UCA->cmp("ABC","abc"), 0);
  84 ok( $UCA->cmp($hiragana, $katakana), 0);
  85
  86 $UCA->{level} = $old_level;
  87
  88 $UCA->{katakana_before_hiragana} = 1;
  89
  90 ok( $UCA->cmp("abc", "ABC"), -1);
  91 ok( $UCA->cmp($hiragana, $katakana), 1);
  92
  93 $UCA->{upper_before_lower} = 1;
  94
  95 ok( $UCA->cmp("abc", "ABC"), 1);
  96 ok( $UCA->cmp($hiragana, $katakana), 1);
  97
  98 $UCA->{katakana_before_hiragana} = 0;
  99
 100 ok( $UCA->cmp("abc", "ABC"), 1);
 101 ok( $UCA->cmp($hiragana, $katakana), -1);
 102
 103 $UCA->{upper_before_lower} = 0;
 104
 105 ok( $UCA->cmp("abc", "ABC"), -1);
 106 ok( $UCA->cmp($hiragana, $katakana), -1);
 107
 108 my $ign = Unicode::Collate->new(
 109   table => 'keys.txt',
 110   normalization => undef,
 111   ignoreChar => qr/^[ae]$/,
 112 );
 113
 114 ok( $ign->cmp("element","lament"), 0);
 115
 116 $UCA->{level} = 2;
 117
 118 my $orig = "This is a Perl book.";
 119 my $str;
 120 my $sub = "PERL";
 121 my $rep = "camel";
 122 my $ret = "This is a camel book.";
 123
 124 $str = $orig;
 125 if(my @tmp = $UCA->index($str, $sub)){
 126   substr($str, $tmp[0], $tmp[1], $rep);
 127 }
 128
 129 ok($str, $ret);
 130
 131 $UCA->{level} = $old_level;
 132
 133 $str = $orig;
 134 if(my @tmp = $UCA->index($str, $sub)){
 135   substr($str, $tmp[0], $tmp[1], $rep);
 136 }
 137
 138 ok($str, $orig);
 139