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