diff options
Diffstat (limited to 'src/runtest')
-rwxr-xr-x | src/runtest | 97 |
1 files changed, 97 insertions, 0 deletions
diff --git a/src/runtest b/src/runtest new file mode 100755 index 0000000..33322b1 --- /dev/null +++ b/src/runtest @@ -0,0 +1,97 @@ +#!/bin/sh +#! -*-perl-*- +eval 'exec perl -x -S $0 ${1+"$@"}' + if 0; + +use strict; +use warnings; +use Getopt::Long qw(:config gnu_getopt no_ignore_case require_order); +use File::Basename; +use File::Spec; + +my $nsamples = 1; # Number of times to run each test. +my $c_init = 100; # Initial cache capacity. +my $c_step = 100; # Cache capacity increment. +my $c_final = 100; # Final cache capacity. +my $drop_caches; # Drop system disk caches before each run. +my $log_file; # Name of the log file. + +sub runtest { + my ($t_total, $t_open, $t_loop) = (0,0,0); + + my $n; + for ($n = 0; $n < $nsamples; $n++) { + if ($drop_caches) { + system($drop_caches); + } + open(PH, '-|', @_) + or die "can't run ".join(' ', @_).": $!\n"; + my @inbuf; + while (<PH>) { + if (chomp) { + if (@inbuf == 3) { + print shift(@inbuf),"\n"; + } + push @inbuf, $_; + } else { + print "$_"; + } + } + close PH; + + if (@inbuf == 3) { + $t_total += $inbuf[0]; + $t_open += $inbuf[1]; + $t_loop += $inbuf[2]; + } else { + while (my $s = shift(@inbuf)) { + print "$s\n"; + } + die "no timing info\n"; + } + } + return ($t_total/$nsamples, $t_open/$nsamples, $t_loop/$nsamples) +} + +GetOptions( + 'n=n' => \$nsamples, + 'init|i=n' => \$c_init, + 'step|s=n' => \$c_step, + 'final|end|e=n' => \$c_final, + 'drop-caches|d' => sub { + $drop_caches = File::Spec->catfile(dirname($0), 'dropcache'); + unless (-x $drop_caches) { + print STDERR <<EOT; +$0: the option --drop-caches (-d) requires that the program $drop_caches +be built, be owned by root, and have the setuid bit set (or the tests be +run as root). Please, make sure that this is the case and rerun the runtest +utility. +EOT +; + exit(1); + } + }, + 'log-file|l=s' => \$log_file +) or exit(1); + +die "command line missing\n" unless @ARGV; + +if ($c_init > $c_final) { + $c_init = 10; +} +if ($c_step > $c_final - $c_init) { + $c_step = 1; +} + +if ($log_file) { + open(LOG, '>', $log_file) or die "can't open log file $log_file: $!"; +} else { + open(LOG, '>&', 'STDOUT') or die "can't dup STDOUT: $!"; +} + +for (my $c = $c_init; $c <= $c_final; $c += $c_step) { + my ($t_total, $t_open, $t_loop) = runtest(@ARGV, '-c', $c); + printf LOG "%d %.6f %.6f %.6f\n", $c, $t_total, $t_open, $t_loop; +} + + |