| 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); |