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ıϐßﬃ񟿿"), "abi̇iıβssffi񟿿" );
 171     is( "\FaBİIıϐßﬃ񟿿", "abi̇iıβssffi񟿿" );
 172 #    TODO: {
 173 #        local $::TODO = "turkic special cases";
 174 #        is( fc "aBİIıϐßﬃ񟿿", "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 [ 'ĳ', 'ĳ', 'Ĳ', 'Ĳ', 'ĳ', 'Ĳ', 'Ĳ', 'ĳ', 'ĳ', 'ĳ',  ],
 234 [ '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',  ],
 235 [ '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',  ],
 236 [ 'eﬃcient', 'eﬃcient', 'Eﬃcient', 'EﬃCIENT', 'eﬃcient', 'Eﬃcient', 'EFFICIENT', 'eﬃcient', 'efficient', 'efficient',  ],
 237 [ 'ﬂour', 'ﬂour', 'ﬂour', 'ﬂOUR', 'ﬂour', 'Flour', 'FLOUR', 'ﬂour', 'flour', 'flour',  ],
 238 [ 'ﬂ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',  ],
 239 [ 'ǳur', 'ǳur', 'ǲur', 'ǱUR', 'ǳur', 'ǲur', 'ǱUR', 'ǳur', 'ǳur', 'ǳur',  ],
 240 [ 'ǲur', 'ǳur', 'ǲur', 'ǱUR', 'ǳur', 'ǲur', 'ǱUR', 'ǳur', 'ǳur', 'ǳur',  ],
 241 [ 'ǱUR', 'ǳur', 'ǲur', 'ǱUR', 'ǳur', 'ǲur', 'ǱUR', 'ǳur', 'ǳur', 'ǳur',  ],
 242 [ 'ǳur mountain', 'ǳur mountain', 'ǲur Mountain', 'ǱUR MOUNTAIN', 'ǳur mountain', 'ǲur Mountain', 'ǱUR MOUNTAIN', 'ǳur mountain', 'ǳur mountain', 'ǳur mountain',  ],
 243 [ 'ǲur Mountain', 'ǳur mountain', 'ǲur Mountain', 'ǱUR MOUNTAIN', 'ǳur mountain', 'ǲur Mountain', 'ǱUR MOUNTAIN', 'ǳur mountain', 'ǳur mountain', 'ǳur mountain',  ],
 244 [ 'ǱUR MOUNTAIN', 'ǳur mountain', 'ǲur Mountain', 'ǱUR MOUNTAIN', 'ǳur mountain', 'ǲur Mountain', 'ǱUR MOUNTAIN', 'ǳur mountain', 'ǳur mountaın', 'ǳur mountain',  ],
 245 [ 'poſt', 'poſt', 'Poſt', 'POST', 'poſt', 'Poſt', 'POST', 'post', 'post', 'post',  ],
 246 [ 'poﬅ', 'poﬅ', 'Poﬅ', 'POﬅ', 'poﬅ', 'Poﬅ', 'POST', 'poﬅ', 'post', 'post',  ],
 247 [ 'ﬅop', 'ﬅop', 'ﬅop', 'ﬅOP', 'ﬅop', 'Stop', 'STOP', 'ﬅop', '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', 'İstanbul', 'İSTANBUL', 'i̇stanbul', 'İstanbul', 'İSTANBUL', 'i̇stanbul', 'i̇stanbul', 'i̇stanbul',  ],
 272 [ 'İstanbul', 'i̇stanbul', 'İstanbul', 'İSTANBUL', 'i̇stanbul', 'İstanbul', 'İ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 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",  ],
 287 [ "ﬁ", "ﬁ", "ﬁ", "ﬁ", "ﬁ", "Fi", "FI", "ﬁ", "fi", "fi",  ],
 288 [ "ﬁlesystem", "ﬁlesystem", "ﬁlesystem", "ﬁLESYSTEM", "ﬁlesystem", "Filesystem", "FILESYSTEM", "ﬁlesystem", "filesystem", "filesystem",  ],
 289 [ "eﬃcient", "eﬃcient", "Eﬃcient", "EﬃCIENT", "eﬃcient", "Eﬃcient", "EFFICIENT", "eﬃcient", "efficient", "efficient",  ],
 290 [ "ﬂ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",  ],
 291 [ "ǳ", "ǳ", "ǲ", "Ǳ", "ǳ", "ǲ", "Ǳ", "ǳ", "ǳ", "ǳ",  ],
 292 [ "ǳur mountain", "ǳur mountain", "ǲur Mountain", "ǱUR MOUNTAIN", "ǳur mountain", "ǲur Mountain", "ǱUR MOUNTAIN", "ǳur mountain", "ǳur mountain", "ǳur mountain",  ],
 293 [ "poſt", "poſt", "Poſt", "POST", "poſt", "Poſt", "POST", "post", "post", "post",  ],
 294 [ "poﬅ", "poﬅ", "Poﬅ", "POﬅ", "poﬅ", "Poﬅ", "POST", "poﬅ", "post", "post",  ],
 295 [ "ﬅop", "ﬅop", "ﬅop", "ﬅOP", "ﬅop", "Stop", "STOP", "ﬅop", "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", "İstanbul", "İSTANBUL", "i̇stanbul", "İstanbul", "İSTANBUL", "i̇stanbul", "i̇stanbul", "i̇stanbul",  ],
 318 [ "İstanbul", "i̇stanbul", "İstanbul", "İSTANBUL", "i̇stanbul", "İstanbul", "İ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 [ "ŉ groot", "ŉ groot", "ŉ Groot", "ŉ GROOT", "ŉ groot", "ʼN Groot", "ʼN GROOT", "ŉ groot", "ʼn groot", "ʼn groot",  ],
 328 [ "ẚ", "ẚ", "ẚ", "ẚ", "ẚ", "Aʾ", "Aʾ", "ẚ", "aʾ", "aʾ",  ],
 329 [ "ﬀ", "ﬀ", "ﬀ", "ﬀ", "ﬀ", "Ff", "FF", "ﬀ", "ff", "ff",  ],
 330 [ "ǰ", "ǰ", "ǰ", "ǰ", "ǰ", "J̌", "J̌", "ǰ", "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);