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