summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorKarl Williamson <public@khwilliamson.com>2011-01-31 22:40:24 -0700
committerKarl Williamson <public@khwilliamson.com>2011-02-02 16:31:21 -0700
commit4ff124d1950fcd3422a53601f54b293c3e28e700 (patch)
tree7690791dd55361ffa3701a202e8e28b0296466e9
parenta5c376b78a9b42912acccf456a320266fa90eeff (diff)
downloadperl-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.pl16
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;
}