This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
uni/fold.t: Use Unicode::UCD::casefolds() for inputs
authorKarl Williamson <public@khwilliamson.com>
Wed, 28 Mar 2012 14:00:10 +0000 (08:00 -0600)
committerKarl Williamson <public@khwilliamson.com>
Sat, 2 Jun 2012 14:29:16 +0000 (08:29 -0600)
This allows this .t to work on early Unicodes.

t/uni/fold.t

index 3dde704..483a43d 100644 (file)
@@ -11,46 +11,43 @@ BEGIN {
 }
 
 use feature 'unicode_strings';
+use Unicode::UCD qw(all_casefolds);
 
 binmode *STDOUT, ":utf8";
 
 our $TODO;
 
+
 plan("no_plan");
 # Read in the official case folding definitions.
-my $CF = '../lib/unicore/CaseFolding.txt';
-
-die qq[$0: failed to open "$CF": $!\n] if ! open(my $fh, "<", $CF);
-
+my $casefolds = all_casefolds();
+my @folds;
 my @CF;
 my @simple_folds;
 my %reverse_fold;
-while (<$fh>) {
-    # We only use 'S' in simple folded fc(), since the regex engine uses
-    # 'F'ull case folding.  I is obsolete starting with Unicode 3.2, but
-    # leaving it in does no harm, and allows backward compatibility
-    next unless my ($code, $type, $mapping, $name) = $_ =~
-            /^([0-9A-F]+); ([CFIS]); ((?:[0-9A-F]+)(?: [0-9A-F]+)*); \# (.+)/;
-
-    # Convert any 0-255 range chars to native.
-    $code = sprintf("%04X", ord_latin1_to_native(hex $code)) if hex $code < 0x100;
-    $mapping = join " ", map { $_ =
-                                sprintf("%04X", ord_latin1_to_native(hex $_)) }
-                                                            split / /, $mapping;
-
-    if ( $type eq "S" ) {
-        push @simple_folds, [$code, $mapping, $type, $name];
-        next;
+use Unicode::UCD;
+use charnames();
+
+foreach my $decimal_code_point (sort { $a <=> $b } keys %$casefolds) {
+    # We only use simple folds in fc(), since the regex engine uses full case
+    # folding.
+
+    my $name = charnames::viacode($decimal_code_point);
+    my $type = $casefolds->{$decimal_code_point}{'status'};
+    my $code = $casefolds->{$decimal_code_point}{'code'};
+    my $simple = $casefolds->{$decimal_code_point}{'simple'};
+    my $full = $casefolds->{$decimal_code_point}{'full'};
+
+    if ($simple && $simple ne $full) { # If there is a distinction
+        push @simple_folds, [ $code, $simple, $type, $name ];
     }
 
-    push @CF, [$code, $mapping, $type, $name];
+    push @CF, [ $code, $full, $type, $name ];
 
     # Get the inverse fold for single-char mappings.
-    $reverse_fold{pack "U0U*", hex $mapping} = pack "U0U*", hex $code if $type ne 'F';
+    $reverse_fold{pack "U0U*", hex $simple} = pack "U0U*", $decimal_code_point if $simple;
 }
 
-close($fh) or die "$0 Couldn't close $CF";
-
 foreach my $test_ref ( @simple_folds ) {
     use feature 'fc';
     my ($code, $mapping, $type, $name) = @$test_ref;
@@ -438,6 +435,4 @@ foreach my $test_ref (@CF) {
 
 my $num_tests = curr_test() - 1;
 
-die qq[$0: failed to find casefoldings from "$CF"\n] unless $num_tests > 0;
-
 plan($num_tests);