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;
+}
+
+