Create inversion list for Assigned code points

[perl5.git] / Porting / harness-timer-report.pl

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