1use strict; 2use 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 7BEGIN { 8 chdir 't' if -d 't'; 9 @INC = '../lib'; 10 require Config; import Config; 11 require './test.pl'; 12} 13 14use feature 'unicode_strings'; 15use Unicode::UCD qw(all_casefolds); 16 17binmode *STDOUT, ":utf8"; 18 19our $TODO; 20 21 22plan("no_plan"); 23# Read in the official case folding definitions. 24my $casefolds = all_casefolds(); 25my @folds; 26my @CF; 27my @simple_folds; 28my %reverse_fold; 29use Unicode::UCD; 30use charnames(); 31 32foreach 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 52foreach 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 65foreach 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}) || $Config::Config{ccflags} =~ /\bD?NO_LOCALE(_|\b)/; 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 SKIP: { 441 if ( 442 !$Config::Config{d_setlocale} 443 || $Config::Config{ccflags} =~ /\bD?NO_LOCALE(_|\b)/ 444 ) { 445 skip "no locale support", 2 446 } 447 no feature 'unicode_strings'; 448 is(fc($latin1), lc($latin1), "under nothing, fc() for <256 is the same as lc"); 449 } 450 } 451} 452 453my $num_tests = curr_test() - 1; 454 455plan($num_tests); 456