1dbc85b21407dcfc83d9dc6a56e8e0f21c748c0c
1#!/usr/bin/perl
2
3use lib '../../perl/blib/lib';
4use strict;
5use warnings;
6use Git;
7
8sub get_times {
9 my $name = shift;
10 open my $fh, "<", $name or return undef;
11 my $line = <$fh>;
12 return undef if not defined $line;
13 close $fh or die "cannot close $name: $!";
14 $line =~ /^(?:(\d+):)?(\d+):(\d+(?:\.\d+)?) (\d+(?:\.\d+)?) (\d+(?:\.\d+)?)$/
15 or die "bad input line: $line";
16 my $rt = ((defined $1 ? $1 : 0.0)*60+$2)*60+$3;
17 return ($rt, $4, $5);
18}
19
20sub format_times {
21 my ($r, $u, $s, $firstr) = @_;
22 if (!defined $r) {
23 return "<missing>";
24 }
25 my $out = sprintf "%.2f(%.2f+%.2f)", $r, $u, $s;
26 if (defined $firstr) {
27 if ($firstr > 0) {
28 $out .= sprintf " %+.1f%%", 100.0*($r-$firstr)/$firstr;
29 } elsif ($r == 0) {
30 $out .= " =";
31 } else {
32 $out .= " +inf";
33 }
34 }
35 return $out;
36}
37
38my (@dirs, %dirnames, %dirabbrevs, %prefixes, @tests);
39while (scalar @ARGV) {
40 my $arg = $ARGV[0];
41 my $dir;
42 last if -f $arg or $arg eq "--";
43 if (! -d $arg) {
44 my $rev = Git::command_oneline(qw(rev-parse --verify), $arg);
45 $dir = "build/".$rev;
46 } else {
47 $arg =~ s{/*$}{};
48 $dir = $arg;
49 $dirabbrevs{$dir} = $dir;
50 }
51 push @dirs, $dir;
52 $dirnames{$dir} = $arg;
53 my $prefix = $dir;
54 $prefix =~ tr/^a-zA-Z0-9/_/c;
55 $prefixes{$dir} = $prefix . '.';
56 shift @ARGV;
57}
58
59if (not @dirs) {
60 @dirs = ('.');
61}
62$dirnames{'.'} = $dirabbrevs{'.'} = "this tree";
63$prefixes{'.'} = '';
64
65shift @ARGV if scalar @ARGV and $ARGV[0] eq "--";
66
67@tests = @ARGV;
68if (not @tests) {
69 @tests = glob "p????-*.sh";
70}
71
72my @subtests;
73my %shorttests;
74for my $t (@tests) {
75 $t =~ s{(?:.*/)?(p(\d+)-[^/]+)\.sh$}{$1} or die "bad test name: $t";
76 my $n = $2;
77 my $fname = "test-results/$t.subtests";
78 open my $fp, "<", $fname or die "cannot open $fname: $!";
79 for (<$fp>) {
80 chomp;
81 /^(\d+)$/ or die "malformed subtest line: $_";
82 push @subtests, "$t.$1";
83 $shorttests{"$t.$1"} = "$n.$1";
84 }
85 close $fp or die "cannot close $fname: $!";
86}
87
88sub read_descr {
89 my $name = shift;
90 open my $fh, "<", $name or return "<error reading description>";
91 binmode $fh, ":utf8" or die "PANIC on binmode: $!";
92 my $line = <$fh>;
93 close $fh or die "cannot close $name";
94 chomp $line;
95 return $line;
96}
97
98my %descrs;
99my $descrlen = 4; # "Test"
100for my $t (@subtests) {
101 $descrs{$t} = $shorttests{$t}.": ".read_descr("test-results/$t.descr");
102 $descrlen = length $descrs{$t} if length $descrs{$t}>$descrlen;
103}
104
105sub have_duplicate {
106 my %seen;
107 for (@_) {
108 return 1 if exists $seen{$_};
109 $seen{$_} = 1;
110 }
111 return 0;
112}
113sub have_slash {
114 for (@_) {
115 return 1 if m{/};
116 }
117 return 0;
118}
119
120my %newdirabbrevs = %dirabbrevs;
121while (!have_duplicate(values %newdirabbrevs)) {
122 %dirabbrevs = %newdirabbrevs;
123 last if !have_slash(values %dirabbrevs);
124 %newdirabbrevs = %dirabbrevs;
125 for (values %newdirabbrevs) {
126 s{^[^/]*/}{};
127 }
128}
129
130my %times;
131my @colwidth = ((0)x@dirs);
132for my $i (0..$#dirs) {
133 my $d = $dirs[$i];
134 my $w = length (exists $dirabbrevs{$d} ? $dirabbrevs{$d} : $dirnames{$d});
135 $colwidth[$i] = $w if $w > $colwidth[$i];
136}
137for my $t (@subtests) {
138 my $firstr;
139 for my $i (0..$#dirs) {
140 my $d = $dirs[$i];
141 $times{$prefixes{$d}.$t} = [get_times("test-results/$prefixes{$d}$t.times")];
142 my ($r,$u,$s) = @{$times{$prefixes{$d}.$t}};
143 my $w = length format_times($r,$u,$s,$firstr);
144 $colwidth[$i] = $w if $w > $colwidth[$i];
145 $firstr = $r unless defined $firstr;
146 }
147}
148my $totalwidth = 3*@dirs+$descrlen;
149$totalwidth += $_ for (@colwidth);
150
151binmode STDOUT, ":utf8" or die "PANIC on binmode: $!";
152
153printf "%-${descrlen}s", "Test";
154for my $i (0..$#dirs) {
155 my $d = $dirs[$i];
156 printf " %-$colwidth[$i]s", (exists $dirabbrevs{$d} ? $dirabbrevs{$d} : $dirnames{$d});
157}
158print "\n";
159print "-"x$totalwidth, "\n";
160for my $t (@subtests) {
161 printf "%-${descrlen}s", $descrs{$t};
162 my $firstr;
163 for my $i (0..$#dirs) {
164 my $d = $dirs[$i];
165 my ($r,$u,$s) = @{$times{$prefixes{$d}.$t}};
166 printf " %-$colwidth[$i]s", format_times($r,$u,$s,$firstr);
167 $firstr = $r unless defined $firstr;
168 }
169 print "\n";
170}