Commit | Line | Data |
71648f9a |
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}\""); |