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ıϐßﬃ񟿿"), "abi̇iıβssffi񟿿" );
 193     is( "\FaBİIıϐßﬃ񟿿", "abi̇iıβssffi񟿿" );
 194 #    TODO: {
 195 #        local $::TODO = "turkic special cases";
 196 #        is( fc "aBİIıϐßﬃ񟿿", "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 [ 'ĳ', 'ĳ', 'Ĳ', 'Ĳ', 'ĳ', 'Ĳ', 'Ĳ', 'ĳ', 'ĳ', 'ĳ',  ],
 257 [ 'Van Dĳke', 'van dĳke', 'Van Dĳke', 'VAN DĲKE', 'van dĳke', 'Van Dĳke', 'VAN DĲKE', 'van dĳke', 'van dĳke', 'van dĳke',  ],
 258 [ 'VAN DĲKE', 'van dĳke', 'Van Dĳke', 'VAN DĲKE', 'van dĳke', 'Van Dĳke', 'VAN DĲKE', 'van dĳke', 'van dĳke', 'van dĳke',  ],
 259 [ 'eﬃcient', 'eﬃcient', 'Eﬃcient', 'EﬃCIENT', 'eﬃcient', 'Eﬃcient', 'EFFICIENT', 'eﬃcient', 'efficient', 'efficient',  ],
 260 [ 'ﬂour', 'ﬂour', 'ﬂour', 'ﬂOUR', 'ﬂour', 'Flour', 'FLOUR', 'ﬂour', 'flour', 'flour',  ],
 261 [ 'ﬂour and water', 'ﬂour and water', 'ﬂour And Water', 'ﬂOUR AND WATER', 'ﬂour and water', 'Flour And Water', 'FLOUR AND WATER', 'ﬂour and water', 'flour and water', 'flour and water',  ],
 262 [ 'ǳur', 'ǳur', 'ǲur', 'ǱUR', 'ǳur', 'ǲur', 'ǱUR', 'ǳur', 'ǳur', 'ǳur',  ],
 263 [ 'ǲur', 'ǳur', 'ǲur', 'ǱUR', 'ǳur', 'ǲur', 'ǱUR', 'ǳur', 'ǳur', 'ǳur',  ],
 264 [ 'ǱUR', 'ǳur', 'ǲur', 'ǱUR', 'ǳur', 'ǲur', 'ǱUR', 'ǳur', 'ǳur', 'ǳur',  ],
 265 [ 'ǳur mountain', 'ǳur mountain', 'ǲur Mountain', 'ǱUR MOUNTAIN', 'ǳur mountain', 'ǲur Mountain', 'ǱUR MOUNTAIN', 'ǳur mountain', 'ǳur mountain', 'ǳur mountain',  ],
 266 [ 'ǲur Mountain', 'ǳur mountain', 'ǲur Mountain', 'ǱUR MOUNTAIN', 'ǳur mountain', 'ǲur Mountain', 'ǱUR MOUNTAIN', 'ǳur mountain', 'ǳur mountain', 'ǳur mountain',  ],
 267 [ 'ǱUR MOUNTAIN', 'ǳur mountain', 'ǲur Mountain', 'ǱUR MOUNTAIN', 'ǳur mountain', 'ǲur Mountain', 'ǱUR MOUNTAIN', 'ǳur mountain', 'ǳur mountaın', 'ǳur mountain',  ],
 268 [ 'poſt', 'poſt', 'Poſt', 'POST', 'poſt', 'Poſt', 'POST', 'post', 'post', 'post',  ],
 269 [ 'poﬅ', 'poﬅ', 'Poﬅ', 'POﬅ', 'poﬅ', 'Poﬅ', 'POST', 'poﬅ', 'post', 'post',  ],
 270 [ 'ﬅop', 'ﬅop', 'ﬅop', 'ﬅOP', 'ﬅop', 'Stop', 'STOP', 'ﬅop', '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', 'İstanbul', 'İSTANBUL', 'i̇stanbul', 'İstanbul', 'İSTANBUL', 'i̇stanbul', 'i̇stanbul', 'i̇stanbul',  ],
 295 [ 'İstanbul', 'i̇stanbul', 'İstanbul', 'İSTANBUL', 'i̇stanbul', 'İstanbul', 'İ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 Dĳke", "van dĳke", "Van Dĳke", "VAN DĲKE", "van dĳke", "Van Dĳke", "VAN DĲKE", "van dĳke", "van dĳke", "van dĳke",  ],
 310 [ "ﬁ", "ﬁ", "ﬁ", "ﬁ", "ﬁ", "Fi", "FI", "ﬁ", "fi", "fi",  ],
 311 [ "ﬁlesystem", "ﬁlesystem", "ﬁlesystem", "ﬁLESYSTEM", "ﬁlesystem", "Filesystem", "FILESYSTEM", "ﬁlesystem", "filesystem", "filesystem",  ],
 312 [ "eﬃcient", "eﬃcient", "Eﬃcient", "EﬃCIENT", "eﬃcient", "Eﬃcient", "EFFICIENT", "eﬃcient", "efficient", "efficient",  ],
 313 [ "ﬂour and water", "ﬂour and water", "ﬂour And Water", "ﬂOUR AND WATER", "ﬂour and water", "Flour And Water", "FLOUR AND WATER", "ﬂour and water", "flour and water", "flour and water",  ],
 314 [ "ǳ", "ǳ", "ǲ", "Ǳ", "ǳ", "ǲ", "Ǳ", "ǳ", "ǳ", "ǳ",  ],
 315 [ "ǳur mountain", "ǳur mountain", "ǲur Mountain", "ǱUR MOUNTAIN", "ǳur mountain", "ǲur Mountain", "ǱUR MOUNTAIN", "ǳur mountain", "ǳur mountain", "ǳur mountain",  ],
 316 [ "poſt", "poſt", "Poſt", "POST", "poſt", "Poſt", "POST", "post", "post", "post",  ],
 317 [ "poﬅ", "poﬅ", "Poﬅ", "POﬅ", "poﬅ", "Poﬅ", "POST", "poﬅ", "post", "post",  ],
 318 [ "ﬅop", "ﬅop", "ﬅop", "ﬅOP", "ﬅop", "Stop", "STOP", "ﬅop", "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", "İstanbul", "İSTANBUL", "i̇stanbul", "İstanbul", "İSTANBUL", "i̇stanbul", "i̇stanbul", "i̇stanbul",  ],
 341 [ "İstanbul", "i̇stanbul", "İstanbul", "İSTANBUL", "i̇stanbul", "İstanbul", "İ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 [ "ŉ groot", "ŉ groot", "ŉ Groot", "ŉ GROOT", "ŉ groot", "ʼN Groot", "ʼN GROOT", "ŉ groot", "ʼn groot", "ʼn groot",  ],
 351 [ "ẚ", "ẚ", "ẚ", "ẚ", "ẚ", "Aʾ", "Aʾ", "ẚ", "aʾ", "aʾ",  ],
 352 [ "ﬀ", "ﬀ", "ﬀ", "ﬀ", "ﬀ", "Ff", "FF", "ﬀ", "ff", "ff",  ],
 353 [ "ǰ", "ǰ", "ǰ", "ǰ", "ǰ", "J̌", "J̌", "ǰ", "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);