summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Mitchell <davem@iabyn.com>2011-02-23 12:46:05 +0000
committerDavid Mitchell <davem@iabyn.com>2011-02-23 22:03:40 +0000
commitbb2fbce0eaea956040fe698906fe951ebc2a0fb7 (patch)
tree28b8b039e84d926295d6c8779172cc9e21e0de2d
parent61ec922c7335a9814ce5ab2d4b51f45165a79fe8 (diff)
downloadperl-bb2fbce0eaea956040fe698906fe951ebc2a0fb7.tar.gz
make t/re/fold_grind.t faster
This is currently the slowest test in the suite. On my debugging build, it takes 4 minutes. This commit reduces it to 3 minutes. This is done by removing the second layer of eval: The tests are constructed as strings to be evaled, but were then wrapped in a second eval to handle TODO etc. This second eval turned out to be unnecessary.
-rw-r--r--t/re/fold_grind.t40
1 files changed, 10 insertions, 30 deletions
diff --git a/t/re/fold_grind.t b/t/re/fold_grind.t
index 6c5192b757..2aa950982e 100644
--- a/t/re/fold_grind.t
+++ b/t/re/fold_grind.t
@@ -58,16 +58,16 @@ sub numerically {
return $a <=> $b
}
-sub format_test($$$$) {
+sub run_test($$$$) {
my ($test, $count, $todo, $debug) = @_;
- # Create a test entry, with TODO set if it is one of the known problem
- # code points
-
$debug = "" unless $DEBUG;
$todo = "Known problem" if $todo;
- return qq[TODO: { local \$::TODO = "$todo"; ok(eval '$test', '$test; $debug'); }];
+ TODO: {
+ local $::TODO = $todo ? "Known problem" : undef;
+ ok(eval $test, "$test; $debug");
+ }
}
my %tests; # The final set of tests. keys are the code points to test
@@ -192,8 +192,6 @@ $tests{0x3A} = [ 0x3A ];
$tests{0xF7} = [ 0xF7 ];
$tests{0x2C7} = [ 0x2C7 ];
-my $clump_execs = 1000; # Speed up by building an 'exec' of many tests
-my @eval_tests;
# To cut down on the number of tests
my $has_tested_aa_above_latin1;
@@ -340,17 +338,17 @@ foreach my $test (sort { numerically } keys %tests) {
&& ! ($charset eq 'd' && (! $upgrade_target || ! $upgrade_pattern))
);
my $eval = "my \$c = \"$lhs$rhs\"; my \$p = qr/(?$charset:^($rhs)\\1\$)/i;$upgrade_target$upgrade_pattern \$c $op \$p";
- push @eval_tests, format_test($eval, ++$count, $todo, "");
+ run_test($eval, ++$count, $todo, "");
$eval = "my \$c = \"$lhs$rhs\"; my \$p = qr/(?$charset:^(?<grind>$rhs)\\k<grind>\$)/i;$upgrade_target$upgrade_pattern \$c $op \$p";
- push @eval_tests, format_test($eval, ++$count, $todo, "");
+ run_test($eval, ++$count, $todo, "");
if ($lhs ne $rhs) {
$eval = "my \$c = \"$rhs$lhs\"; my \$p = qr/(?$charset:^($rhs)\\1\$)/i;$upgrade_target$upgrade_pattern \$c $op \$p";
- push @eval_tests, format_test($eval, ++$count, "", "");
+ run_test($eval, ++$count, "", "");
$eval = "my \$c = \"$rhs$lhs\"; my \$p = qr/(?$charset:^(?<grind>$rhs)\\k<grind>\$)/i;$upgrade_target$upgrade_pattern \$c $op \$p";
- push @eval_tests, format_test($eval, ++$count, "", "");
+ run_test($eval, ++$count, "", "");
}
foreach my $bracketed (0, 1) { # Put rhs in [...], or not
@@ -458,18 +456,7 @@ foreach my $test (sort { numerically } keys %tests) {
# XXX Doesn't currently test multi-char folds in pattern
next if @pattern != 1;
- push @eval_tests, format_test($eval, ++$count, "", $debug);
-
- # Group tests
- if (@eval_tests >= $clump_execs) {
- #eval "use re qw(Debug COMPILE EXECUTE);" . join ";\n", @eval_tests;
- eval join ";\n", @eval_tests;
- if ($@) {
- fail($@);
- exit 1;
- }
- undef @eval_tests;
- }
+ run_test($eval, ++$count, "", $debug);
}
}
}
@@ -484,13 +471,6 @@ foreach my $test (sort { numerically } keys %tests) {
}
}
-# Finish up any tests not already done
-eval join ";\n", @eval_tests;
-if ($@) {
- fail($@);
- exit 1;
-}
-
plan($count);
1