From: Karl Williamson <public@khwilliamson.com>
Date: Tue, 1 Feb 2011 05:40:24 +0000 (-0700)
Subject: utf8_heavy: Use new mktables caseless feature
X-Git-Tag: v5.13.10~423
X-Git-Url: https://perl5.git.perl.org/perl5.git/commitdiff_plain/4ff124d1950fcd3422a53601f54b293c3e28e700?ds=inline

utf8_heavy: Use new mktables caseless feature

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.
---

diff --git a/lib/utf8_heavy.pl b/lib/utf8_heavy.pl
index e271ba3..6bf8975 100644
--- a/lib/utf8_heavy.pl
+++ b/lib/utf8_heavy.pl
@@ -89,7 +89,11 @@ sub croak { require Carp; Carp::croak(@_) }
             $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:
             {
@@ -105,7 +109,7 @@ sub croak { require Carp; Carp::croak(@_) }
                     if (exists &{$prop}) {
                         no strict 'refs';
                         
-                        $list = &{$prop};
+                        $list = &{$prop}($caseless);
                         last GETFILE;
                     }
                 }
@@ -130,7 +134,7 @@ sub croak { require Carp; Carp::croak(@_) }
                 }
                 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;
 
@@ -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 ($caseless
+                        && exists $utf8::caseless_equivalent{$property_and_table})
+                    {
+                        $file = $utf8::caseless_equivalent{$property_and_table};
+                    }
                     $file= "$unicore_dir/lib/$file.pl";
                     last GETFILE;
                 }