t/op/turkish.t

   1 # Verifies that can implement Turkish casing as defined by Unicode 5.2.
   2
   3 use Config;
   4
   5 BEGIN {
   6     chdir 't';
   7     @INC = '../lib';
   8     require './test.pl';
   9 }
  10
  11 use subs qw(lc lcfirst uc ucfirst);
  12
  13 sub uc($) {
  14     my $string = shift;
  15     utf8::upgrade($string);
  16     return CORE::uc($string);
  17 }
  18
  19 sub ucfirst($) {
  20     my $string = shift;
  21     utf8::upgrade($string);
  22     return CORE::ucfirst($string);
  23 }
  24
  25 sub lc($) {
  26     my $string = shift;
  27     utf8::upgrade($string);
  28
  29     # Unless an I is before a dot_above, it turns into a dotless i.
  30     $string =~ s/I (?! [^\p{ccc=0}\p{ccc=Above}]* \x{0307} )/\x{131}/gx;
  31
  32     # But when the I is followed by a dot_above, remove the dot_above so
  33     # the end result will be i.
  34     $string =~ s/I ([^\p{ccc=0}\p{ccc=Above}]* ) \x{0307}/i$1/gx;
  35     return CORE::lc($string);
  36 }
  37
  38 sub lcfirst($) {
  39     my $string = shift;
  40     utf8::upgrade($string);
  41
  42     # Unless an I is before a dot_above, it turns into a dotless i.
  43     $string =~ s/^I (?! [^\p{ccc=0}\p{ccc=Above}]* \x{0307} )/\x{131}/x;
  44
  45     # But when the I is followed by a dot_above, remove the dot_above so
  46     # the end result will be i.
  47     $string =~ s/^I ([^\p{ccc=0}\p{ccc=Above}]* ) \x{0307}/i$1/x;
  48     return CORE::lcfirst($string);
  49 }
  50
  51 plan tests => 22;
  52
  53 my $map_directory = "../lib/unicore/To";
  54 my $upper = "$map_directory/Upper.pl";
  55 my $lower = "$map_directory/Lower.pl";
  56 my $title = "$map_directory/Title.pl";
  57
  58 sub ToUpper {
  59     my $official = do $upper;
  60     $utf8::ToSpecUpper{'i'} = "\x{0130}";
  61     return $official;
  62 }
  63
  64 sub ToTitle {
  65     my $official = do $title;
  66     $utf8::ToSpecTitle{'i'} = "\x{0130}";
  67     return $official;
  68 }
  69
  70 sub ToLower {
  71     my $official = do $lower;
  72     $utf8::ToSpecLower{"\xc4\xb0"} = "i";
  73     return $official;
  74 }
  75
  76 is(uc("\x{DF}\x{DF}"), "SSSS", "Verify that uc of non-overridden multi-char works");
  77 is(uc("aa"), "AA", "Verify that uc of non-overridden ASCII works");
  78 is(uc("\x{101}\x{101}"), "\x{100}\x{100}", "Verify that uc of non-overridden utf8 works");
  79 is(uc("ii"), "\x{130}\x{130}", "Verify uc('i') eq \\x{130}");
  80
  81 is(ucfirst("\x{DF}\x{DF}"), "Ss\x{DF}", "Verify that ucfirst of non-overridden multi-char works");
  82 is(ucfirst("\x{101}\x{101}"), "\x{100}\x{101}", "Verify that ucfirst of non-overridden utf8 works");
  83 is(ucfirst("aa"), "Aa", "Verify that ucfirst of non-overridden ASCII works");
  84 is(ucfirst("ii"), "\x{130}i", "Verify ucfirst('ii') eq \"\\x{130}i\"");
  85
  86 is(lc("AA"), "aa", "Verify that lc of non-overridden ASCII works");
  87 is(lc("\x{C0}\x{C0}"), "\x{E0}\x{E0}", "Verify that lc of non-overridden latin1 works");
  88 is(lc("\x{0178}\x{0178}"), "\x{FF}\x{FF}", "Verify that lc of non-overridden utf8 works");
  89 is(lc("II"), "\x{131}\x{131}", "Verify that lc('I') eq \\x{131}");
  90 is(lc("IG\x{0307}IG\x{0307}"), "\x{131}g\x{0307}\x{131}g\x{0307}", "Verify that lc(\"I...\\x{0307}\") eq \"\\x{131}...\\x{0307}\"");
  91 is(lc("I\x{0307}I\x{0307}"), "ii", "Verify that lc(\"I\\x{0307}\") removes the \\x{0307}, leaving 'i'");
  92 is(lc("\x{130}\x{130}"), "ii", "Verify that lc(\"\\x{130}\") eq 'i'");
  93
  94 is(lcfirst("AA"), "aA", "Verify that lcfirst of non-overridden ASCII works");
  95 is(lcfirst("\x{C0}\x{C0}"), "\x{E0}\x{C0}", "Verify that lcfirst of non-overridden latin1 works");
  96 is(lcfirst("\x{0178}\x{0178}"), "\x{FF}\x{0178}", "Verify that lcfirst of non-overridden utf8 works");
  97 is(lcfirst("I"), "\x{131}", "Verify that lcfirst('II') eq \"\\x{131}I\"");
  98 is(lcfirst("IG\x{0307}"), "\x{131}G\x{0307}", "Verify that lcfirst(\"I...\\x{0307}\") eq \"\\x{131}...\\x{0307}\"");
  99 is(lcfirst("I\x{0307}I\x{0307}"), "iI\x{0307}", "Verify that lcfirst(\"I\\x{0307}I\\x{0307}\") removes the first \\x{0307}, leaving 'iI\\x{0307}'");
 100 is(lcfirst("\x{130}\x{130}"), "i\x{130}", "Verify that lcfirst(\"\\x{130}\\x{130}\") eq \"i\\x{130}\"");