From 6f9b16a7d2fe9614c783e2d5785df2cd8d7921a0 Mon Sep 17 00:00:00 2001 From: Nicholas Clark Date: Mon, 7 Nov 2005 13:22:35 +0000 Subject: Fix bug #37628 (both lcfirst and ucfirst) p4raw-id: //depot/perl@26034 --- t/uni/case.pl | 136 ++++++++++++++++++++++++++++++---------------------------- t/uni/lower.t | 5 ++- t/uni/title.t | 4 +- t/uni/upper.t | 4 +- 4 files changed, 78 insertions(+), 71 deletions(-) (limited to 't/uni') diff --git a/t/uni/case.pl b/t/uni/case.pl index 43fc84b6ea..f12e482419 100644 --- a/t/uni/case.pl +++ b/t/uni/case.pl @@ -7,7 +7,7 @@ sub unidump { } sub casetest { - my ($base, $spec, $func) = @_; + my ($base, $spec, @funcs) = @_; my $file = File::Spec->catfile(File::Spec->catdir(File::Spec->updir, "lib", "unicore", "To"), "$base.pl"); @@ -45,9 +45,9 @@ sub casetest { print "# ", scalar keys %none, " noncase mappings\n"; my $tests = - (scalar keys %simple) + - (scalar keys %$spec) + - (scalar keys %none); + ((scalar keys %simple) + + (scalar keys %$spec) + + (scalar keys %none)) * @funcs; print "1..$tests\n"; my $test = 1; @@ -55,11 +55,13 @@ sub casetest { for my $i (sort keys %simple) { my $w = $simple{$i}; my $c = pack "U0U", hex $i; - my $d = $func->($c); - my $e = unidump($d); - print $d eq pack("U0U", hex $simple{$i}) ? - "ok $test # $i -> $w\n" : "not ok $test # $i -> $e ($w)\n"; - $test++; + foreach my $func (@funcs) { + my $d = $func->($c); + my $e = unidump($d); + print $d eq pack("U0U", hex $simple{$i}) ? + "ok $test # $i -> $w\n" : "not ok $test # $i -> $e ($w)\n"; + $test++; + } } for my $i (sort keys %$spec) { @@ -67,69 +69,73 @@ sub casetest { my $u = unpack "C0U", $i; my $h = sprintf "%04X", $u; my $c = chr($u); $c .= chr(0x100); chop $c; - my $d = $func->($c); - my $e = unidump($d); - if (ord "A" == 193) { # EBCDIC - # We need to a little bit of remapping. - # - # For example, in titlecase (ucfirst) mapping - # of U+0149 the Unicode mapping is U+02BC U+004E. - # The 4E is N, which in EBCDIC is 2B-- - # and the ucfirst() does that right. - # The problem is that our reference - # data is in Unicode code points. - # - # The Right Way here would be to use, say, - # Encode, to remap the less-than 0x100 code points, - # but let's try to be Encode-independent here. - # - # These are the titlecase exceptions: - # - # Unicode Unicode+EBCDIC - # - # 0149 -> 02BC 004E (02BC 002B) - # 01F0 -> 004A 030C (00A2 030C) - # 1E96 -> 0048 0331 (00E7 0331) - # 1E97 -> 0054 0308 (00E8 0308) - # 1E98 -> 0057 030A (00EF 030A) - # 1E99 -> 0059 030A (00DF 030A) - # 1E9A -> 0041 02BE (00A0 02BE) - # - # The uppercase exceptions are identical. - # - # The lowercase has one more: - # - # Unicode Unicode+EBCDIC - # - # 0130 -> 0069 0307 (00D1 0307) - # - if ($i =~ /^(0130|0149|01F0|1E96|1E97|1E98|1E99|1E9A)$/) { - $e =~ s/004E/002B/; # N - $e =~ s/004A/00A2/; # J - $e =~ s/0048/00E7/; # H - $e =~ s/0054/00E8/; # T - $e =~ s/0057/00EF/; # W - $e =~ s/0059/00DF/; # Y - $e =~ s/0041/00A0/; # A - $e =~ s/0069/00D1/; # i + foreach my $func (@funcs) { + my $d = $func->($c); + my $e = unidump($d); + if (ord "A" == 193) { # EBCDIC + # We need to a little bit of remapping. + # + # For example, in titlecase (ucfirst) mapping + # of U+0149 the Unicode mapping is U+02BC U+004E. + # The 4E is N, which in EBCDIC is 2B-- + # and the ucfirst() does that right. + # The problem is that our reference + # data is in Unicode code points. + # + # The Right Way here would be to use, say, + # Encode, to remap the less-than 0x100 code points, + # but let's try to be Encode-independent here. + # + # These are the titlecase exceptions: + # + # Unicode Unicode+EBCDIC + # + # 0149 -> 02BC 004E (02BC 002B) + # 01F0 -> 004A 030C (00A2 030C) + # 1E96 -> 0048 0331 (00E7 0331) + # 1E97 -> 0054 0308 (00E8 0308) + # 1E98 -> 0057 030A (00EF 030A) + # 1E99 -> 0059 030A (00DF 030A) + # 1E9A -> 0041 02BE (00A0 02BE) + # + # The uppercase exceptions are identical. + # + # The lowercase has one more: + # + # Unicode Unicode+EBCDIC + # + # 0130 -> 0069 0307 (00D1 0307) + # + if ($i =~ /^(0130|0149|01F0|1E96|1E97|1E98|1E99|1E9A)$/) { + $e =~ s/004E/002B/; # N + $e =~ s/004A/00A2/; # J + $e =~ s/0048/00E7/; # H + $e =~ s/0054/00E8/; # T + $e =~ s/0057/00EF/; # W + $e =~ s/0059/00DF/; # Y + $e =~ s/0041/00A0/; # A + $e =~ s/0069/00D1/; # i + } + # We have to map the output, not the input, because + # pack/unpack U has been EBCDICified, too, it would + # just undo our remapping. } - # We have to map the output, not the input, because - # pack/unpack U has been EBCDICified, too, it would - # just undo our remapping. + print $w eq $e ? + "ok $test # $i -> $w\n" : "not ok $test # $h -> $e ($w)\n"; + $test++; } - print $w eq $e ? - "ok $test # $i -> $w\n" : "not ok $test # $h -> $e ($w)\n"; - $test++; } for my $i (sort { $a <=> $b } keys %none) { my $w = $i = sprintf "%04X", $i; my $c = pack "U0U", hex $i; - my $d = $func->($c); - my $e = unidump($d); - print $d eq $c ? - "ok $test # $i -> $w\n" : "not ok $test # $i -> $e ($w)\n"; - $test++; + foreach my $func (@funcs) { + my $d = $func->($c); + my $e = unidump($d); + print $d eq $c ? + "ok $test # $i -> $w\n" : "not ok $test # $i -> $e ($w)\n"; + $test++; + } } } diff --git a/t/uni/lower.t b/t/uni/lower.t index 4420d0b165..76df6de09d 100644 --- a/t/uni/lower.t +++ b/t/uni/lower.t @@ -4,5 +4,6 @@ BEGIN { require "case.pl"; } -casetest("Lower", \%utf8::ToSpecLower, sub { lc $_[0] }); - +casetest("Lower", \%utf8::ToSpecLower, + sub { lc $_[0] }, sub { my $a = ""; lc ($_[0] . $a) }, + sub { lcfirst $_[0] }, sub { my $a = ""; lcfirst ($_[0] . $a) }); diff --git a/t/uni/title.t b/t/uni/title.t index c0b7e3a016..ae85f94fbb 100644 --- a/t/uni/title.t +++ b/t/uni/title.t @@ -4,5 +4,5 @@ BEGIN { require "case.pl"; } -casetest("Title", \%utf8::ToSpecTitle, sub { ucfirst $_[0] }); - +casetest("Title", \%utf8::ToSpecTitle, sub { ucfirst $_[0] }, + sub { my $a = ""; ucfirst ($_[0] . $a) }); diff --git a/t/uni/upper.t b/t/uni/upper.t index 5694c26f22..d9f1788c72 100644 --- a/t/uni/upper.t +++ b/t/uni/upper.t @@ -4,5 +4,5 @@ BEGIN { require "case.pl"; } -casetest("Upper", \%utf8::ToSpecUpper, sub { uc $_[0] }); - +casetest("Upper", \%utf8::ToSpecUpper, sub { uc $_[0] }, + sub { my $a = ""; uc ($_[0] . $a) }); -- cgit v1.2.1