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 <j...@iki.fi>
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

Reply via email to