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