In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/227e818e7f550517639af67457b5de16e61ffc11?hp=c7d255944c0b238f9cec18e728822535d42a9ed2>
- Log ----------------------------------------------------------------- commit 227e818e7f550517639af67457b5de16e61ffc11 Author: Karl Williamson <[email protected]> Date: Sat Nov 8 11:22:36 2014 -0700 t/uni/case.pl: Improve test names. This is clearer as to what is being tested and the desired result. M t/uni/case.pl M t/uni/lower.t M t/uni/title.t M t/uni/upper.t commit d2579e9a6de6e262f4ce14dbd2f7e0fbabccefc1 Author: Karl Williamson <[email protected]> Date: Sat Nov 8 18:17:13 2014 -0700 t/uni/case.pl: Use calculated test count This test file calculates the number of tests, but discards it in favor of done_testing(). Since we've gone to the trouble of computing it, use it. M t/uni/case.pl commit 8cf6707da9e10cde056cb4e94fabe8d1cf7133b1 Author: Karl Williamson <[email protected]> Date: Fri Nov 14 10:08:35 2014 -0700 lib/Unicode/UCD.t: Add missing arg to failure sprintf This wasn't spotted before because the test never failed. M lib/Unicode/UCD.t ----------------------------------------------------------------------- Summary of changes: lib/Unicode/UCD.t | 3 ++- t/uni/case.pl | 75 +++++++++++++++++++++++++++++-------------------------- t/uni/lower.t | 7 ++++-- t/uni/title.t | 6 +++-- t/uni/upper.t | 8 +++--- 5 files changed, 56 insertions(+), 43 deletions(-) diff --git a/lib/Unicode/UCD.t b/lib/Unicode/UCD.t index bc07795..37c8bd2 100644 --- a/lib/Unicode/UCD.t +++ b/lib/Unicode/UCD.t @@ -1749,7 +1749,8 @@ foreach my $prop (sort(keys %props), sort keys %legacy_props) { my $packed = pack "U*", @{$invmap_ref->[$i]}; if ($value ne $packed) { fail("prop_invmap('$display_prop')"); - diag(sprintf "For %04X, expected the mapping to be '$packed', but got '$value'"); + diag(sprintf "For %04X, expected the mapping to be " + . "'$packed', but got '$value'", $invlist_ref->[$i]); next PROPERTY; } diff --git a/t/uni/case.pl b/t/uni/case.pl index f9c3640..72de5e8 100644 --- a/t/uni/case.pl +++ b/t/uni/case.pl @@ -7,11 +7,11 @@ use strict; use warnings; sub unidump { - join " ", map { sprintf "%04X", $_ } unpack "U*", $_[0]; + join "", map { sprintf "\\x{%04X}", $_ } unpack "U*", $_[0]; } sub casetest { - my ($already_run, $base, @funcs) = @_; + my ($already_run, $base, %funcs) = @_; my %spec; @@ -20,14 +20,14 @@ sub casetest { # $already_run is the number of extra tests the caller has run before this # call. my $ballast = chr (0x2672) x 3; - @funcs = map {my $f = $_; - ($f, - sub {my $r = $f->($_[0] . $ballast); # Add it before + foreach my $name (keys %funcs) { + $funcs{"${name}_with_ballast"} = + sub {my $r = $funcs{$name}->($_[0] . $ballast); # Add it before $r =~ s/$ballast\z//so # Remove it afterwards or die "'$_[0]' to '$r' mangled"; $r; # Result with $ballast removed. - }, - )} @funcs; + }; + } use Unicode::UCD 'prop_invmap'; @@ -78,46 +78,51 @@ sub casetest { } print "# ", scalar keys %none, " noncase mappings\n"; - my $tests = - $already_run + - ((scalar keys %simple) + - (scalar keys %spec) + - (scalar keys %none)) * @funcs; my $test = $already_run + 1; - for my $i (sort keys %simple) { - my $w = $simple{$i}; - my $c = pack "U0U", $i; - foreach my $func (@funcs) { - my $d = $func->($c); - my $e = unidump($d); - is( $d, pack("U0U", $simple{$i}), "$i -> $e ($w)" ); + for my $ord (sort keys %simple) { + my $char = pack "U0U", $ord; + my $disp_input = unidump($char); + + my $expected = pack("U0U", $simple{$ord}); + my $disp_expected = unidump($expected); + + foreach my $name (sort keys %funcs) { + my $got = $funcs{$name}->($char); + is( $got, $expected, + "Verify $name(\"$disp_input\") eq \"$disp_expected\""); } } - for my $i (sort keys %spec) { - my $w = unidump($spec{$i}); - my $h = sprintf "%04X", $i; - my $c = chr($i); $c .= chr(0x100); chop $c; - foreach my $func (@funcs) { - my $d = $func->($c); - my $e = unidump($d); - is( $w, $e, "$h -> $e ($w)" ); + for my $ord (sort keys %spec) { + my $char = chr($ord); $char .= chr(0x100); chop $char; + my $disp_input = unidump($char); + + my $expected = unidump($spec{$ord}); + + foreach my $name (sort keys %funcs) { + my $got = $funcs{$name}->($char); + is( unidump($got), $expected, + "Verify $name(\"$disp_input\") eq \"$expected\""); } } - for my $i (sort { $a <=> $b } keys %none) { - my $c = pack "U0U", $i; - my $w = $i = sprintf "%04X", $i; - foreach my $func (@funcs) { - my $d = $func->($c); - my $e = unidump($d); - is( $d, $c, "$i -> $e ($w)" ); + for my $ord (sort { $a <=> $b } keys %none) { + my $char = pack "U0U", $ord; + my $disp_input = unidump($char); + + foreach my $name (sort keys %funcs) { + my $got = $funcs{$name}->($char); + is( $got, $char, + "Verify $name(\"$disp_input\") eq \"$disp_input\""); } } - done_testing(); + plan $already_run + + ((scalar keys %simple) + + (scalar keys %spec) + + (scalar keys %none)) * scalar keys %funcs; } 1; diff --git a/t/uni/lower.t b/t/uni/lower.t index 8c8a053..2e6fb2e 100644 --- a/t/uni/lower.t +++ b/t/uni/lower.t @@ -5,5 +5,8 @@ BEGIN { casetest(0, # No extra tests run here, "Lowercase_Mapping", - sub { lc $_[0] }, sub { my $a = ""; lc ($_[0] . $a) }, - sub { lcfirst $_[0] }, sub { my $a = ""; lcfirst ($_[0] . $a) }); + lc => sub { lc $_[0] }, + lc_with_appended_null_arg => sub { my $a = ""; lc ($_[0] . $a) }, + lcfirst => sub { lcfirst $_[0] }, + lcfirst_with_appended_null_arg => sub { my $a = ""; lcfirst ($_[0] . $a) } + ); diff --git a/t/uni/title.t b/t/uni/title.t index 6acaf55..a043529 100644 --- a/t/uni/title.t +++ b/t/uni/title.t @@ -4,5 +4,7 @@ BEGIN { } casetest(0, # No extra tests run here, - "Titlecase_Mapping", sub { ucfirst $_[0] }, - sub { my $a = ""; ucfirst ($_[0] . $a) }); + "Titlecase_Mapping", + ucfirst => sub { ucfirst $_[0] }, + ucfirst_with_appended_null_arg => sub { my $a = ""; ucfirst ($_[0] . $a) } + ); diff --git a/t/uni/upper.t b/t/uni/upper.t index c8bdb4b..f62b43b 100644 --- a/t/uni/upper.t +++ b/t/uni/upper.t @@ -3,9 +3,11 @@ BEGIN { require "uni/case.pl"; } -is(uc("\x{3B1}\x{345}\x{301}"), "\x{391}\x{301}\x{399}", 'Verify moves YPOGEGRAMMENI'); +is(uc("\x{3B1}\x{345}\x{301}"), "\x{391}\x{301}\x{399}", + 'Verify moves YPOGEGRAMMENI'); casetest( 1, # extra tests already run "Uppercase_Mapping", - sub { uc $_[0] }, - sub { my $a = ""; uc ($_[0] . $a) }); + uc => sub { uc $_[0] }, + uc_with_appended_null_arg => sub { my $a = ""; uc ($_[0] . $a) } + ); -- Perl5 Master Repository
