![[tokkee]](http://tokkee.org/images/avatar.png){kind=avatar}
diff --git a/t/perf/aggregate.perl b/t/perf/aggregate.perl
--- /dev/null
+++ b/t/perf/aggregate.perl
@@ -0,0 +1,166 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Git;
+
+sub get_times {
+ my $name = shift;
+ open my $fh, "<", $name or return undef;
+ my $line = <$fh>;
+ return undef if not defined $line;
+ close $fh or die "cannot close $name: $!";
+ $line =~ /^(?:(\d+):)?(\d+):(\d+(?:\.\d+)?) (\d+(?:\.\d+)?) (\d+(?:\.\d+)?)$/
+ or die "bad input line: $line";
+ my $rt = ((defined $1 ? $1 : 0.0)*60+$2)*60+$3;
+ return ($rt, $4, $5);
+}
+
+sub format_times {
+ my ($r, $u, $s, $firstr) = @_;
+ if (!defined $r) {
+ return "<missing>";
+ }
+ my $out = sprintf "%.2f(%.2f+%.2f)", $r, $u, $s;
+ if (defined $firstr) {
+ if ($firstr > 0) {
+ $out .= sprintf " %+.1f%%", 100.0*($r-$firstr)/$firstr;
+ } elsif ($r == 0) {
+ $out .= " =";
+ } else {
+ $out .= " +inf";
+ }
+ }
+ return $out;
+}
+
+my (@dirs, %dirnames, %dirabbrevs, %prefixes, @tests);
+while (scalar @ARGV) {
+ my $arg = $ARGV[0];
+ my $dir;
+ last if -f $arg or $arg eq "--";
+ if (! -d $arg) {
+ my $rev = Git::command_oneline(qw(rev-parse --verify), $arg);
+ $dir = "build/".$rev;
+ } else {
+ $arg =~ s{/*$}{};
+ $dir = $arg;
+ $dirabbrevs{$dir} = $dir;
+ }
+ push @dirs, $dir;
+ $dirnames{$dir} = $arg;
+ my $prefix = $dir;
+ $prefix =~ tr/^a-zA-Z0-9/_/c;
+ $prefixes{$dir} = $prefix . '.';
+ shift @ARGV;
+}
+
+if (not @dirs) {
+ @dirs = ('.');
+}
+$dirnames{'.'} = $dirabbrevs{'.'} = "this tree";
+$prefixes{'.'} = '';
+
+shift @ARGV if scalar @ARGV and $ARGV[0] eq "--";
+
+@tests = @ARGV;
+if (not @tests) {
+ @tests = glob "p????-*.sh";
+}
+
+my @subtests;
+my %shorttests;
+for my $t (@tests) {
+ $t =~ s{(?:.*/)?(p(\d+)-[^/]+)\.sh$}{$1} or die "bad test name: $t";
+ my $n = $2;
+ my $fname = "test-results/$t.subtests";
+ open my $fp, "<", $fname or die "cannot open $fname: $!";
+ for (<$fp>) {
+ chomp;
+ /^(\d+)$/ or die "malformed subtest line: $_";
+ push @subtests, "$t.$1";
+ $shorttests{"$t.$1"} = "$n.$1";
+ }
+ close $fp or die "cannot close $fname: $!";
+}
+
+sub read_descr {
+ my $name = shift;
+ open my $fh, "<", $name or return "<error reading description>";
+ my $line = <$fh>;
+ close $fh or die "cannot close $name";
+ chomp $line;
+ return $line;
+}
+
+my %descrs;
+my $descrlen = 4; # "Test"
+for my $t (@subtests) {
+ $descrs{$t} = $shorttests{$t}.": ".read_descr("test-results/$t.descr");
+ $descrlen = length $descrs{$t} if length $descrs{$t}>$descrlen;
+}
+
+sub have_duplicate {
+ my %seen;
+ for (@_) {
+ return 1 if exists $seen{$_};
+ $seen{$_} = 1;
+ }
+ return 0;
+}
+sub have_slash {
+ for (@_) {
+ return 1 if m{/};
+ }
+ return 0;
+}
+
+my %newdirabbrevs = %dirabbrevs;
+while (!have_duplicate(values %newdirabbrevs)) {
+ %dirabbrevs = %newdirabbrevs;
+ last if !have_slash(values %dirabbrevs);
+ %newdirabbrevs = %dirabbrevs;
+ for (values %newdirabbrevs) {
+ s{^[^/]*/}{};
+ }
+}
+
+my %times;
+my @colwidth = ((0)x@dirs);
+for my $i (0..$#dirs) {
+ my $d = $dirs[$i];
+ my $w = length (exists $dirabbrevs{$d} ? $dirabbrevs{$d} : $dirnames{$d});
+ $colwidth[$i] = $w if $w > $colwidth[$i];
+}
+for my $t (@subtests) {
+ my $firstr;
+ for my $i (0..$#dirs) {
+ my $d = $dirs[$i];
+ $times{$prefixes{$d}.$t} = [get_times("test-results/$prefixes{$d}$t.times")];
+ my ($r,$u,$s) = @{$times{$prefixes{$d}.$t}};
+ my $w = length format_times($r,$u,$s,$firstr);
+ $colwidth[$i] = $w if $w > $colwidth[$i];
+ $firstr = $r unless defined $firstr;
+ }
+}
+my $totalwidth = 3*@dirs+$descrlen;
+$totalwidth += $_ for (@colwidth);
+
+printf "%-${descrlen}s", "Test";
+for my $i (0..$#dirs) {
+ my $d = $dirs[$i];
+ printf " %-$colwidth[$i]s", (exists $dirabbrevs{$d} ? $dirabbrevs{$d} : $dirnames{$d});
+}
+print "\n";
+print "-"x$totalwidth, "\n";
+for my $t (@subtests) {
+ printf "%-${descrlen}s", $descrs{$t};
+ my $firstr;
+ for my $i (0..$#dirs) {
+ my $d = $dirs[$i];
+ my ($r,$u,$s) = @{$times{$prefixes{$d}.$t}};
+ printf " %-$colwidth[$i]s", format_times($r,$u,$s,$firstr);
+ $firstr = $r unless defined $firstr;
+ }
+ print "\n";
+}