This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add script for looking at test time outliers.
[perl5.git] / Porting / harness-timer-report.pl
1 #!perl -w
2 #
3 # harness-timer-report.pl
4 #
5 # - read in the HARNESS_TIMER=1 output of "make test"
6 # - convert the milliseconds to seconds
7 # - compute a couple of derived values
8 #   - cpu: the sum of 'self' and 'kids'
9 #   - ratio of the wallclock and the cpu
10 # - optionally show header, the sum, or the max of each colum
11 # - sort the rows in various ways
12 #   - default ordering by 'cpu' seconds
13 # - optionally scale the column values by either the sum or the max
14 # - optionally display only rows that have rows of at least / at most a limit
15 #
16 # The --sort option has a few canned sorting rules.  If those are
17 # not to your liking, there is always sort(1).
18 #
19 # Example usages:
20 #
21 # perl harness-timer-report.pl log
22 # perl harness-timer-report.pl --sort=wall log
23 # perl harness-timer-report.pl --scale=sum log
24 # perl harness-timer-report.pl --scale=sum --min=0.01 log
25 # perl harness-timer-report.pl --show=header,max,sum log
26 # perl harness-timer-report.pl --min=wall=10 log
27
28 use strict;
29 use warnings;
30
31 use File::Basename qw[basename];
32
33 our $ME = basename($0);
34
35 use Getopt::Long;
36
37 sub usage {
38     die <<__EOF__;
39 $ME: Usage:
40 $ME [--scale=[sum|max]]
41     [--sort=[cpu|wall|ratio|self|kids|test|name]]
42     [--show=header,sum,max]
43     [--min=[[cpu|wall|ratio|self|kids]=value,...]]
44     [--max=[[cpu|wall|ratio|self|kids]=value,...]]
45     [--order]
46     logfile
47
48 The --order includes the original test order as the last column.
49 __EOF__
50 }
51
52 my %Opt;
53 usage()
54     unless
55     GetOptions(
56         'scale=s' => \$Opt{scale},
57         'sort=s'  => \$Opt{sort},
58         'show=s' => \$Opt{show},
59         'min=s' => \$Opt{min},
60         'max=s' => \$Opt{max},
61         'order' => \$Opt{order},
62     );
63
64 my %SHOW;
65 if (defined $Opt{show}) {
66     for my $s (split(/,/, $Opt{show})) {
67         if ($s =~ /^(header|sum|max)$/) {
68             $SHOW{$s}++;
69         } else {
70             die "$ME: Unexpected --show='$s'\n";
71         }
72     }
73 }
74 my %MIN;
75 if (defined $Opt{min}) {
76     for my $s (split(/,/, $Opt{min})) {
77         if ($s =~ /^(wall|cpu|kids|self|ratio)=(\d+(?:\.\d+)?)$/) {
78             $MIN{$1} = $2;
79         } else {
80             die "$ME: Unexpected --min='$s'\n";
81         }
82     }
83 }
84 my %MAX;
85 if (defined $Opt{max}) {
86     for my $s (split(/,/, $Opt{max})) {
87         if ($s =~ /^(wall|cpu|kids|self|ratio)=(\d+(?:\.\d+)?)$/) {
88             $MAX{$1} = $2;
89         } else {
90             die "$ME: Unexpected --max='$s'\n";
91         }
92     }
93 }
94
95 use List::Util qw[max];
96
97 my ($sa, $sb, $sc, $sd, $se);
98 my ($ma, $mb, $mc, $md, $me);
99
100 my $order = 0;
101 my @t;
102 while (<>) {
103     # t/re/pat ....................................................... ok     2876 ms  2660 ms   210 ms
104     if (m{(.+)\s+\.+\s+ok\s+(\d+)\s+ms\s+(\d+)\s+ms\s+(\d+)\s+ms$}) {
105         my ($test, $wall, $self, $kids) = ($1, $2, $3, $4);
106         next unless $wall > 0;
107         # Milliseconds to seconds.
108         $wall /= 1000;
109         $self /= 1000;
110         $kids /= 1000;
111         my $cpu = $self + $kids;
112         my $ratio = $cpu / $wall;
113         push @t, [ $test, $wall, $self, $kids, $cpu, $ratio, $order++ ];
114         $sa += $wall;
115         $sb += $self;
116         $sc += $kids;
117         $sd += $cpu;
118         $ma = max($wall,  $ma // $wall);
119         $mb = max($self,  $mb // $self);
120         $mc = max($kids,  $mc // $kids);
121         $md = max($cpu,   $md // $cpu);
122         $me = max($ratio, $md // $ratio);
123     }
124 }
125
126 die "$ME: No input found\n" unless @t;
127
128 # Compute the sum for the ratio only after the loop.
129 $se = $sd / $sa;
130
131 my %SORTER =
132     (
133      'cpu' =>
134       sub { $b->[4] <=> $a->[4] ||
135             $b->[1] <=> $a->[1] ||
136             $a->[0] cmp $b->[0] },
137      'wall' =>
138       sub { $b->[1] <=> $a->[1] ||
139             $b->[4] <=> $a->[4] ||
140             $a->[0] cmp $b->[0] },
141      'ratio' =>
142       sub { $b->[5] <=> $a->[5] ||
143             $b->[4] <=> $a->[4] ||
144             $b->[1] <=> $a->[1] ||
145             $a->[0] cmp $b->[0] },
146      'self' =>
147       sub { $b->[2] <=> $a->[2] ||
148             $b->[3] <=> $a->[3] ||
149             $a->[0] cmp $b->[0] },
150      'kids' =>
151       sub { $b->[3] <=> $a->[3] ||
152             $b->[2] <=> $a->[2] ||
153             $a->[0] cmp $b->[0] },
154      'test' =>
155       sub { $a->[6] <=> $b->[6] },
156      'name' =>
157       sub { $a->[0] cmp $b->[0] },
158     );
159 my $sorter;
160
161 $Opt{sort} //= 'cpu';
162
163 die "$ME: Unexpected --sort='$Opt{sort}'\n"
164     unless defined $SORTER{$Opt{sort}};
165
166 @t = sort { $SORTER{$Opt{sort}}->() } @t;
167
168 if (defined $Opt{scale}) {
169     my ($ta, $tb, $tc, $td, $te) =
170         $Opt{scale} eq 'sum' ?
171         ($sa, $sb, $sc, $sd, $se) :
172         $Opt{scale} eq 'max' ?
173         ($ma, $mb, $mc, $md, $me) :
174         die "$ME: Unexpected --scale='$Opt{scale}'";
175
176     my @u;
177     for my $t (@t) {
178     push @u, [ $t->[0],
179                $t->[1] / $ta, $t->[2] / $tb,
180                $t->[3] / $tc, $t->[4] / $td,
181                $t->[5] / $te, $t->[6] ];
182     }
183     @t = @u;
184 }
185
186 if ($SHOW{header}) {
187     my @header = qw[TEST WALL SELF KIDS CPU RATIO];
188     if ($Opt{order}) {
189         push @header, 'ORDER';
190     }
191     print join(" ", @header), "\n";
192 }
193 if ($SHOW{sum}) {
194     print join(" ", "SUM",
195                map { sprintf("%.6f", $_) } $sa, $sb, $sc, $sd, $se),
196           "\n";
197 }
198 if ($SHOW{max}) {
199     print join(" ", "MAX",
200                map { sprintf("%.6f", $_) } $ma, $mb, $mc, $md, $me),
201           "\n";
202 }
203
204 my %N2I = (wall  => 1,
205            self  => 2,
206            kids  => 3,
207            cpu   => 4,
208            ratio => 5);
209
210 sub row_is_skippable {
211     my ($t) = @_;
212     if (scalar keys %MIN) {
213         for my $k (grep { exists $MIN{$_} } keys %N2I) {
214             if ($t->[$N2I{$k}] < $MIN{$k}) {
215                 return 1;
216             }
217         }
218     }
219     if (scalar keys %MAX) {
220         for my $k (grep { exists $MAX{$_} } keys %N2I) {
221             if ($t->[$N2I{$k}] > $MAX{$k}) {
222                 return 1;
223             }
224         }
225     }
226     return 0;
227 }
228
229 for my $t (@t) {
230     next if row_is_skippable($t);
231     my $out = sprintf("%s %.6f %.6f %.6f %.6f %.6f",
232                       $t->[0], $t->[1], $t->[2], $t->[3], $t->[4], $t->[5]);
233     if ($Opt{order}) {
234         $out .= " $t->[6]";
235     }
236     print $out, "\n";
237 }
238
239 exit(0);