summaryrefslogtreecommitdiffabout
path: root/src/runtest
Side-by-side diff
Diffstat (limited to 'src/runtest') (more/less context) (ignore whitespace changes)
-rwxr-xr-xsrc/runtest97
1 files changed, 97 insertions, 0 deletions
diff --git a/src/runtest b/src/runtest
new file mode 100755
index 0000000..33322b1
--- a/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;
+}
+
+

Return to:

Send suggestions and report system problems to the System administrator.