In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/87af8d55d30dca849a4094c502ad2d067745049f?hp=a19564f7dac42c5dc47e1e3e792d670223548c44>
- Log ----------------------------------------------------------------- commit 87af8d55d30dca849a4094c502ad2d067745049f Author: Jarkko Hietaniemi <[email protected]> Date: Sun Oct 16 15:26:36 2016 -0400 Add script for looking at test time outliers. Requires logging the output of "make test" with HARNESS_TIMER=1 ----------------------------------------------------------------------- Summary of changes: MANIFEST | 1 + Porting/README.pod | 5 + Porting/exec-bit.txt | 1 + Porting/harness-timer-report.pl | 239 ++++++++++++++++++++++++++++++++++++++++ 4 files changed, 246 insertions(+) create mode 100755 Porting/harness-timer-report.pl diff --git a/MANIFEST b/MANIFEST index 7b7fc73..8d3d0f1 100644 --- a/MANIFEST +++ b/MANIFEST @@ -4988,6 +4988,7 @@ Porting/git-find-p4-change Find the change for a p4 change number Porting/git-make-p4-refs Output git refs for each p4 change number, suitable for appending to .git/packed-refs Porting/GitUtils.pm Generate the contents of a .patch file Porting/Glossary Glossary of config.sh variables +Porting/harness-timer-report.pl Analyze the timings from the test harness Porting/how_to_write_a_perldelta.pod Bluffer's guide to writing a perldelta. Porting/leakfinder.pl Hacky script for finding memory leaks Porting/Maintainers Program to pretty print info in Maintainers.pl diff --git a/Porting/README.pod b/Porting/README.pod index 21a0414..af78bbf 100644 --- a/Porting/README.pod +++ b/Porting/README.pod @@ -186,6 +186,11 @@ This file is built by F<metaconfig>. This file contains a description of all the shell variables whose value is determined by the Configure script. It later gets incorporated into the pod for F<Config.pm>. +=head2 F<harness-timer-report.pl> + +For analyzing the output of "env HARNESS_TIMER=1 make test", to find +outliers of test execution times. + =head2 F<how_to_write_a_perldelta.pod> This file contains a specification as to how to write a perldelta pod. diff --git a/Porting/exec-bit.txt b/Porting/exec-bit.txt index 4504c52..bf79b62 100644 --- a/Porting/exec-bit.txt +++ b/Porting/exec-bit.txt @@ -47,6 +47,7 @@ Porting/corecpan.pl Porting/corelist-perldelta.pl Porting/corelist.pl Porting/expand-macro.pl +Porting/harness-timer-report.pl Porting/findrfuncs Porting/makerel Porting/make_dot_patch.pl diff --git a/Porting/harness-timer-report.pl b/Porting/harness-timer-report.pl new file mode 100755 index 0000000..899af86 --- /dev/null +++ b/Porting/harness-timer-report.pl @@ -0,0 +1,239 @@ +#!perl -w +# +# harness-timer-report.pl +# +# - read in the HARNESS_TIMER=1 output of "make test" +# - convert the milliseconds to seconds +# - compute a couple of derived values +# - cpu: the sum of 'self' and 'kids' +# - ratio of the wallclock and the cpu +# - optionally show header, the sum, or the max of each colum +# - sort the rows in various ways +# - default ordering by 'cpu' seconds +# - optionally scale the column values by either the sum or the max +# - optionally display only rows that have rows of at least / at most a limit +# +# The --sort option has a few canned sorting rules. If those are +# not to your liking, there is always sort(1). +# +# Example usages: +# +# perl harness-timer-report.pl log +# perl harness-timer-report.pl --sort=wall log +# perl harness-timer-report.pl --scale=sum log +# perl harness-timer-report.pl --scale=sum --min=0.01 log +# perl harness-timer-report.pl --show=header,max,sum log +# perl harness-timer-report.pl --min=wall=10 log + +use strict; +use warnings; + +use File::Basename qw[basename]; + +our $ME = basename($0); + +use Getopt::Long; + +sub usage { + die <<__EOF__; +$ME: Usage: +$ME [--scale=[sum|max]] + [--sort=[cpu|wall|ratio|self|kids|test|name]] + [--show=header,sum,max] + [--min=[[cpu|wall|ratio|self|kids]=value,...]] + [--max=[[cpu|wall|ratio|self|kids]=value,...]] + [--order] + logfile + +The --order includes the original test order as the last column. +__EOF__ +} + +my %Opt; +usage() + unless + GetOptions( + 'scale=s' => \$Opt{scale}, + 'sort=s' => \$Opt{sort}, + 'show=s' => \$Opt{show}, + 'min=s' => \$Opt{min}, + 'max=s' => \$Opt{max}, + 'order' => \$Opt{order}, + ); + +my %SHOW; +if (defined $Opt{show}) { + for my $s (split(/,/, $Opt{show})) { + if ($s =~ /^(header|sum|max)$/) { + $SHOW{$s}++; + } else { + die "$ME: Unexpected --show='$s'\n"; + } + } +} +my %MIN; +if (defined $Opt{min}) { + for my $s (split(/,/, $Opt{min})) { + if ($s =~ /^(wall|cpu|kids|self|ratio)=(\d+(?:\.\d+)?)$/) { + $MIN{$1} = $2; + } else { + die "$ME: Unexpected --min='$s'\n"; + } + } +} +my %MAX; +if (defined $Opt{max}) { + for my $s (split(/,/, $Opt{max})) { + if ($s =~ /^(wall|cpu|kids|self|ratio)=(\d+(?:\.\d+)?)$/) { + $MAX{$1} = $2; + } else { + die "$ME: Unexpected --max='$s'\n"; + } + } +} + +use List::Util qw[max]; + +my ($sa, $sb, $sc, $sd, $se); +my ($ma, $mb, $mc, $md, $me); + +my $order = 0; +my @t; +while (<>) { + # t/re/pat ....................................................... ok 2876 ms 2660 ms 210 ms + if (m{(.+)\s+\.+\s+ok\s+(\d+)\s+ms\s+(\d+)\s+ms\s+(\d+)\s+ms$}) { + my ($test, $wall, $self, $kids) = ($1, $2, $3, $4); + next unless $wall > 0; + # Milliseconds to seconds. + $wall /= 1000; + $self /= 1000; + $kids /= 1000; + my $cpu = $self + $kids; + my $ratio = $cpu / $wall; + push @t, [ $test, $wall, $self, $kids, $cpu, $ratio, $order++ ]; + $sa += $wall; + $sb += $self; + $sc += $kids; + $sd += $cpu; + $ma = max($wall, $ma // $wall); + $mb = max($self, $mb // $self); + $mc = max($kids, $mc // $kids); + $md = max($cpu, $md // $cpu); + $me = max($ratio, $md // $ratio); + } +} + +die "$ME: No input found\n" unless @t; + +# Compute the sum for the ratio only after the loop. +$se = $sd / $sa; + +my %SORTER = + ( + 'cpu' => + sub { $b->[4] <=> $a->[4] || + $b->[1] <=> $a->[1] || + $a->[0] cmp $b->[0] }, + 'wall' => + sub { $b->[1] <=> $a->[1] || + $b->[4] <=> $a->[4] || + $a->[0] cmp $b->[0] }, + 'ratio' => + sub { $b->[5] <=> $a->[5] || + $b->[4] <=> $a->[4] || + $b->[1] <=> $a->[1] || + $a->[0] cmp $b->[0] }, + 'self' => + sub { $b->[2] <=> $a->[2] || + $b->[3] <=> $a->[3] || + $a->[0] cmp $b->[0] }, + 'kids' => + sub { $b->[3] <=> $a->[3] || + $b->[2] <=> $a->[2] || + $a->[0] cmp $b->[0] }, + 'test' => + sub { $a->[6] <=> $b->[6] }, + 'name' => + sub { $a->[0] cmp $b->[0] }, + ); +my $sorter; + +$Opt{sort} //= 'cpu'; + +die "$ME: Unexpected --sort='$Opt{sort}'\n" + unless defined $SORTER{$Opt{sort}}; + +@t = sort { $SORTER{$Opt{sort}}->() } @t; + +if (defined $Opt{scale}) { + my ($ta, $tb, $tc, $td, $te) = + $Opt{scale} eq 'sum' ? + ($sa, $sb, $sc, $sd, $se) : + $Opt{scale} eq 'max' ? + ($ma, $mb, $mc, $md, $me) : + die "$ME: Unexpected --scale='$Opt{scale}'"; + + my @u; + for my $t (@t) { + push @u, [ $t->[0], + $t->[1] / $ta, $t->[2] / $tb, + $t->[3] / $tc, $t->[4] / $td, + $t->[5] / $te, $t->[6] ]; + } + @t = @u; +} + +if ($SHOW{header}) { + my @header = qw[TEST WALL SELF KIDS CPU RATIO]; + if ($Opt{order}) { + push @header, 'ORDER'; + } + print join(" ", @header), "\n"; +} +if ($SHOW{sum}) { + print join(" ", "SUM", + map { sprintf("%.6f", $_) } $sa, $sb, $sc, $sd, $se), + "\n"; +} +if ($SHOW{max}) { + print join(" ", "MAX", + map { sprintf("%.6f", $_) } $ma, $mb, $mc, $md, $me), + "\n"; +} + +my %N2I = (wall => 1, + self => 2, + kids => 3, + cpu => 4, + ratio => 5); + +sub row_is_skippable { + my ($t) = @_; + if (scalar keys %MIN) { + for my $k (grep { exists $MIN{$_} } keys %N2I) { + if ($t->[$N2I{$k}] < $MIN{$k}) { + return 1; + } + } + } + if (scalar keys %MAX) { + for my $k (grep { exists $MAX{$_} } keys %N2I) { + if ($t->[$N2I{$k}] > $MAX{$k}) { + return 1; + } + } + } + return 0; +} + +for my $t (@t) { + next if row_is_skippable($t); + my $out = sprintf("%s %.6f %.6f %.6f %.6f %.6f", + $t->[0], $t->[1], $t->[2], $t->[3], $t->[4], $t->[5]); + if ($Opt{order}) { + $out .= " $t->[6]"; + } + print $out, "\n"; +} + +exit(0); -- Perl5 Master Repository
