This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Document tricks, work-arounds for user-defined casing
[perl5.git] / 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}\"");