Allow actions to be unit tested.

Allow unit tests to be performance tested.
Add an example script to generate @rx vs @pm tests.
This commit is contained in:
brectanus
2008-04-25 23:16:48 +00:00
parent cfeb3b9769
commit 40fba3355e
4 changed files with 552 additions and 111 deletions

96
apache2/t/gen_rx-pm.pl.in Executable file
View File

@@ -0,0 +1,96 @@
#!@PERL@
#
# Generates a test file for comparing @rx and @pm speed.
#
use strict;
use Regexp::Assemble;
my $MIN = 1;
my $MAX = 5000;
my $INC = 250;
my $ITERATIONS = 10000;
my $MINSTRLEN = 2;
my $MAXSTRLEN = 8;
my $last = rndstr();
my @param = ($last);
my $i=$MIN;
while ($i <= $MAX) {
my $ra = Regexp::Assemble->new;
$ra->add(@param);
printf (
"# rx: %6d\n".
"{\n".
" comment => \"%6d item(s)\",\n".
" type => \"op\",\n".
" name => \"rx\",\n".
" param => qr/^(?:%s)\$/,\n".
" input => \"%s\",\n".
" ret => 1,\n".
" iterations => %d,\n".
"},\n",
$i,
$i,
join('|', @param),
$last,
$ITERATIONS,
);
printf (
"# rx-optimized: %6d\n".
"{\n".
" comment => \"%6d item(s)\",\n".
" type => \"op\",\n".
" name => \"rx\",\n".
" param => qr/^(?:%s)\$/,\n".
" input => \"%s\",\n".
" ret => 1,\n".
" iterations => %d,\n".
"},\n",
$i,
$i,
$ra->as_string,
$last,
$ITERATIONS,
);
printf (
"# pm: %6d\n".
"{\n".
" comment => \"%6d item(s)\",\n".
" type => \"op\",\n".
" name => \"pm\",\n".
" param => \"%s\",\n".
" input => \"%s\",\n".
" ret => 1,\n".
" iterations => %d,\n".
"},\n",
$i,
$i,
join(' ', @param),
$last,
$ITERATIONS,
);
$i = ($i == 1) ? $INC : $i + $INC;
while (@param < $i) {
unshift @param, rndstr();
}
}
sub rndstr {
my @c=('a'..'z','0'..'9','_');
my $rndstr;
my $max = int(rand($MAXSTRLEN - $MINSTRLEN)) + $MINSTRLEN;
foreach (1 .. $max) {
$rndstr .= $c[rand @c];
}
# We need a string that is not in another string for "last"
if ($last =~ m/$rndstr/) {
$rndstr = rndstr();
}
return $rndstr;
}

View File

@@ -13,12 +13,13 @@ use File::Basename qw(basename dirname);
use FileHandle;
use IPC::Open2 qw(open2);
my @TYPES = qw(tfn op);
my @TYPES = qw(tfn op action);
my $TEST = "./msc_test";
my $SCRIPT = basename($0);
my $SCRIPTDIR = dirname($0);
my $PASSED = 0;
my $TOTAL = 0;
my $DEBUG = $ENV{MSC_TEST_DEBUG} || 0;
if (defined $ARGV[0]) {
runfile(dirname($ARGV[0]), basename($ARGV[0]), $ARGV[1]);
@@ -72,7 +73,7 @@ sub runfile {
my %t = %{$t || {}};
my $id = sprintf("%6d", $n);
my $in = $t{input};
my $in = (exists($t{input}) and defined($t{input})) ? $t{input} : "";
my $out;
my $test_in = new FileHandle();
my $test_out = new FileHandle();
@@ -86,11 +87,14 @@ sub runfile {
elsif ($t{type} eq "op") {
$param = escape($t{param});
}
elsif ($t{type} eq "action") {
$param = escape($t{param});
}
else {
quit(1, "Unknown type \"$t{type}\" - should be one of: " . join(",",@TYPES));
}
@test = ($t{type}, $t{name}, $param, (exists($t{ret}) ? ($t{ret}) : ()));
@test = ("-t", $t{type}, "-n", $t{name}, "-p", $param, "-D", "$DEBUG", (exists($t{ret}) ? ("-r", $t{ret}) : ()), (exists($t{iterations}) ? ("-I", $t{iterations}) : ()), (exists($t{prerun}) ? ("-P", $t{prerun}) : ()));
$teststr = "$TEST " . join(" ", map { "\"$_\"" } @test);
$test_pid = open2($test_out, $test_in, $TEST, @test) or quit(1, "Failed to execute test: $teststr\": $!");
print $test_in "$in";
@@ -117,7 +121,7 @@ sub runfile {
$pass++;
}
msg(sprintf("%s) %s \"%s\": %s%s", $id, $t{type}, $t{name}, ($rc ? "failed" : "passed"), ((defined($out) && $out ne "")? " ($out)" : "")));
msg(sprintf("%s) %s \"%s\"%s: %s%s", $id, $t{type}, $t{name}, (exists($t{comment}) ? " $t{comment}" : ""), ($rc ? "failed" : "passed"), ((defined($out) && $out ne "")? " ($out)" : "")));
}