This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perl5db: add tests for v command
[perl5.git] / t / uni / fold.t
1 use strict;
2 use warnings;
3
4 # re/fold_grind.t has more complex tests, but doesn't test every fold
5 # This file also tests the fc() keyword.
6
7 BEGIN {
8     chdir 't' if -d 't';
9     require './test.pl';
10     set_up_inc('../lib');
11     skip_all_without_unicode_tables();
12     skip_all_if_miniperl("miniperl, no Unicode::Normalize");
13     require Config; import Config;
14     require './charset_tools.pl';
15     require './loc_tools.pl';   # Contains find_utf8_ctype_locale()
16 }
17
18 use feature 'unicode_strings';
19 use Unicode::UCD qw(all_casefolds);
20
21 binmode *STDOUT, ":utf8";
22
23 our $TODO;
24
25
26 plan("no_plan");
27 # Read in the official case folding definitions.
28 my $casefolds = all_casefolds();
29 my @folds;
30 my @CF;
31 my @simple_folds;
32 my %reverse_fold;
33 use Unicode::UCD;
34 use charnames();
35
36 foreach my $decimal_code_point (sort { $a <=> $b } keys %$casefolds) {
37     # We only use simple folds in fc(), since the regex engine uses full case
38     # folding.
39
40     my $name = charnames::viacode($decimal_code_point);
41     my $type = $casefolds->{$decimal_code_point}{'status'};
42     my $code = $casefolds->{$decimal_code_point}{'code'};
43     my $simple = $casefolds->{$decimal_code_point}{'simple'};
44     my $full = $casefolds->{$decimal_code_point}{'full'};
45
46     if ($simple && $simple ne $full) { # If there is a distinction
47         push @simple_folds, [ $code, $simple, $type, $name ];
48     }
49
50     push @CF, [ $code, $full, $type, $name ];
51
52     # Get the inverse fold for single-char mappings.
53     $reverse_fold{pack "W*", hex $simple} = pack "W*", $decimal_code_point if $simple;
54 }
55
56 foreach my $test_ref ( @simple_folds ) {
57     use feature 'fc';
58     my ($code, $mapping, $type, $name) = @$test_ref;
59     my $c = pack("W*", hex $code);
60     utf8::upgrade($c);
61     my $f = pack("W*", map { hex } split " ", $mapping);
62
63     my $against = join "", "qq{", map("\\x{$_}", split " ", $mapping), "}";
64     {
65         isnt(fc($c), $f, "$code - $name - $mapping - $type - Full casefolding, fc(\\x{$code}) ne $against");
66         isnt("\F$c", $f, "$code - $name - $mapping - $type - Full casefolding, qq{\\F\\x{$code}} ne $against");
67     }
68 }
69
70 foreach my $test_ref (@CF) {
71     my ($code, $mapping, $type, $name) = @$test_ref;
72     my $c = pack("W*", hex $code);
73     utf8::upgrade($c);
74     my $f = pack("W*", map { hex } split " ", $mapping);
75     my $f_length = length $f;
76     foreach my $test (
77             qq[":$c:" =~ /:$c:/],
78             qq[":$c:" =~ /:$c:/i],
79             qq[":$c:" =~ /:[_$c]:/], # Place two chars in [] so doesn't get
80                                      # optimized to a non-charclass
81             qq[":$c:" =~ /:[_$c]:/i],
82             qq[":$c:" =~ /:$f:/i],
83             qq[":$f:" =~ /:$c:/i],
84     ) {
85         ok eval $test, "$code - $name - $mapping - $type - $test";
86     }
87
88     {
89         # fc() tests
90         my $against = join "", "qq{", map("\\x{$_}", split " ", $mapping), "}";
91         is(CORE::fc($c), $f,
92             "$code - $name - $mapping - $type - fc(\\x{$code}) eq $against");
93         is("\F$c", $f, "$code - $name - $mapping - $type - qq{\\F\\x{$code}} eq $against");
94
95         # And here we test bytes. For [A-Za-z0-9], the fold is the same as lc under
96         # bytes. For everything else, it's the bytes that formed the original string.
97         if ( $c =~ /[A-Za-z0-9]/ ) {
98             use bytes;
99             is(CORE::fc($c), lc($c), "$code - $name - fc and use bytes, ascii");
100         } else {
101             my $copy = "" . $c;
102             utf8::encode($copy);
103             is($copy, do { use bytes; CORE::fc($c) }, "$code - $name - fc and use bytes");
104         }
105     }
106     # Certain tests weren't convenient to put in the list above since they are
107     # TODO's in multi-character folds.
108     if ($f_length == 1) {
109
110         # The qq loses the utf8ness of ":$f:".  These tests are not about
111         # finding bugs in utf8ness, so make sure it's utf8.
112         my $test = qq[my \$s = ":$f:"; utf8::upgrade(\$s); \$s =~ /:[_$c]:/i];
113         ok eval $test, "$code - $name - $mapping - $type - $test";
114         $test = qq[":$c:" =~ /:[_$f]:/i];
115         ok eval $test, "$code - $name - $mapping - $type - $test";
116     }
117     else {
118
119         # There are two classes of multi-char folds that need more work.  For
120         # example,
121         #   ":ß:" =~ /:[_s]{2}:/i
122         #   ":ss:" =~ /:[_ß]:/i
123         #
124         # Some of the old tests for the second case happened to pass somewhat
125         # coincidentally.  But none would pass if changed to this.
126         #   ":SS:" =~ /:[_ß]:/i
127         #
128         # As the capital SS doesn't get folded.  When those pass, it means
129         # that the code has been changed to take into account folding in the
130         # string, and all should pass, capitalized or not (this wouldn't be
131         # true for [^complemented character classes], for which the fold case
132         # is better, but these aren't used in this .t currently.  So, what is
133         # done is to essentially upper-case the string for this class (but use
134         # the reverse fold not uc(), as that is more correct)
135         my $u;
136         for my $i (0 .. $f_length - 1) {
137             my $cur_char = substr($f, $i, 1);
138             $u .= $reverse_fold{$cur_char} || $cur_char;
139         }
140         my $test;
141
142         # A multi-char fold should not match just one char;
143         # e.g., ":ß:" !~ /:[_s]:/i
144         $test = qq[":$c:" !~ /:[_$f]:/i];
145         ok eval $test, "$code - $name - $mapping - $type - $test";
146
147         TODO: { # e.g., ":ß:" =~ /:[_s]{2}:/i
148             local $TODO = 'Multi-char fold in [character class]';
149
150             $test = qq[":$c:" =~ /:[_$f]{$f_length}:/i];
151             ok eval $test, "$code - $name - $mapping - $type - $test";
152         }
153
154         # e.g., ":SS:" =~ /:[_ß]:/i now pass, so TODO has been removed, but
155         # since they use '$u', they are left out of the main loop
156         $test = qq[ my \$s = ":$u:"; utf8::upgrade(\$s); \$s =~ /:[_$c]:/i];
157         ok eval $test, "$code - $name - $mapping - $type - $test";
158
159         my $bracketed_f = ($f =~ s/(.)/[$1]/gr);
160         $test = qq[":$c:" =~ /:$bracketed_f:/iu];
161         ok eval $test, "$code - $name - $mapping - $type - $test";
162
163         my @f_chars = ($f =~ / (.) (.) (.?) /x);
164         my $every_other_bracketed_f = "[$f_chars[0]]$f_chars[1]";
165         $every_other_bracketed_f .= "[$f_chars[2]]" if $f_chars[2];
166         $test = qq[":$c:" =~ /:$every_other_bracketed_f:/iu];
167         ok eval $test, "$code - $name - $mapping - $type - $test";
168
169         my $other_every_bracketed_f = "$f_chars[0]";
170         $other_every_bracketed_f .= "[$f_chars[1]]";
171         $other_every_bracketed_f .= "$f_chars[2]" if $f_chars[2];
172         $test = qq[":$c:" =~ /:$other_every_bracketed_f:/iu];
173         ok eval $test, "$code - $name - $mapping - $type - $test";
174     }
175 }
176
177 {
178     use utf8;
179     use feature qw(fc);
180     # These three come from the ICU project's test suite, more especifically
181     # http://icu.sourcearchive.com/documentation/4.4~rc1-1/strcase_8cpp-source.html
182
183     my $s = "A\N{U+00df}\N{U+00b5}\N{U+fb03}\N{U+1040C}\N{U+0130}\N{U+0131}";
184     #\N{LATIN CAPITAL LETTER A}\N{LATIN SMALL LETTER SHARP S}\N{MICRO SIGN}\N{LATIN SMALL LIGATURE FFI}\N{DESERET CAPITAL LETTER AY}\N{LATIN CAPITAL LETTER I WITH DOT ABOVE}\N{LATIN SMALL LETTER DOTLESS I}
185
186     my $f = "ass\N{U+03bc}ffi\N{U+10434}i\N{U+0307}\N{U+0131}";
187     #\N{LATIN SMALL LETTER A}\N{LATIN SMALL LETTER S}\N{LATIN SMALL LETTER S}\N{GREEK SMALL LETTER MU}\N{LATIN SMALL LETTER F}\N{LATIN SMALL LETTER F}\N{LATIN SMALL LETTER I}\N{DESERET SMALL LETTER AY}\N{LATIN SMALL LETTER I}\N{COMBINING DOT ABOVE}\N{LATIN SMALL LETTER DOTLESS I}
188
189     is(fc($s), $f, "ICU's casefold test passes");
190     is("\F$s", $f, "ICU's casefold test passes");
191
192     is( fc("aBİIıϐßffi񟿿"), "abi̇iıβssffi񟿿" );
193     is( "\FaBİIıϐßffi񟿿", "abi̇iıβssffi񟿿" );
194 #    TODO: {
195 #        local $::TODO = "turkic special cases";
196 #        is( fc "aBİIıϐßffi񟿿", "abiııβssffi񟿿" );
197 #    }
198
199     # The next batch come from http://www.devdaily.com/java/jwarehouse/lucene/contrib/icu/src/test/org/apache/lucene/analysis/icu/TestICUFoldingFilter.java.shtml
200     # Except the article got most casings wrong. Or maybe Lucene does.
201
202     is( fc("This is a test"), "this is a test" );
203     is( fc("Ruß"), "russ"    );
204     is( fc("ΜΆΪΟΣ"), "μάϊοσ" );
205     is( fc("Μάϊος"), "μάϊοσ" );
206     is( fc("𐐖"), "𐐾"       );
207     is( fc("r" . uni_to_native("\xe9") . "sum" . uni_to_native("\xe9")),
208            "r" . uni_to_native("\xe9") . "sum" . uni_to_native("\xe9") );
209     is( fc("re\x{0301}sume\x{0301}"), "re\x{301}sume\x{301}" );
210     is( fc("ELİF"), "eli\x{307}f" );
211     is( fc("eli\x{307}f"), "eli\x{307}f");
212
213     # This batch comes from
214     # http://www.java2s.com/Open-Source/Java-Document/Internationalization-Localization/icu4j/com/ibm/icu/dev/test/lang/UCharacterCaseTest.java.htm
215     # Which uses ICU as the backend.
216
217     my @folding_mixed = (
218         uni_to_native("\x{61}\x{42}\x{130}\x{49}\x{131}\x{3d0}\x{df}\x{fb03}"),
219         "A" . uni_to_native("\x{df}\x{b5}\x{fb03}\x{1040C}\x{130}\x{131}"),
220     );
221
222     my @folding_default = (
223         uni_to_native("\x{61}\x{62}\x{69}\x{307}\x{69}\x{131}\x{3b2}\x{73}\x{73}\x{66}\x{66}\x{69}"),
224         "ass\x{3bc}ffi\x{10434}i\x{307}\x{131}"
225     );
226
227     my @folding_exclude_turkic = (
228         uni_to_native("\x{61}\x{62}\x{69}\x{131}\x{131}\x{3b2}\x{73}\x{73}\x{66}\x{66}\x{69}"),
229                          "ass\x{3bc}ffi\x{10434}i\x{131}",
230     );
231
232     is( fc($folding_mixed[1]), $folding_default[1] );
233
234     is( fc($folding_mixed[0]), $folding_default[0] );
235
236 }
237
238 {
239     use utf8;
240     # Table stolen from tchrist's mail in
241     # http://bugs.python.org/file23051/casing-tests.py
242     # and http://98.245.80.27/tcpc/OSCON2011/case-test.python3
243     # For reference, it's a longer version of what he posted here:
244     # http://stackoverflow.com/questions/6991038/case-insensitive-storage-and-unicode-compatibility
245
246     #Couple of repeats because I'm lazy, not tchrist's fault.
247
248     #This should probably go in t/op/lc.t
249
250     my @test_table = (
251 # ORIG LC_SIMPLE TC_SIMPLE UC_SIMPLE LC_FULL TC_FULL UC_FULL FC_SIMPLE FC_TURKIC FC_FULL
252 [ 'þǽr rihtes', 'þǽr rihtes', 'Þǽr Rihtes', 'ÞǼR RIHTES', 'þǽr rihtes', 'Þǽr Rihtes', 'ÞǼR RIHTES', 'þǽr rihtes', 'þǽr rihtes', 'þǽr rihtes',  ],
253 [ 'duȝeðlice', 'duȝeðlice', 'Duȝeðlice', 'DUȜEÐLICE', 'duȝeðlice', 'Duȝeðlice', 'DUȜEÐLICE', 'duȝeðlice', 'duȝeðlice', 'duȝeðlice',  ],
254 [ 'Ævar Arnfjörð Bjarmason', 'ævar arnfjörð bjarmason', 'Ævar Arnfjörð Bjarmason', 'ÆVAR ARNFJÖRРBJARMASON', 'ævar arnfjörð bjarmason', 'Ævar Arnfjörð Bjarmason', 'ÆVAR ARNFJÖRРBJARMASON', 'ævar arnfjörð bjarmason', 'ævar arnfjörð bjarmason', 'ævar arnfjörð bjarmason',  ],
255 [ 'Кириллица', 'кириллица', 'Кириллица', 'КИРИЛЛИЦА', 'кириллица', 'Кириллица', 'КИРИЛЛИЦА', 'кириллица', 'кириллица', 'кириллица',  ],
256 [ 'ij', 'ij', 'IJ', 'IJ', 'ij', 'IJ', 'IJ', 'ij', 'ij', 'ij',  ],
257 [ 'Van Dijke', 'van dijke', 'Van Dijke', 'VAN DIJKE', 'van dijke', 'Van Dijke', 'VAN DIJKE', 'van dijke', 'van dijke', 'van dijke',  ],
258 [ 'VAN DIJKE', 'van dijke', 'Van Dijke', 'VAN DIJKE', 'van dijke', 'Van Dijke', 'VAN DIJKE', 'van dijke', 'van dijke', 'van dijke',  ],
259 [ 'efficient', 'efficient', 'Efficient', 'EffiCIENT', 'efficient', 'Efficient', 'EFFICIENT', 'efficient', 'efficient', 'efficient',  ],
260 [ 'flour', 'flour', 'flour', 'flOUR', 'flour', 'Flour', 'FLOUR', 'flour', 'flour', 'flour',  ],
261 [ 'flour and water', 'flour and water', 'flour And Water', 'flOUR AND WATER', 'flour and water', 'Flour And Water', 'FLOUR AND WATER', 'flour and water', 'flour and water', 'flour and water',  ],
262 [ 'dzur', 'dzur', 'Dzur', 'DZUR', 'dzur', 'Dzur', 'DZUR', 'dzur', 'dzur', 'dzur',  ],
263 [ 'Dzur', 'dzur', 'Dzur', 'DZUR', 'dzur', 'Dzur', 'DZUR', 'dzur', 'dzur', 'dzur',  ],
264 [ 'DZUR', 'dzur', 'Dzur', 'DZUR', 'dzur', 'Dzur', 'DZUR', 'dzur', 'dzur', 'dzur',  ],
265 [ 'dzur mountain', 'dzur mountain', 'Dzur Mountain', 'DZUR MOUNTAIN', 'dzur mountain', 'Dzur Mountain', 'DZUR MOUNTAIN', 'dzur mountain', 'dzur mountain', 'dzur mountain',  ],
266 [ 'Dzur Mountain', 'dzur mountain', 'Dzur Mountain', 'DZUR MOUNTAIN', 'dzur mountain', 'Dzur Mountain', 'DZUR MOUNTAIN', 'dzur mountain', 'dzur mountain', 'dzur mountain',  ],
267 [ 'DZUR MOUNTAIN', 'dzur mountain', 'Dzur Mountain', 'DZUR MOUNTAIN', 'dzur mountain', 'Dzur Mountain', 'DZUR MOUNTAIN', 'dzur mountain', 'dzur mountaın', 'dzur mountain',  ],
268 [ 'poſt', 'poſt', 'Poſt', 'POST', 'poſt', 'Poſt', 'POST', 'post', 'post', 'post',  ],
269 [ 'poſt', 'poſt', 'Poſt', 'POſt', 'poſt', 'Poſt', 'POST', 'poſt', 'post', 'post',  ],
270 [ 'ſtop', 'ſtop', 'ſtop', 'ſtOP', 'ſtop', 'Stop', 'STOP', 'ſtop', 'stop', 'stop',  ],
271 [ 'tschüß', 'tschüß', 'Tschüß', 'TSCHÜß', 'tschüß', 'Tschüß', 'TSCHÜSS', 'tschüß', 'tschüss', 'tschüss',  ],
272 [ 'TSCHÜẞ', 'tschüß', 'Tschüß', 'TSCHÜẞ', 'tschüß', 'Tschüß', 'TSCHÜẞ', 'tschüß', 'tschüss', 'tschüss',  ],
273 [ 'weiß', 'weiß', 'Weiß', 'WEIß', 'weiß', 'Weiß', 'WEISS', 'weiß', 'weiss', 'weiss',  ],
274 [ 'WEIẞ', 'weiß', 'Weiß', 'WEIẞ', 'weiß', 'Weiß', 'WEIẞ', 'weiß', 'weıss', 'weiss',  ],
275 [ 'ẞIEW', 'ßiew', 'ẞiew', 'ẞIEW', 'ßiew', 'ẞiew', 'ẞIEW', 'ßiew', 'ssıew', 'ssiew',  ],
276 [ 'ᾲ', 'ᾲ', 'Ὰͅ', 'ᾺΙ', 'ᾲ', 'Ὰͅ', 'ᾺΙ', 'ὰι', 'ὰι', 'ὰι',  ],
277 [ 'Ὰι', 'ὰι', 'Ὰι', 'ᾺΙ', 'ὰι', 'Ὰι', 'ᾺΙ', 'ὰι', 'ὰι', 'ὰι',  ],
278 [ 'ᾺΙ', 'ὰι', 'Ὰι', 'ᾺΙ', 'ὰι', 'Ὰι', 'ᾺΙ', 'ὰι', 'ὰι', 'ὰι',  ],
279 [ 'ᾲ', 'ᾲ', 'ᾲ', 'ᾲ', 'ᾲ', 'Ὰͅ', 'ᾺΙ', 'ᾲ', 'ὰι', 'ὰι',  ],
280 [ 'Ὰͅ', 'ᾲ', 'Ὰͅ', 'ᾺΙ', 'ᾲ', 'Ὰͅ', 'ᾺΙ', 'ὰι', 'ὰι', 'ὰι',  ],
281 [ 'ᾺΙ', 'ὰι', 'Ὰι', 'ᾺΙ', 'ὰι', 'Ὰι', 'ᾺΙ', 'ὰι', 'ὰι', 'ὰι',  ],
282 [ 'ᾲ στο διάολο', 'ᾲ στο διάολο', 'ᾲ Στο Διάολο', 'ᾲ ΣΤΟ ΔΙΆΟΛΟ', 'ᾲ στο διάολο', 'Ὰͅ Στο Διάολο', 'ᾺΙ ΣΤΟ ΔΙΆΟΛΟ', 'ᾲ στο διάολο', 'ὰι στο διάολο', 'ὰι στο διάολο',  ],
283 [ 'ᾲ στο διάολο', 'ᾲ στο διάολο', 'Ὰͅ Στο Διάολο', 'ᾺΙ ΣΤΟ ΔΙΆΟΛΟ', 'ᾲ στο διάολο', 'Ὰͅ Στο Διάολο', 'ᾺΙ ΣΤΟ ΔΙΆΟΛΟ', 'ὰι στο διάολο', 'ὰι στο διάολο', 'ὰι στο διάολο',  ],
284 [ '𐐼𐐯𐑅𐐨𐑉𐐯𐐻', '𐐼𐐯𐑅𐐨𐑉𐐯𐐻', '𐐔𐐯𐑅𐐨𐑉𐐯𐐻', '𐐔𐐇𐐝𐐀𐐡𐐇𐐓', '𐐼𐐯𐑅𐐨𐑉𐐯𐐻', '𐐔𐐯𐑅𐐨𐑉𐐯𐐻', '𐐔𐐇𐐝𐐀𐐡𐐇𐐓', '𐐼𐐯𐑅𐐨𐑉𐐯𐐻', '𐐼𐐯𐑅𐐨𐑉𐐯𐐻', '𐐼𐐯𐑅𐐨𐑉𐐯𐐻',  ],
285 [ '𐐔𐐯𐑅𐐨𐑉𐐯𐐻', '𐐼𐐯𐑅𐐨𐑉𐐯𐐻', '𐐔𐐯𐑅𐐨𐑉𐐯𐐻', '𐐔𐐇𐐝𐐀𐐡𐐇𐐓', '𐐼𐐯𐑅𐐨𐑉𐐯𐐻', '𐐔𐐯𐑅𐐨𐑉𐐯𐐻', '𐐔𐐇𐐝𐐀𐐡𐐇𐐓', '𐐼𐐯𐑅𐐨𐑉𐐯𐐻', '𐐼𐐯𐑅𐐨𐑉𐐯𐐻', '𐐼𐐯𐑅𐐨𐑉𐐯𐐻',  ],
286 [ '𐐔𐐇𐐝𐐀𐐡𐐇𐐓', '𐐼𐐯𐑅𐐨𐑉𐐯𐐻', '𐐔𐐯𐑅𐐨𐑉𐐯𐐻', '𐐔𐐇𐐝𐐀𐐡𐐇𐐓', '𐐼𐐯𐑅𐐨𐑉𐐯𐐻', '𐐔𐐯𐑅𐐨𐑉𐐯𐐻', '𐐔𐐇𐐝𐐀𐐡𐐇𐐓', '𐐼𐐯𐑅𐐨𐑉𐐯𐐻', '𐐼𐐯𐑅𐐨𐑉𐐯𐐻', '𐐼𐐯𐑅𐐨𐑉𐐯𐐻',  ],
287 [ 'henry ⅷ', 'henry ⅷ', 'Henry Ⅷ', 'HENRY Ⅷ', 'henry ⅷ', 'Henry Ⅷ', 'HENRY Ⅷ', 'henry ⅷ', 'henry ⅷ', 'henry ⅷ',  ],
288 [ 'Henry Ⅷ', 'henry ⅷ', 'Henry Ⅷ', 'HENRY Ⅷ', 'henry ⅷ', 'Henry Ⅷ', 'HENRY Ⅷ', 'henry ⅷ', 'henry ⅷ', 'henry ⅷ',  ],
289 [ 'HENRY Ⅷ', 'henry ⅷ', 'Henry Ⅷ', 'HENRY Ⅷ', 'henry ⅷ', 'Henry Ⅷ', 'HENRY Ⅷ', 'henry ⅷ', 'henry ⅷ', 'henry ⅷ',  ],
290 [ 'i work at ⓚ', 'i work at ⓚ', 'I Work At Ⓚ', 'I WORK AT Ⓚ', 'i work at ⓚ', 'I Work At Ⓚ', 'I WORK AT Ⓚ', 'i work at ⓚ', 'i work at ⓚ', 'i work at ⓚ',  ],
291 [ 'I Work At Ⓚ', 'i work at ⓚ', 'I Work At Ⓚ', 'I WORK AT Ⓚ', 'i work at ⓚ', 'I Work At Ⓚ', 'I WORK AT Ⓚ', 'i work at ⓚ', 'ı work at ⓚ', 'i work at ⓚ',  ],
292 [ 'I WORK AT Ⓚ', 'i work at ⓚ', 'I Work At Ⓚ', 'I WORK AT Ⓚ', 'i work at ⓚ', 'I Work At Ⓚ', 'I WORK AT Ⓚ', 'i work at ⓚ', 'ı work at ⓚ', 'i work at ⓚ',  ],
293 [ 'istambul', 'istambul', 'Istambul', 'ISTAMBUL', 'istambul', 'Istambul', 'ISTAMBUL', 'istambul', 'istambul', 'istambul',  ],
294 [ 'i̇stanbul', 'i̇stanbul', 'İstanbul', 'İSTANBUL', 'i̇stanbul', 'İstanbul', 'İSTANBUL', 'i̇stanbul', 'i̇stanbul', 'i̇stanbul',  ],
295 [ 'İstanbul', 'i̇stanbul', 'İstanbul', 'İSTANBUL', 'i̇stanbul', 'İstanbul', 'İSTANBUL', 'i̇stanbul', 'ı̇stanbul', 'i̇stanbul',  ],
296 [ 'İSTANBUL', 'istanbul', 'İstanbul', 'İSTANBUL', 'i̇stanbul', 'İstanbul', 'İSTANBUL', 'İstanbul', 'istanbul', 'i̇stanbul',  ],
297 [ 'στιγμας', 'στιγμας', 'Στιγμας', 'ΣΤΙΓΜΑΣ', 'στιγμας', 'Στιγμας', 'ΣΤΙΓΜΑΣ', 'στιγμασ', 'στιγμασ', 'στιγμασ',  ],
298 [ 'στιγμασ', 'στιγμασ', 'Στιγμασ', 'ΣΤΙΓΜΑΣ', 'στιγμασ', 'Στιγμασ', 'ΣΤΙΓΜΑΣ', 'στιγμασ', 'στιγμασ', 'στιγμασ',  ],
299 [ 'ΣΤΙΓΜΑΣ', 'στιγμασ', 'Στιγμασ', 'ΣΤΙΓΜΑΣ', 'στιγμασ', 'Στιγμασ', 'ΣΤΙΓΜΑΣ', 'στιγμασ', 'στιγμασ', 'στιγμασ',  ],
300 [ 'ʀᴀʀᴇ', 'ʀᴀʀᴇ', 'Ʀᴀʀᴇ', 'ƦᴀƦᴇ', 'ʀᴀʀᴇ', 'Ʀᴀʀᴇ', 'ƦᴀƦᴇ', 'ʀᴀʀᴇ', 'ʀᴀʀᴇ', 'ʀᴀʀᴇ',  ],
301 [ 'Ʀᴀʀᴇ', 'ʀᴀʀᴇ', 'Ʀᴀʀᴇ', 'ƦᴀƦᴇ', 'ʀᴀʀᴇ', 'Ʀᴀʀᴇ', 'ƦᴀƦᴇ', 'ʀᴀʀᴇ', 'ʀᴀʀᴇ', 'ʀᴀʀᴇ',  ],
302 [ 'ƦᴀƦᴇ', 'ʀᴀʀᴇ', 'Ʀᴀʀᴇ', 'ƦᴀƦᴇ', 'ʀᴀʀᴇ', 'Ʀᴀʀᴇ', 'ƦᴀƦᴇ', 'ʀᴀʀᴇ', 'ʀᴀʀᴇ', 'ʀᴀʀᴇ',  ],
303 [ 'Ԧԧ', 'ԧԧ', 'Ԧԧ', 'ԦԦ', 'ԧԧ', 'Ԧԧ', 'ԦԦ', 'ԧԧ', 'ԧԧ', 'ԧԧ',  ],
304 [ 'ԧԧ', 'ԧԧ', 'Ԧԧ', 'ԦԦ', 'ԧԧ', 'Ԧԧ', 'ԦԦ', 'ԧԧ', 'ԧԧ', 'ԧԧ',  ],
305 [ 'Ԧԧ', 'ԧԧ', 'Ԧԧ', 'ԦԦ', 'ԧԧ', 'Ԧԧ', 'ԦԦ', 'ԧԧ', 'ԧԧ', 'ԧԧ',  ],
306 [ 'ԦԦ', 'ԧԧ', 'Ԧԧ', 'ԦԦ', 'ԧԧ', 'Ԧԧ', 'ԦԦ', 'ԧԧ', 'ԧԧ', 'ԧԧ',  ],
307 [ "þǽr rihtes", "þǽr rihtes", "Þǽr Rihtes", "ÞǼR RIHTES", "þǽr rihtes", "Þǽr Rihtes", "ÞǼR RIHTES", "þǽr rihtes", "þǽr rihtes", "þǽr rihtes",  ],
308 [ "duȝeðlice", "duȝeðlice", "Duȝeðlice", "DUȜEÐLICE", "duȝeðlice", "Duȝeðlice", "DUȜEÐLICE", "duȝeðlice", "duȝeðlice", "duȝeðlice",  ],
309 [ "Van Dijke", "van dijke", "Van Dijke", "VAN DIJKE", "van dijke", "Van Dijke", "VAN DIJKE", "van dijke", "van dijke", "van dijke",  ],
310 [ "fi", "fi", "fi", "fi", "fi", "Fi", "FI", "fi", "fi", "fi",  ],
311 [ "filesystem", "filesystem", "filesystem", "fiLESYSTEM", "filesystem", "Filesystem", "FILESYSTEM", "filesystem", "filesystem", "filesystem",  ],
312 [ "efficient", "efficient", "Efficient", "EffiCIENT", "efficient", "Efficient", "EFFICIENT", "efficient", "efficient", "efficient",  ],
313 [ "flour and water", "flour and water", "flour And Water", "flOUR AND WATER", "flour and water", "Flour And Water", "FLOUR AND WATER", "flour and water", "flour and water", "flour and water",  ],
314 [ "dz", "dz", "Dz", "DZ", "dz", "Dz", "DZ", "dz", "dz", "dz",  ],
315 [ "dzur mountain", "dzur mountain", "Dzur Mountain", "DZUR MOUNTAIN", "dzur mountain", "Dzur Mountain", "DZUR MOUNTAIN", "dzur mountain", "dzur mountain", "dzur mountain",  ],
316 [ "poſt", "poſt", "Poſt", "POST", "poſt", "Poſt", "POST", "post", "post", "post",  ],
317 [ "poſt", "poſt", "Poſt", "POſt", "poſt", "Poſt", "POST", "poſt", "post", "post",  ],
318 [ "ſtop", "ſtop", "ſtop", "ſtOP", "ſtop", "Stop", "STOP", "ſtop", "stop", "stop",  ],
319 [ "tschüß", "tschüß", "Tschüß", "TSCHÜß", "tschüß", "Tschüß", "TSCHÜSS", "tschüß", "tschüss", "tschüss",  ],
320 [ "TSCHÜẞ", "tschüß", "Tschüß", "TSCHÜẞ", "tschüß", "Tschüß", "TSCHÜẞ", "tschüß", "tschüss", "tschüss",  ],
321 [ "rußland", "rußland", "Rußland", "RUßLAND", "rußland", "Rußland", "RUSSLAND", "rußland", "russland", "russland",  ],
322 [ "RUẞLAND", "rußland", "Rußland", "RUẞLAND", "rußland", "Rußland", "RUẞLAND", "rußland", "russland", "russland",  ],
323 [ "weiß", "weiß", "Weiß", "WEIß", "weiß", "Weiß", "WEISS", "weiß", "weiss", "weiss",  ],
324 [ "WEIẞ", "weiß", "Weiß", "WEIẞ", "weiß", "Weiß", "WEIẞ", "weiß", "weıss", "weiss",  ],
325 [ "ẞIEW", "ßiew", "ẞiew", "ẞIEW", "ßiew", "ẞiew", "ẞIEW", "ßiew", "ssıew", "ssiew",  ],
326 [ "ͅ", "ͅ", "Ι", "Ι", "ͅ", "Ι", "Ι", "ι", "ι", "ι",  ],
327 [ "ᾲ", "ᾲ", "Ὰͅ", "ᾺΙ", "ᾲ", "Ὰͅ", "ᾺΙ", "ὰι", "ὰι", "ὰι",  ],
328 [ "Ὰι", "ὰι", "Ὰι", "ᾺΙ", "ὰι", "Ὰι", "ᾺΙ", "ὰι", "ὰι", "ὰι",  ],
329 [ "ᾺΙ", "ὰι", "Ὰι", "ᾺΙ", "ὰι", "Ὰι", "ᾺΙ", "ὰι", "ὰι", "ὰι",  ],
330 [ "ᾲ", "ᾲ", "ᾲ", "ᾲ", "ᾲ", "Ὰͅ", "ᾺΙ", "ᾲ", "ὰι", "ὰι",  ],
331 [ "Ὰͅ", "ᾲ", "Ὰͅ", "ᾺΙ", "ᾲ", "Ὰͅ", "ᾺΙ", "ὰι", "ὰι", "ὰι",  ],
332 [ "ᾺΙ", "ὰι", "Ὰι", "ᾺΙ", "ὰι", "Ὰι", "ᾺΙ", "ὰι", "ὰι", "ὰι",  ],
333 [ "ᾲ στο διάολο", "ᾲ στο διάολο", "ᾲ Στο Διάολο", "ᾲ ΣΤΟ ΔΙΆΟΛΟ", "ᾲ στο διάολο", "Ὰͅ Στο Διάολο", "ᾺΙ ΣΤΟ ΔΙΆΟΛΟ", "ᾲ στο διάολο", "ὰι στο διάολο", "ὰι στο διάολο",  ],
334 [ "ᾲ στο διάολο", "ᾲ στο διάολο", "Ὰͅ Στο Διάολο", "ᾺΙ ΣΤΟ ΔΙΆΟΛΟ", "ᾲ στο διάολο", "Ὰͅ Στο Διάολο", "ᾺΙ ΣΤΟ ΔΙΆΟΛΟ", "ὰι στο διάολο", "ὰι στο διάολο", "ὰι στο διάολο",  ],
335 [ "ⅷ", "ⅷ", "Ⅷ", "Ⅷ", "ⅷ", "Ⅷ", "Ⅷ", "ⅷ", "ⅷ", "ⅷ",  ],
336 [ "henry ⅷ", "henry ⅷ", "Henry Ⅷ", "HENRY Ⅷ", "henry ⅷ", "Henry Ⅷ", "HENRY Ⅷ", "henry ⅷ", "henry ⅷ", "henry ⅷ",  ],
337 [ "ⓚ", "ⓚ", "Ⓚ", "Ⓚ", "ⓚ", "Ⓚ", "Ⓚ", "ⓚ", "ⓚ", "ⓚ",  ],
338 [ "i work at ⓚ", "i work at ⓚ", "I Work At Ⓚ", "I WORK AT Ⓚ", "i work at ⓚ", "I Work At Ⓚ", "I WORK AT Ⓚ", "i work at ⓚ", "i work at ⓚ", "i work at ⓚ",  ],
339 [ "istambul", "istambul", "Istambul", "ISTAMBUL", "istambul", "Istambul", "ISTAMBUL", "istambul", "istambul", "istambul",  ],
340 [ "i̇stanbul", "i̇stanbul", "İstanbul", "İSTANBUL", "i̇stanbul", "İstanbul", "İSTANBUL", "i̇stanbul", "i̇stanbul", "i̇stanbul",  ],
341 [ "İstanbul", "i̇stanbul", "İstanbul", "İSTANBUL", "i̇stanbul", "İstanbul", "İSTANBUL", "i̇stanbul", "ı̇stanbul", "i̇stanbul",  ],
342 [ "İSTANBUL", "istanbul", "İstanbul", "İSTANBUL", "i̇stanbul", "İstanbul", "İSTANBUL", "İstanbul", "istanbul", "i̇stanbul",  ],
343 [ "στιγμας", "στιγμας", "Στιγμας", "ΣΤΙΓΜΑΣ", "στιγμας", "Στιγμας", "ΣΤΙΓΜΑΣ", "στιγμασ", "στιγμασ", "στιγμασ",  ],
344 [ "στιγμασ", "στιγμασ", "Στιγμασ", "ΣΤΙΓΜΑΣ", "στιγμασ", "Στιγμασ", "ΣΤΙΓΜΑΣ", "στιγμασ", "στιγμασ", "στιγμασ",  ],
345 [ "ΣΤΙΓΜΑΣ", "στιγμασ", "Στιγμασ", "ΣΤΙΓΜΑΣ", "στιγμασ", "Στιγμασ", "ΣΤΙΓΜΑΣ", "στιγμασ", "στιγμασ", "στιγμασ",  ],
346 [ "ʀᴀʀᴇ", "ʀᴀʀᴇ", "Ʀᴀʀᴇ", "ƦᴀƦᴇ", "ʀᴀʀᴇ", "Ʀᴀʀᴇ", "ƦᴀƦᴇ", "ʀᴀʀᴇ", "ʀᴀʀᴇ", "ʀᴀʀᴇ",  ],
347 [ "𐐼𐐯𐑅𐐨𐑉𐐯𐐻", "𐐼𐐯𐑅𐐨𐑉𐐯𐐻", "𐐔𐐯𐑅𐐨𐑉𐐯𐐻", "𐐔𐐇𐐝𐐀𐐡𐐇𐐓", "𐐼𐐯𐑅𐐨𐑉𐐯𐐻", "𐐔𐐯𐑅𐐨𐑉𐐯𐐻", "𐐔𐐇𐐝𐐀𐐡𐐇𐐓", "𐐼𐐯𐑅𐐨𐑉𐐯𐐻", "𐐼𐐯𐑅𐐨𐑉𐐯𐐻", "𐐼𐐯𐑅𐐨𐑉𐐯𐐻",  ],
348 [ "Ԧԧ", "ԧԧ", "Ԧԧ", "ԦԦ", "ԧԧ", "Ԧԧ", "ԦԦ", "ԧԧ", "ԧԧ", "ԧԧ",  ],
349 [ "ﬓﬔﬕﬖﬗ", "ﬓﬔﬕﬖﬗ", "ﬓﬔﬕﬖﬗ", "ﬓﬔﬕﬖﬗ", "ﬓﬔﬕﬖﬗ", "Մնﬔﬕﬖﬗ", "ՄՆՄԵՄԻՎՆՄԽ", "ﬓﬔﬕﬖﬗ", "մնմեմիվնմխ", "մնմեմիվնմխ",  ],
350 [ "ʼn groot", "ʼn groot", "ʼn Groot", "ʼn GROOT", "ʼn groot", "ʼN Groot", "ʼN GROOT", "ʼn groot", "ʼn groot", "ʼn groot",  ],
351 [ "ẚ", "ẚ", "ẚ", "ẚ", "ẚ", "Aʾ", "Aʾ", "ẚ", "aʾ", "aʾ",  ],
352 [ "ff", "ff", "ff", "ff", "ff", "Ff", "FF", "ff", "ff", "ff",  ],
353 [ "ǰ", "ǰ", "ǰ", "ǰ", "ǰ", "J̌", "J̌", "ǰ", "ǰ", "ǰ",  ],
354 [ "550 nm or Å", "550 nm or å", "550 Nm Or Å", "550 NM OR Å", "550 nm or å", "550 Nm Or Å", "550 NM OR Å", "550 nm or å", "550 nm or å", "550 nm or å",  ],
355 );
356
357     use feature qw(fc);
358
359     for (@test_table) {
360         my ($simple_lc, $simple_tc, $simple_uc, $simple_fc) = @{$_}[1, 2, 3, 7];
361         my ($orig, $lower, $titlecase, $upper, $fc_turkic, $fc_full) = @{$_}[0,4,5,6,8,9];
362
363         if ($orig =~ /(\P{Assigned})/) {   # So can fail gracefully in earlier
364                                            # Unicode versions
365             fail(sprintf "because U+%04X is unassigned", ord($1));
366             next;
367         }
368         is( fc($orig), $fc_full, "fc('$orig') returns '$fc_full'" );
369         is( "\F$orig", $fc_full, '\F works' );
370         is( lc($orig), $lower,   "lc('$orig') returns '$lower'" );
371         is( "\L$orig", $lower,   '\L works' );
372         is( uc($orig), $upper,   "uc('$orig') returns '$upper'" );
373         is( "\U$orig", $upper,   '\U works' );
374     }
375 }
376
377 {
378     use feature qw(fc);
379     package Eeyup  { use overload q{""} => sub { main::uni_to_native("\x{df}")   }, fallback => 1 }
380     package Uunope { use overload q{""} => sub { "\x{30cb}" }, fallback => 1 }
381     package Undef  { use overload q{""} => sub {   undef    }, fallback => 1 }
382
383     my $obj = bless {}, "Eeyup";
384     is(fc($obj), "ss", "fc() works on overloaded objects returning latin-1");
385     $obj = bless {}, "Eeyup";
386     is("\F$obj", "ss", '\F works on overloaded objects returning latin-1');
387
388     $obj = bless {}, "Uunope";
389     is(fc($obj), "\x{30cb}", "fc() works on overloaded objects returning UTF-8");
390     $obj = bless {}, "Uunope";
391     is("\F$obj", "\x{30cb}", '\F works on overloaded objects returning UTF-8');
392
393     $obj = bless {}, "Undef";
394     my $warnings;
395     {
396         no warnings;
397         use warnings "uninitialized";
398         local $SIG{__WARN__} = sub { $warnings++; like(shift, qr/Use of uninitialized value (?:\$obj )?in fc/) };
399         fc(undef);
400         fc($obj);
401     }
402     is( $warnings, 2, "correct number of warnings" );
403
404     my $fetched = 0;
405     package Derpy { sub TIESCALAR { bless {}, shift } sub FETCH { $fetched++; main::uni_to_native("\x{df}") } }
406
407     tie my $x, "Derpy";
408
409     is( fc($x), "ss", "fc() works on tied values" );
410     is( $fetched, 1, "and only calls the magic once" );
411
412 }
413
414 {
415     use feature qw( fc );
416     my $troublesome1 = uni_to_native("\xdf") x 11; #SvLEN should be 12, SvCUR should be 11
417                                     #So this should force fc() to grow the string.
418
419     is( fc($troublesome1), "ss" x 11, "fc() grows the string" );
420
421     my $troublesome2 = "abcdef:" . uni_to_native("\x{df}")
422                      . ":fjksjs"; #SvLEN should be 16, SvCUR should be 15
423     is( fc($troublesome2), "abcdef:ss:fjksjs", "fc() expands \\x{DF} in the middle of a string that needs to grow" );
424
425     my $troublesome3 = ":" . uni_to_native("\x{df}") . ":";
426     is( fc($troublesome3), ":ss:", "fc() expands \\x{DF} in the middle of a string" );
427
428
429     my $troublesome4 = uni_to_native("\x{B5}"); #\N{MICRON SIGN} is latin-1, but its foldcase is in UTF-8
430
431     is( fc($troublesome4), "\x{3BC}", "fc() for a latin-1 \x{B5} returns UTF-8" );
432     ok( !utf8::is_utf8($troublesome4), "fc() doesn't upgrade the original string" );
433
434
435     my $troublesome5 = uni_to_native("\x{C9}") . "abda"
436                      . uni_to_native("\x{B5}") . "aaf"
437                      . uni_to_native("\x{C8}");  # Up until foldcasing \x{B5}, the string
438                                                     # was in Latin-1. This tests that the
439                                                     # results don't have illegal UTF-8
440                                                     # (i.e. leftover latin-1) in them
441
442     is( fc($troublesome5), uni_to_native("\x{E9}") . "abda\x{3BC}aaf"
443                          . uni_to_native("\x{E8}") );
444 }
445
446
447 SKIP: {
448     use feature qw( fc unicode_strings );
449
450     skip "locales not available", 256 unless locales_enabled('LC_ALL');
451
452     setlocale(&POSIX::LC_ALL, "C");
453
454     # This tests both code paths in pp_fc
455
456     for (0..0xff) {
457         my $latin1 = chr;
458         my $utf8   = $latin1;
459         utf8::downgrade($latin1); #No-op, but doesn't hurt
460         utf8::upgrade($utf8);
461         is(fc($latin1), fc($utf8), "fc() gives the same results for \\x{$_} in Latin-1 and UTF-8 under unicode_strings");
462         SKIP: {
463             skip 'Locales not available', 2 unless locales_enabled('LC_CTYPE');
464             use locale;
465             is(fc($latin1), lc($latin1), "use locale; fc(qq{\\x{$_}}), lc(qq{\\x{$_}}) when qq{\\x{$_}} is in latin-1");
466             is(fc($utf8), lc($utf8), "use locale; fc(qq{\\x{$_}}), lc(qq{\\x{$_}}) when qq{\\x{$_}} is in latin-1");
467         }
468         {
469             no feature 'unicode_strings';
470             is(fc($latin1), lc($latin1), "under nothing, fc() for <256 is the same as lc");
471         }
472     }
473 }
474
475 my $utf8_locale = find_utf8_ctype_locale();
476
477 {
478     use feature qw( fc );
479     use locale;
480     no warnings 'locale';   # Would otherwise warn
481     is(fc("\x{1E9E}"), fc("\x{17F}\x{17F}"), 'fc("\x{1E9E}") eq fc("\x{17F}\x{17F}")');
482     use warnings 'locale';
483     SKIP: {
484         skip 'Can\'t find a UTF-8 locale', 1 unless defined $utf8_locale;
485         setlocale(&LC_CTYPE, $utf8_locale);
486         is(fc("\x{1E9E}"), "ss", 'fc("\x{1E9E}") eq "ss" in a UTF-8 locale)');
487     }
488 }
489
490 SKIP: {
491     skip 'Can\'t find a UTF-8 locale', 256 unless defined $utf8_locale;
492
493     use feature qw( fc unicode_strings );
494
495     # Get the official fc values outside locale.
496     no locale;
497     my @unicode_fc;
498     for (0..0xff) {
499         push @unicode_fc, fc(chr);
500     }
501
502     # These should match the UTF-8 locale values
503     setlocale(&LC_CTYPE, $utf8_locale);
504     use locale;
505     for (0..0xff) {
506         is(fc(chr), $unicode_fc[$_], "In a UTF-8 locale, fc(chr $_) is the same as official Unicode");
507     }
508 }
509
510
511 my $num_tests = curr_test() - 1;
512
513 plan($num_tests);