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 }
 160
 161 {
 162     use utf8;
 163     use feature qw(fc);
 164     # These three come from the ICU project's test suite, more especifically
 165     # http://icu.sourcearchive.com/documentation/4.4~rc1-1/strcase_8cpp-source.html
 166
 167     my $s = "A\N{U+00df}\N{U+00b5}\N{U+fb03}\N{U+1040C}\N{U+0130}\N{U+0131}";
 168     #\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}
 169
 170     my $f = "ass\N{U+03bc}ffi\N{U+10434}i\N{U+0307}\N{U+0131}";
 171     #\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}
 172
 173     is(fc($s), $f, "ICU's casefold test passes");
 174     is("\F$s", $f, "ICU's casefold test passes");
 175
 176     is( fc("aBİIıϐßﬃ񟿿"), "abi̇iıβssffi񟿿" );
 177     is( "\FaBİIıϐßﬃ񟿿", "abi̇iıβssffi񟿿" );
 178 #    TODO: {
 179 #        local $::TODO = "turkic special cases";
 180 #        is( fc "aBİIıϐßﬃ񟿿", "abiııβssffi񟿿" );
 181 #    }
 182
 183     # The next batch come from http://www.devdaily.com/java/jwarehouse/lucene/contrib/icu/src/test/org/apache/lucene/analysis/icu/TestICUFoldingFilter.java.shtml
 184     # Except the article got most casings wrong. Or maybe Lucene does.
 185
 186     is( fc("This is a test"), "this is a test" );
 187     is( fc("Ruß"), "russ"    );
 188     is( fc("ΜΆΪΟΣ"), "μάϊοσ" );
 189     is( fc("Μάϊος"), "μάϊοσ" );
 190     is( fc("𐐖"), "𐐾"       );
 191     is( fc("r" . uni_to_native("\xe9") . "sum" . uni_to_native("\xe9")),
 192            "r" . uni_to_native("\xe9") . "sum" . uni_to_native("\xe9") );
 193     is( fc("re\x{0301}sume\x{0301}"), "re\x{301}sume\x{301}" );
 194     is( fc("ELİF"), "eli\x{307}f" );
 195     is( fc("eli\x{307}f"), "eli\x{307}f");
 196
 197     # This batch comes from
 198     # http://www.java2s.com/Open-Source/Java-Document/Internationalization-Localization/icu4j/com/ibm/icu/dev/test/lang/UCharacterCaseTest.java.htm
 199     # Which uses ICU as the backend.
 200
 201     my @folding_mixed = (
 202         uni_to_native("\x{61}\x{42}\x{130}\x{49}\x{131}\x{3d0}\x{df}\x{fb03}"),
 203         "A" . uni_to_native("\x{df}\x{b5}\x{fb03}\x{1040C}\x{130}\x{131}"),
 204     );
 205
 206     my @folding_default = (
 207         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}"),
 208         "ass\x{3bc}ffi\x{10434}i\x{307}\x{131}"
 209     );
 210
 211     my @folding_exclude_turkic = (
 212         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}"),
 213                          "ass\x{3bc}ffi\x{10434}i\x{131}",
 214     );
 215
 216     is( fc($folding_mixed[1]), $folding_default[1] );
 217
 218     is( fc($folding_mixed[0]), $folding_default[0] );
 219
 220 }
 221
 222 {
 223     use utf8;
 224     # Table stolen from tchrist's mail in
 225     # http://bugs.python.org/file23051/casing-tests.py
 226     # and http://98.245.80.27/tcpc/OSCON2011/case-test.python3
 227     # For reference, it's a longer version of what he posted here:
 228     # http://stackoverflow.com/questions/6991038/case-insensitive-storage-and-unicode-compatibility
 229
 230     #Couple of repeats because I'm lazy, not tchrist's fault.
 231
 232     #This should probably go in t/op/lc.t
 233
 234     my @test_table = (
 235 # ORIG LC_SIMPLE TC_SIMPLE UC_SIMPLE LC_FULL TC_FULL UC_FULL FC_SIMPLE FC_TURKIC FC_FULL
 236 [ 'þǽr rihtes', 'þǽr rihtes', 'Þǽr Rihtes', 'ÞǼR RIHTES', 'þǽr rihtes', 'Þǽr Rihtes', 'ÞǼR RIHTES', 'þǽr rihtes', 'þǽr rihtes', 'þǽr rihtes',  ],
 237 [ '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',  ],
 238 [ 'Æ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',  ],
 239 [ 'Кириллица', 'кириллица', 'Кириллица', 'КИРИЛЛИЦА', 'кириллица', 'Кириллица', 'КИРИЛЛИЦА', 'кириллица', 'кириллица', 'кириллица',  ],
 240 [ 'ĳ', 'ĳ', 'Ĳ', 'Ĳ', 'ĳ', 'Ĳ', 'Ĳ', 'ĳ', 'ĳ', 'ĳ',  ],
 241 [ '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',  ],
 242 [ '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',  ],
 243 [ 'eﬃcient', 'eﬃcient', 'Eﬃcient', 'EﬃCIENT', 'eﬃcient', 'Eﬃcient', 'EFFICIENT', 'eﬃcient', 'efficient', 'efficient',  ],
 244 [ 'ﬂour', 'ﬂour', 'ﬂour', 'ﬂOUR', 'ﬂour', 'Flour', 'FLOUR', 'ﬂour', 'flour', 'flour',  ],
 245 [ 'ﬂ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',  ],
 246 [ 'ǳur', 'ǳur', 'ǲur', 'ǱUR', 'ǳur', 'ǲur', 'ǱUR', 'ǳur', 'ǳur', 'ǳur',  ],
 247 [ 'ǲur', 'ǳur', 'ǲur', 'ǱUR', 'ǳur', 'ǲur', 'ǱUR', 'ǳur', 'ǳur', 'ǳur',  ],
 248 [ 'ǱUR', 'ǳur', 'ǲur', 'ǱUR', 'ǳur', 'ǲur', 'ǱUR', 'ǳur', 'ǳur', 'ǳur',  ],
 249 [ 'ǳur mountain', 'ǳur mountain', 'ǲur Mountain', 'ǱUR MOUNTAIN', 'ǳur mountain', 'ǲur Mountain', 'ǱUR MOUNTAIN', 'ǳur mountain', 'ǳur mountain', 'ǳur mountain',  ],
 250 [ 'ǲur Mountain', 'ǳur mountain', 'ǲur Mountain', 'ǱUR MOUNTAIN', 'ǳur mountain', 'ǲur Mountain', 'ǱUR MOUNTAIN', 'ǳur mountain', 'ǳur mountain', 'ǳur mountain',  ],
 251 [ 'ǱUR MOUNTAIN', 'ǳur mountain', 'ǲur Mountain', 'ǱUR MOUNTAIN', 'ǳur mountain', 'ǲur Mountain', 'ǱUR MOUNTAIN', 'ǳur mountain', 'ǳur mountaın', 'ǳur mountain',  ],
 252 [ 'poſt', 'poſt', 'Poſt', 'POST', 'poſt', 'Poſt', 'POST', 'post', 'post', 'post',  ],
 253 [ 'poﬅ', 'poﬅ', 'Poﬅ', 'POﬅ', 'poﬅ', 'Poﬅ', 'POST', 'poﬅ', 'post', 'post',  ],
 254 [ 'ﬅop', 'ﬅop', 'ﬅop', 'ﬅOP', 'ﬅop', 'Stop', 'STOP', 'ﬅop', 'stop', 'stop',  ],
 255 [ 'tschüß', 'tschüß', 'Tschüß', 'TSCHÜß', 'tschüß', 'Tschüß', 'TSCHÜSS', 'tschüß', 'tschüss', 'tschüss',  ],
 256 [ 'TSCHÜẞ', 'tschüß', 'Tschüß', 'TSCHÜẞ', 'tschüß', 'Tschüß', 'TSCHÜẞ', 'tschüß', 'tschüss', 'tschüss',  ],
 257 [ 'weiß', 'weiß', 'Weiß', 'WEIß', 'weiß', 'Weiß', 'WEISS', 'weiß', 'weiss', 'weiss',  ],
 258 [ 'WEIẞ', 'weiß', 'Weiß', 'WEIẞ', 'weiß', 'Weiß', 'WEIẞ', 'weiß', 'weıss', 'weiss',  ],
 259 [ 'ẞIEW', 'ßiew', 'ẞiew', 'ẞIEW', 'ßiew', 'ẞiew', 'ẞIEW', 'ßiew', 'ssıew', 'ssiew',  ],
 260 [ 'ᾲ', 'ᾲ', 'Ὰͅ', 'ᾺΙ', 'ᾲ', 'Ὰͅ', 'ᾺΙ', 'ὰι', 'ὰι', 'ὰι',  ],
 261 [ 'Ὰι', 'ὰι', 'Ὰι', 'ᾺΙ', 'ὰι', 'Ὰι', 'ᾺΙ', 'ὰι', 'ὰι', 'ὰι',  ],
 262 [ 'ᾺΙ', 'ὰι', 'Ὰι', 'ᾺΙ', 'ὰι', 'Ὰι', 'ᾺΙ', 'ὰι', 'ὰι', 'ὰι',  ],
 263 [ 'ᾲ', 'ᾲ', 'ᾲ', 'ᾲ', 'ᾲ', 'Ὰͅ', 'ᾺΙ', 'ᾲ', 'ὰι', 'ὰι',  ],
 264 [ 'Ὰͅ', 'ᾲ', 'Ὰͅ', 'ᾺΙ', 'ᾲ', 'Ὰͅ', 'ᾺΙ', 'ὰι', 'ὰι', 'ὰι',  ],
 265 [ 'ᾺΙ', 'ὰι', 'Ὰι', 'ᾺΙ', 'ὰι', 'Ὰι', 'ᾺΙ', 'ὰι', 'ὰι', 'ὰι',  ],
 266 [ 'ᾲ στο διάολο', 'ᾲ στο διάολο', 'ᾲ Στο Διάολο', 'ᾲ ΣΤΟ ΔΙΆΟΛΟ', 'ᾲ στο διάολο', 'Ὰͅ Στο Διάολο', 'ᾺΙ ΣΤΟ ΔΙΆΟΛΟ', 'ᾲ στο διάολο', 'ὰι στο διάολο', 'ὰι στο διάολο',  ],
 267 [ 'ᾲ στο διάολο', 'ᾲ στο διάολο', 'Ὰͅ Στο Διάολο', 'ᾺΙ ΣΤΟ ΔΙΆΟΛΟ', 'ᾲ στο διάολο', 'Ὰͅ Στο Διάολο', 'ᾺΙ ΣΤΟ ΔΙΆΟΛΟ', 'ὰι στο διάολο', 'ὰι στο διάολο', 'ὰι στο διάολο',  ],
 268 [ '𐐼𐐯𐑅𐐨𐑉𐐯𐐻', '𐐼𐐯𐑅𐐨𐑉𐐯𐐻', '𐐔𐐯𐑅𐐨𐑉𐐯𐐻', '𐐔𐐇𐐝𐐀𐐡𐐇𐐓', '𐐼𐐯𐑅𐐨𐑉𐐯𐐻', '𐐔𐐯𐑅𐐨𐑉𐐯𐐻', '𐐔𐐇𐐝𐐀𐐡𐐇𐐓', '𐐼𐐯𐑅𐐨𐑉𐐯𐐻', '𐐼𐐯𐑅𐐨𐑉𐐯𐐻', '𐐼𐐯𐑅𐐨𐑉𐐯𐐻',  ],
 269 [ '𐐔𐐯𐑅𐐨𐑉𐐯𐐻', '𐐼𐐯𐑅𐐨𐑉𐐯𐐻', '𐐔𐐯𐑅𐐨𐑉𐐯𐐻', '𐐔𐐇𐐝𐐀𐐡𐐇𐐓', '𐐼𐐯𐑅𐐨𐑉𐐯𐐻', '𐐔𐐯𐑅𐐨𐑉𐐯𐐻', '𐐔𐐇𐐝𐐀𐐡𐐇𐐓', '𐐼𐐯𐑅𐐨𐑉𐐯𐐻', '𐐼𐐯𐑅𐐨𐑉𐐯𐐻', '𐐼𐐯𐑅𐐨𐑉𐐯𐐻',  ],
 270 [ '𐐔𐐇𐐝𐐀𐐡𐐇𐐓', '𐐼𐐯𐑅𐐨𐑉𐐯𐐻', '𐐔𐐯𐑅𐐨𐑉𐐯𐐻', '𐐔𐐇𐐝𐐀𐐡𐐇𐐓', '𐐼𐐯𐑅𐐨𐑉𐐯𐐻', '𐐔𐐯𐑅𐐨𐑉𐐯𐐻', '𐐔𐐇𐐝𐐀𐐡𐐇𐐓', '𐐼𐐯𐑅𐐨𐑉𐐯𐐻', '𐐼𐐯𐑅𐐨𐑉𐐯𐐻', '𐐼𐐯𐑅𐐨𐑉𐐯𐐻',  ],
 271 [ 'henry ⅷ', 'henry ⅷ', 'Henry Ⅷ', 'HENRY Ⅷ', 'henry ⅷ', 'Henry Ⅷ', 'HENRY Ⅷ', 'henry ⅷ', 'henry ⅷ', 'henry ⅷ',  ],
 272 [ 'Henry Ⅷ', 'henry ⅷ', 'Henry Ⅷ', 'HENRY Ⅷ', 'henry ⅷ', 'Henry Ⅷ', 'HENRY Ⅷ', 'henry ⅷ', 'henry ⅷ', 'henry ⅷ',  ],
 273 [ 'HENRY Ⅷ', 'henry ⅷ', 'Henry Ⅷ', 'HENRY Ⅷ', 'henry ⅷ', 'Henry Ⅷ', 'HENRY Ⅷ', 'henry ⅷ', 'henry ⅷ', 'henry ⅷ',  ],
 274 [ '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 ⓚ',  ],
 275 [ '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 ⓚ',  ],
 276 [ '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 ⓚ',  ],
 277 [ 'istambul', 'istambul', 'Istambul', 'ISTAMBUL', 'istambul', 'Istambul', 'ISTAMBUL', 'istambul', 'istambul', 'istambul',  ],
 278 [ 'i̇stanbul', 'i̇stanbul', 'İstanbul', 'İSTANBUL', 'i̇stanbul', 'İstanbul', 'İSTANBUL', 'i̇stanbul', 'i̇stanbul', 'i̇stanbul',  ],
 279 [ 'İstanbul', 'i̇stanbul', 'İstanbul', 'İSTANBUL', 'i̇stanbul', 'İstanbul', 'İSTANBUL', 'i̇stanbul', 'ı̇stanbul', 'i̇stanbul',  ],
 280 [ 'İSTANBUL', 'istanbul', 'İstanbul', 'İSTANBUL', 'i̇stanbul', 'İstanbul', 'İSTANBUL', 'İstanbul', 'istanbul', 'i̇stanbul',  ],
 281 [ 'στιγμας', 'στιγμας', 'Στιγμας', 'ΣΤΙΓΜΑΣ', 'στιγμας', 'Στιγμας', 'ΣΤΙΓΜΑΣ', 'στιγμασ', 'στιγμασ', 'στιγμασ',  ],
 282 [ 'στιγμασ', 'στιγμασ', 'Στιγμασ', 'ΣΤΙΓΜΑΣ', 'στιγμασ', 'Στιγμασ', 'ΣΤΙΓΜΑΣ', 'στιγμασ', 'στιγμασ', 'στιγμασ',  ],
 283 [ 'ΣΤΙΓΜΑΣ', 'στιγμασ', 'Στιγμασ', 'ΣΤΙΓΜΑΣ', 'στιγμασ', 'Στιγμασ', 'ΣΤΙΓΜΑΣ', 'στιγμασ', 'στιγμασ', 'στιγμασ',  ],
 284 [ 'ʀᴀʀᴇ', 'ʀᴀʀᴇ', 'Ʀᴀʀᴇ', 'ƦᴀƦᴇ', 'ʀᴀʀᴇ', 'Ʀᴀʀᴇ', 'ƦᴀƦᴇ', 'ʀᴀʀᴇ', 'ʀᴀʀᴇ', 'ʀᴀʀᴇ',  ],
 285 [ 'Ʀᴀʀᴇ', 'ʀᴀʀᴇ', 'Ʀᴀʀᴇ', 'ƦᴀƦᴇ', 'ʀᴀʀᴇ', 'Ʀᴀʀᴇ', 'ƦᴀƦᴇ', 'ʀᴀʀᴇ', 'ʀᴀʀᴇ', 'ʀᴀʀᴇ',  ],
 286 [ 'ƦᴀƦᴇ', 'ʀᴀʀᴇ', 'Ʀᴀʀᴇ', 'ƦᴀƦᴇ', 'ʀᴀʀᴇ', 'Ʀᴀʀᴇ', 'ƦᴀƦᴇ', 'ʀᴀʀᴇ', 'ʀᴀʀᴇ', 'ʀᴀʀᴇ',  ],
 287 [ 'Ԧԧ', 'ԧԧ', 'Ԧԧ', 'ԦԦ', 'ԧԧ', 'Ԧԧ', 'ԦԦ', 'ԧԧ', 'ԧԧ', 'ԧԧ',  ],
 288 [ 'ԧԧ', 'ԧԧ', 'Ԧԧ', 'ԦԦ', 'ԧԧ', 'Ԧԧ', 'ԦԦ', 'ԧԧ', 'ԧԧ', 'ԧԧ',  ],
 289 [ 'Ԧԧ', 'ԧԧ', 'Ԧԧ', 'ԦԦ', 'ԧԧ', 'Ԧԧ', 'ԦԦ', 'ԧԧ', 'ԧԧ', 'ԧԧ',  ],
 290 [ 'ԦԦ', 'ԧԧ', 'Ԧԧ', 'ԦԦ', 'ԧԧ', 'Ԧԧ', 'ԦԦ', 'ԧԧ', 'ԧԧ', 'ԧԧ',  ],
 291 [ "þǽr rihtes", "þǽr rihtes", "Þǽr Rihtes", "ÞǼR RIHTES", "þǽr rihtes", "Þǽr Rihtes", "ÞǼR RIHTES", "þǽr rihtes", "þǽr rihtes", "þǽr rihtes",  ],
 292 [ "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",  ],
 293 [ "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",  ],
 294 [ "ﬁ", "ﬁ", "ﬁ", "ﬁ", "ﬁ", "Fi", "FI", "ﬁ", "fi", "fi",  ],
 295 [ "ﬁlesystem", "ﬁlesystem", "ﬁlesystem", "ﬁLESYSTEM", "ﬁlesystem", "Filesystem", "FILESYSTEM", "ﬁlesystem", "filesystem", "filesystem",  ],
 296 [ "eﬃcient", "eﬃcient", "Eﬃcient", "EﬃCIENT", "eﬃcient", "Eﬃcient", "EFFICIENT", "eﬃcient", "efficient", "efficient",  ],
 297 [ "ﬂ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",  ],
 298 [ "ǳ", "ǳ", "ǲ", "Ǳ", "ǳ", "ǲ", "Ǳ", "ǳ", "ǳ", "ǳ",  ],
 299 [ "ǳur mountain", "ǳur mountain", "ǲur Mountain", "ǱUR MOUNTAIN", "ǳur mountain", "ǲur Mountain", "ǱUR MOUNTAIN", "ǳur mountain", "ǳur mountain", "ǳur mountain",  ],
 300 [ "poſt", "poſt", "Poſt", "POST", "poſt", "Poſt", "POST", "post", "post", "post",  ],
 301 [ "poﬅ", "poﬅ", "Poﬅ", "POﬅ", "poﬅ", "Poﬅ", "POST", "poﬅ", "post", "post",  ],
 302 [ "ﬅop", "ﬅop", "ﬅop", "ﬅOP", "ﬅop", "Stop", "STOP", "ﬅop", "stop", "stop",  ],
 303 [ "tschüß", "tschüß", "Tschüß", "TSCHÜß", "tschüß", "Tschüß", "TSCHÜSS", "tschüß", "tschüss", "tschüss",  ],
 304 [ "TSCHÜẞ", "tschüß", "Tschüß", "TSCHÜẞ", "tschüß", "Tschüß", "TSCHÜẞ", "tschüß", "tschüss", "tschüss",  ],
 305 [ "rußland", "rußland", "Rußland", "RUßLAND", "rußland", "Rußland", "RUSSLAND", "rußland", "russland", "russland",  ],
 306 [ "RUẞLAND", "rußland", "Rußland", "RUẞLAND", "rußland", "Rußland", "RUẞLAND", "rußland", "russland", "russland",  ],
 307 [ "weiß", "weiß", "Weiß", "WEIß", "weiß", "Weiß", "WEISS", "weiß", "weiss", "weiss",  ],
 308 [ "WEIẞ", "weiß", "Weiß", "WEIẞ", "weiß", "Weiß", "WEIẞ", "weiß", "weıss", "weiss",  ],
 309 [ "ẞIEW", "ßiew", "ẞiew", "ẞIEW", "ßiew", "ẞiew", "ẞIEW", "ßiew", "ssıew", "ssiew",  ],
 310 [ "ͅ", "ͅ", "Ι", "Ι", "ͅ", "Ι", "Ι", "ι", "ι", "ι",  ],
 311 [ "ᾲ", "ᾲ", "Ὰͅ", "ᾺΙ", "ᾲ", "Ὰͅ", "ᾺΙ", "ὰι", "ὰι", "ὰι",  ],
 312 [ "Ὰι", "ὰι", "Ὰι", "ᾺΙ", "ὰι", "Ὰι", "ᾺΙ", "ὰι", "ὰι", "ὰι",  ],
 313 [ "ᾺΙ", "ὰι", "Ὰι", "ᾺΙ", "ὰι", "Ὰι", "ᾺΙ", "ὰι", "ὰι", "ὰι",  ],
 314 [ "ᾲ", "ᾲ", "ᾲ", "ᾲ", "ᾲ", "Ὰͅ", "ᾺΙ", "ᾲ", "ὰι", "ὰι",  ],
 315 [ "Ὰͅ", "ᾲ", "Ὰͅ", "ᾺΙ", "ᾲ", "Ὰͅ", "ᾺΙ", "ὰι", "ὰι", "ὰι",  ],
 316 [ "ᾺΙ", "ὰι", "Ὰι", "ᾺΙ", "ὰι", "Ὰι", "ᾺΙ", "ὰι", "ὰι", "ὰι",  ],
 317 [ "ᾲ στο διάολο", "ᾲ στο διάολο", "ᾲ Στο Διάολο", "ᾲ ΣΤΟ ΔΙΆΟΛΟ", "ᾲ στο διάολο", "Ὰͅ Στο Διάολο", "ᾺΙ ΣΤΟ ΔΙΆΟΛΟ", "ᾲ στο διάολο", "ὰι στο διάολο", "ὰι στο διάολο",  ],
 318 [ "ᾲ στο διάολο", "ᾲ στο διάολο", "Ὰͅ Στο Διάολο", "ᾺΙ ΣΤΟ ΔΙΆΟΛΟ", "ᾲ στο διάολο", "Ὰͅ Στο Διάολο", "ᾺΙ ΣΤΟ ΔΙΆΟΛΟ", "ὰι στο διάολο", "ὰι στο διάολο", "ὰι στο διάολο",  ],
 319 [ "ⅷ", "ⅷ", "Ⅷ", "Ⅷ", "ⅷ", "Ⅷ", "Ⅷ", "ⅷ", "ⅷ", "ⅷ",  ],
 320 [ "henry ⅷ", "henry ⅷ", "Henry Ⅷ", "HENRY Ⅷ", "henry ⅷ", "Henry Ⅷ", "HENRY Ⅷ", "henry ⅷ", "henry ⅷ", "henry ⅷ",  ],
 321 [ "ⓚ", "ⓚ", "Ⓚ", "Ⓚ", "ⓚ", "Ⓚ", "Ⓚ", "ⓚ", "ⓚ", "ⓚ",  ],
 322 [ "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 ⓚ",  ],
 323 [ "istambul", "istambul", "Istambul", "ISTAMBUL", "istambul", "Istambul", "ISTAMBUL", "istambul", "istambul", "istambul",  ],
 324 [ "i̇stanbul", "i̇stanbul", "İstanbul", "İSTANBUL", "i̇stanbul", "İstanbul", "İSTANBUL", "i̇stanbul", "i̇stanbul", "i̇stanbul",  ],
 325 [ "İstanbul", "i̇stanbul", "İstanbul", "İSTANBUL", "i̇stanbul", "İstanbul", "İSTANBUL", "i̇stanbul", "ı̇stanbul", "i̇stanbul",  ],
 326 [ "İSTANBUL", "istanbul", "İstanbul", "İSTANBUL", "i̇stanbul", "İstanbul", "İSTANBUL", "İstanbul", "istanbul", "i̇stanbul",  ],
 327 [ "στιγμας", "στιγμας", "Στιγμας", "ΣΤΙΓΜΑΣ", "στιγμας", "Στιγμας", "ΣΤΙΓΜΑΣ", "στιγμασ", "στιγμασ", "στιγμασ",  ],
 328 [ "στιγμασ", "στιγμασ", "Στιγμασ", "ΣΤΙΓΜΑΣ", "στιγμασ", "Στιγμασ", "ΣΤΙΓΜΑΣ", "στιγμασ", "στιγμασ", "στιγμασ",  ],
 329 [ "ΣΤΙΓΜΑΣ", "στιγμασ", "Στιγμασ", "ΣΤΙΓΜΑΣ", "στιγμασ", "Στιγμασ", "ΣΤΙΓΜΑΣ", "στιγμασ", "στιγμασ", "στιγμασ",  ],
 330 [ "ʀᴀʀᴇ", "ʀᴀʀᴇ", "Ʀᴀʀᴇ", "ƦᴀƦᴇ", "ʀᴀʀᴇ", "Ʀᴀʀᴇ", "ƦᴀƦᴇ", "ʀᴀʀᴇ", "ʀᴀʀᴇ", "ʀᴀʀᴇ",  ],
 331 [ "𐐼𐐯𐑅𐐨𐑉𐐯𐐻", "𐐼𐐯𐑅𐐨𐑉𐐯𐐻", "𐐔𐐯𐑅𐐨𐑉𐐯𐐻", "𐐔𐐇𐐝𐐀𐐡𐐇𐐓", "𐐼𐐯𐑅𐐨𐑉𐐯𐐻", "𐐔𐐯𐑅𐐨𐑉𐐯𐐻", "𐐔𐐇𐐝𐐀𐐡𐐇𐐓", "𐐼𐐯𐑅𐐨𐑉𐐯𐐻", "𐐼𐐯𐑅𐐨𐑉𐐯𐐻", "𐐼𐐯𐑅𐐨𐑉𐐯𐐻",  ],
 332 [ "Ԧԧ", "ԧԧ", "Ԧԧ", "ԦԦ", "ԧԧ", "Ԧԧ", "ԦԦ", "ԧԧ", "ԧԧ", "ԧԧ",  ],
 333 [ "ﬓﬔﬕﬖﬗ", "ﬓﬔﬕﬖﬗ", "ﬓﬔﬕﬖﬗ", "ﬓﬔﬕﬖﬗ", "ﬓﬔﬕﬖﬗ", "Մնﬔﬕﬖﬗ", "ՄՆՄԵՄԻՎՆՄԽ", "ﬓﬔﬕﬖﬗ", "մնմեմիվնմխ", "մնմեմիվնմխ",  ],
 334 [ "ŉ groot", "ŉ groot", "ŉ Groot", "ŉ GROOT", "ŉ groot", "ʼN Groot", "ʼN GROOT", "ŉ groot", "ʼn groot", "ʼn groot",  ],
 335 [ "ẚ", "ẚ", "ẚ", "ẚ", "ẚ", "Aʾ", "Aʾ", "ẚ", "aʾ", "aʾ",  ],
 336 [ "ﬀ", "ﬀ", "ﬀ", "ﬀ", "ﬀ", "Ff", "FF", "ﬀ", "ff", "ff",  ],
 337 [ "ǰ", "ǰ", "ǰ", "ǰ", "ǰ", "J̌", "J̌", "ǰ", "ǰ", "ǰ",  ],
 338 [ "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 å",  ],
 339 );
 340
 341     use feature qw(fc);
 342
 343     for (@test_table) {
 344         my ($simple_lc, $simple_tc, $simple_uc, $simple_fc) = @{$_}[1, 2, 3, 7];
 345         my ($orig, $lower, $titlecase, $upper, $fc_turkic, $fc_full) = @{$_}[0,4,5,6,8,9];
 346
 347         if ($orig =~ /(\P{Assigned})/) {   # So can fail gracefully in earlier
 348                                            # Unicode versions
 349             fail(sprintf "because U+%04X is unassigned", ord($1));
 350             next;
 351         }
 352         is( fc($orig), $fc_full, "fc('$orig') returns '$fc_full'" );
 353         is( "\F$orig", $fc_full, '\F works' );
 354         is( lc($orig), $lower,   "lc('$orig') returns '$lower'" );
 355         is( "\L$orig", $lower,   '\L works' );
 356         is( uc($orig), $upper,   "uc('$orig') returns '$upper'" );
 357         is( "\U$orig", $upper,   '\U works' );
 358     }
 359 }
 360
 361 {
 362     use feature qw(fc);
 363     package Eeyup  { use overload q{""} => sub { main::uni_to_native("\x{df}")   }, fallback => 1 }
 364     package Uunope { use overload q{""} => sub { "\x{30cb}" }, fallback => 1 }
 365     package Undef  { use overload q{""} => sub {   undef    }, fallback => 1 }
 366
 367     my $obj = bless {}, "Eeyup";
 368     is(fc($obj), "ss", "fc() works on overloaded objects returning latin-1");
 369     $obj = bless {}, "Eeyup";
 370     is("\F$obj", "ss", '\F works on overloaded objects returning latin-1');
 371
 372     $obj = bless {}, "Uunope";
 373     is(fc($obj), "\x{30cb}", "fc() works on overloaded objects returning UTF-8");
 374     $obj = bless {}, "Uunope";
 375     is("\F$obj", "\x{30cb}", '\F works on overloaded objects returning UTF-8');
 376
 377     $obj = bless {}, "Undef";
 378     my $warnings;
 379     {
 380         no warnings;
 381         use warnings "uninitialized";
 382         local $SIG{__WARN__} = sub { $warnings++; like(shift, qr/Use of uninitialized value (?:\$obj )?in fc/) };
 383         fc(undef);
 384         fc($obj);
 385     }
 386     is( $warnings, 2, "correct number of warnings" );
 387
 388     my $fetched = 0;
 389     package Derpy { sub TIESCALAR { bless {}, shift } sub FETCH { $fetched++; main::uni_to_native("\x{df}") } }
 390
 391     tie my $x, "Derpy";
 392
 393     is( fc($x), "ss", "fc() works on tied values" );
 394     is( $fetched, 1, "and only calls the magic once" );
 395
 396 }
 397
 398 {
 399     use feature qw( fc );
 400     my $troublesome1 = uni_to_native("\xdf") x 11; #SvLEN should be 12, SvCUR should be 11
 401                                     #So this should force fc() to grow the string.
 402
 403     is( fc($troublesome1), "ss" x 11, "fc() grows the string" );
 404
 405     my $troublesome2 = "abcdef:" . uni_to_native("\x{df}")
 406                      . ":fjksjs"; #SvLEN should be 16, SvCUR should be 15
 407     is( fc($troublesome2), "abcdef:ss:fjksjs", "fc() expands \\x{DF} in the middle of a string that needs to grow" );
 408
 409     my $troublesome3 = ":" . uni_to_native("\x{df}") . ":";
 410     is( fc($troublesome3), ":ss:", "fc() expands \\x{DF} in the middle of a string" );
 411
 412
 413     my $troublesome4 = uni_to_native("\x{B5}"); #\N{MICRON SIGN} is latin-1, but its foldcase is in UTF-8
 414
 415     is( fc($troublesome4), "\x{3BC}", "fc() for a latin-1 \x{B5} returns UTF-8" );
 416     ok( !utf8::is_utf8($troublesome4), "fc() doesn't upgrade the original string" );
 417
 418
 419     my $troublesome5 = uni_to_native("\x{C9}") . "abda"
 420                      . uni_to_native("\x{B5}") . "aaf"
 421                      . uni_to_native("\x{C8}");  # Up until foldcasing \x{B5}, the string
 422                                                     # was in Latin-1. This tests that the
 423                                                     # results don't have illegal UTF-8
 424                                                     # (i.e. leftover latin-1) in them
 425
 426     is( fc($troublesome5), uni_to_native("\x{E9}") . "abda\x{3BC}aaf"
 427                          . uni_to_native("\x{E8}") );
 428 }
 429
 430
 431 SKIP: {
 432     use feature qw( fc unicode_strings );
 433
 434     skip "locales not available", 256 unless locales_enabled('LC_ALL');
 435
 436     setlocale(&POSIX::LC_ALL, "C");
 437
 438     # This tests both code paths in pp_fc
 439
 440     for (0..0xff) {
 441         my $latin1 = chr;
 442         my $utf8   = $latin1;
 443         utf8::downgrade($latin1); #No-op, but doesn't hurt
 444         utf8::upgrade($utf8);
 445         is(fc($latin1), fc($utf8), "fc() gives the same results for \\x{$_} in Latin-1 and UTF-8 under unicode_strings");
 446         SKIP: {
 447             skip 'Locales not available', 2 unless locales_enabled('LC_CTYPE');
 448             use locale;
 449             is(fc($latin1), lc($latin1), "use locale; fc(qq{\\x{$_}}), lc(qq{\\x{$_}}) when qq{\\x{$_}} is in latin-1");
 450             is(fc($utf8), lc($utf8), "use locale; fc(qq{\\x{$_}}), lc(qq{\\x{$_}}) when qq{\\x{$_}} is in latin-1");
 451         }
 452         {
 453             no feature 'unicode_strings';
 454             is(fc($latin1), lc($latin1), "under nothing, fc() for <256 is the same as lc");
 455         }
 456     }
 457 }
 458
 459 my $utf8_locale = find_utf8_ctype_locale();
 460
 461 {
 462     use feature qw( fc );
 463     use locale;
 464     no warnings 'locale';   # Would otherwise warn
 465     is(fc("\x{1E9E}"), fc("\x{17F}\x{17F}"), 'fc("\x{1E9E}") eq fc("\x{17F}\x{17F}")');
 466     use warnings 'locale';
 467     SKIP: {
 468         skip 'Can\'t find a UTF-8 locale', 1 unless defined $utf8_locale;
 469         setlocale(&LC_CTYPE, $utf8_locale);
 470         is(fc("\x{1E9E}"), "ss", 'fc("\x{1E9E}") eq "ss" in a UTF-8 locale)');
 471     }
 472 }
 473
 474 SKIP: {
 475     skip 'Can\'t find a UTF-8 locale', 256 unless defined $utf8_locale;
 476
 477     use feature qw( fc unicode_strings );
 478
 479     # Get the official fc values outside locale.
 480     no locale;
 481     my @unicode_fc;
 482     for (0..0xff) {
 483         push @unicode_fc, fc(chr);
 484     }
 485
 486     # These should match the UTF-8 locale values
 487     setlocale(&LC_CTYPE, $utf8_locale);
 488     use locale;
 489     for (0..0xff) {
 490         is(fc(chr), $unicode_fc[$_], "In a UTF-8 locale, fc(chr $_) is the same as official Unicode");
 491     }
 492 }
 493
 494
 495 my $num_tests = curr_test() - 1;
 496
 497 plan($num_tests);