diff options
author | Karl Williamson <public@khwilliamson.com> | 2011-01-31 22:40:24 -0700 |
---|---|---|
committer | Karl Williamson <public@khwilliamson.com> | 2011-02-02 16:31:21 -0700 |
commit | 4ff124d1950fcd3422a53601f54b293c3e28e700 (patch) | |
tree | 7690791dd55361ffa3701a202e8e28b0296466e9 | |
parent | a5c376b78a9b42912acccf456a320266fa90eeff (diff) | |
download | perl-4ff124d1950fcd3422a53601f54b293c3e28e700.tar.gz |
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.
-rw-r--r-- | lib/utf8_heavy.pl | 16 |
1 files changed, 13 insertions, 3 deletions
diff --git a/lib/utf8_heavy.pl b/lib/utf8_heavy.pl index e271ba3a73..6bf897515c 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; } |