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