This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
utf8_heavy: Use new mktables caseless feature
authorKarl Williamson <public@khwilliamson.com>
Tue, 1 Feb 2011 05:40:24 +0000 (22:40 -0700)
committerKarl Williamson <public@khwilliamson.com>
Wed, 2 Feb 2011 23:31:21 +0000 (16:31 -0700)
This patch causes utf8_heavy.pl to know about the new data structure that
mktables now generates to indicate what substitute table to use for one that
has different results under /i matching.

Note that regcomp.c, as of this commit, does not generate the names that would
exercise this code.

lib/utf8_heavy.pl

index e271ba3..6bf8975 100644 (file)
@@ -89,7 +89,11 @@ sub croak { require Carp; Carp::croak(@_) }
             $type =~ s/^\s+//;
             $type =~ s/\s+$//;
 
             $type =~ s/^\s+//;
             $type =~ s/\s+$//;
 
-            print STDERR __LINE__, ": type = $type\n" if DEBUG;
+            # regcomp.c surrounds the property name with '__" and '_i' if this
+            # is to be caseless matching.
+            my $caseless = $type =~ s/^__(.*)_i$/$1/;
+
+            print STDERR __LINE__, ": type=$type, caseless=$caseless\n" if DEBUG;
 
         GETFILE:
             {
 
         GETFILE:
             {
@@ -105,7 +109,7 @@ sub croak { require Carp; Carp::croak(@_) }
                     if (exists &{$prop}) {
                         no strict 'refs';
                         
                     if (exists &{$prop}) {
                         no strict 'refs';
                         
-                        $list = &{$prop};
+                        $list = &{$prop}($caseless);
                         last GETFILE;
                     }
                 }
                         last GETFILE;
                     }
                 }
@@ -130,7 +134,7 @@ sub croak { require Carp; Carp::croak(@_) }
                 }
                 BEGIN { delete $utf8::{miniperl} }
 
                 }
                 BEGIN { delete $utf8::{miniperl} }
 
-                # Everything is caseless matching
+                # All property names are matched caselessly
                 my $property_and_table = lc $type;
                 print STDERR __LINE__, ": $property_and_table\n" if DEBUG;
 
                 my $property_and_table = lc $type;
                 print STDERR __LINE__, ": $property_and_table\n" if DEBUG;
 
@@ -359,6 +363,12 @@ sub croak { require Carp; Carp::croak(@_) }
                     if ($utf8::why_deprecated{$file}) {
                         warnings::warnif('deprecated', "Use of '$type' in \\p{} or \\P{} is deprecated because: $utf8::why_deprecated{$file};");
                     }
                     if ($utf8::why_deprecated{$file}) {
                         warnings::warnif('deprecated', "Use of '$type' in \\p{} or \\P{} is deprecated because: $utf8::why_deprecated{$file};");
                     }
+
+                    if ($caseless
+                        && exists $utf8::caseless_equivalent{$property_and_table})
+                    {
+                        $file = $utf8::caseless_equivalent{$property_and_table};
+                    }
                     $file= "$unicore_dir/lib/$file.pl";
                     last GETFILE;
                 }
                     $file= "$unicore_dir/lib/$file.pl";
                     last GETFILE;
                 }