merge(third_party/git): Merge squashed git subtree at v2.23.0
Merge commit '1b593e1ea4' as 'third_party/git'
This commit is contained in:
Vincent Ambo
commit
7ef0d62730
3629 changed files with 1139935 additions and 0 deletions
357
third_party/git/t/perf/aggregate.perl
vendored
Executable file
357
third_party/git/t/perf/aggregate.perl
vendored
Executable file
|
|
@ -0,0 +1,357 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
use lib '../../perl/build/lib';
|
||||
use strict;
|
||||
use warnings;
|
||||
use Getopt::Long;
|
||||
use Git;
|
||||
use Cwd qw(realpath);
|
||||
|
||||
sub get_times {
|
||||
my $name = shift;
|
||||
open my $fh, "<", $name or return undef;
|
||||
my $line = <$fh>;
|
||||
return undef if not defined $line;
|
||||
close $fh or die "cannot close $name: $!";
|
||||
# times
|
||||
if ($line =~ /^(?:(\d+):)?(\d+):(\d+(?:\.\d+)?) (\d+(?:\.\d+)?) (\d+(?:\.\d+)?)$/) {
|
||||
my $rt = ((defined $1 ? $1 : 0.0)*60+$2)*60+$3;
|
||||
return ($rt, $4, $5);
|
||||
# size
|
||||
} elsif ($line =~ /^\d+$/) {
|
||||
return $&;
|
||||
} else {
|
||||
die "bad input line: $line";
|
||||
}
|
||||
}
|
||||
|
||||
sub relative_change {
|
||||
my ($r, $firstr) = @_;
|
||||
if ($firstr > 0) {
|
||||
return sprintf "%+.1f%%", 100.0*($r-$firstr)/$firstr;
|
||||
} elsif ($r == 0) {
|
||||
return "=";
|
||||
} else {
|
||||
return "+inf";
|
||||
}
|
||||
}
|
||||
|
||||
sub format_times {
|
||||
my ($r, $u, $s, $firstr) = @_;
|
||||
# no value means we did not finish the test
|
||||
if (!defined $r) {
|
||||
return "<missing>";
|
||||
}
|
||||
# a single value means we have a size, not times
|
||||
if (!defined $u) {
|
||||
return format_size($r, $firstr);
|
||||
}
|
||||
# otherwise, we have real/user/system times
|
||||
my $out = sprintf "%.2f(%.2f+%.2f)", $r, $u, $s;
|
||||
$out .= ' ' . relative_change($r, $firstr) if defined $firstr;
|
||||
return $out;
|
||||
}
|
||||
|
||||
sub usage {
|
||||
print <<EOT;
|
||||
./aggregate.perl [options] [--] [<dir_or_rev>...] [--] [<test_script>...] >
|
||||
|
||||
Options:
|
||||
--codespeed * Format output for Codespeed
|
||||
--reponame <str> * Send given reponame to codespeed
|
||||
--sort-by <str> * Sort output (only "regression" criteria is supported)
|
||||
--subsection <str> * Use results from given subsection
|
||||
|
||||
EOT
|
||||
exit(1);
|
||||
}
|
||||
|
||||
sub human_size {
|
||||
my $n = shift;
|
||||
my @units = ('', qw(K M G));
|
||||
while ($n > 900 && @units > 1) {
|
||||
$n /= 1000;
|
||||
shift @units;
|
||||
}
|
||||
return $n unless length $units[0];
|
||||
return sprintf '%.1f%s', $n, $units[0];
|
||||
}
|
||||
|
||||
sub format_size {
|
||||
my ($size, $first) = @_;
|
||||
# match the width of a time: 0.00(0.00+0.00)
|
||||
my $out = sprintf '%15s', human_size($size);
|
||||
$out .= ' ' . relative_change($size, $first) if defined $first;
|
||||
return $out;
|
||||
}
|
||||
|
||||
my (@dirs, %dirnames, %dirabbrevs, %prefixes, @tests,
|
||||
$codespeed, $sortby, $subsection, $reponame);
|
||||
|
||||
Getopt::Long::Configure qw/ require_order /;
|
||||
|
||||
my $rc = GetOptions("codespeed" => \$codespeed,
|
||||
"reponame=s" => \$reponame,
|
||||
"sort-by=s" => \$sortby,
|
||||
"subsection=s" => \$subsection);
|
||||
usage() unless $rc;
|
||||
|
||||
while (scalar @ARGV) {
|
||||
my $arg = $ARGV[0];
|
||||
my $dir;
|
||||
my $prefix = '';
|
||||
last if -f $arg or $arg eq "--";
|
||||
if (! -d $arg) {
|
||||
my $rev = Git::command_oneline(qw(rev-parse --verify), $arg);
|
||||
$dir = "build/".$rev;
|
||||
} elsif ($arg eq '.') {
|
||||
$dir = '.';
|
||||
} else {
|
||||
$dir = realpath($arg);
|
||||
$dirnames{$dir} = $dir;
|
||||
$prefix .= 'bindir';
|
||||
}
|
||||
push @dirs, $dir;
|
||||
$dirnames{$dir} ||= $arg;
|
||||
$prefix .= $dir;
|
||||
$prefix =~ tr/^a-zA-Z0-9/_/c;
|
||||
$prefixes{$dir} = $prefix . '.';
|
||||
shift @ARGV;
|
||||
}
|
||||
|
||||
if (not @dirs) {
|
||||
@dirs = ('.');
|
||||
}
|
||||
$dirnames{'.'} = $dirabbrevs{'.'} = "this tree";
|
||||
$prefixes{'.'} = '';
|
||||
|
||||
shift @ARGV if scalar @ARGV and $ARGV[0] eq "--";
|
||||
|
||||
@tests = @ARGV;
|
||||
if (not @tests) {
|
||||
@tests = glob "p????-*.sh";
|
||||
}
|
||||
|
||||
my $resultsdir = "test-results";
|
||||
|
||||
if (! $subsection and
|
||||
exists $ENV{GIT_PERF_SUBSECTION} and
|
||||
$ENV{GIT_PERF_SUBSECTION} ne "") {
|
||||
$subsection = $ENV{GIT_PERF_SUBSECTION};
|
||||
}
|
||||
|
||||
if ($subsection) {
|
||||
$resultsdir .= "/" . $subsection;
|
||||
}
|
||||
|
||||
my @subtests;
|
||||
my %shorttests;
|
||||
for my $t (@tests) {
|
||||
$t =~ s{(?:.*/)?(p(\d+)-[^/]+)\.sh$}{$1} or die "bad test name: $t";
|
||||
my $n = $2;
|
||||
my $fname = "$resultsdir/$t.subtests";
|
||||
open my $fp, "<", $fname or die "cannot open $fname: $!";
|
||||
for (<$fp>) {
|
||||
chomp;
|
||||
/^(\d+)$/ or die "malformed subtest line: $_";
|
||||
push @subtests, "$t.$1";
|
||||
$shorttests{"$t.$1"} = "$n.$1";
|
||||
}
|
||||
close $fp or die "cannot close $fname: $!";
|
||||
}
|
||||
|
||||
sub read_descr {
|
||||
my $name = shift;
|
||||
open my $fh, "<", $name or return "<error reading description>";
|
||||
binmode $fh, ":utf8" or die "PANIC on binmode: $!";
|
||||
my $line = <$fh>;
|
||||
close $fh or die "cannot close $name";
|
||||
chomp $line;
|
||||
return $line;
|
||||
}
|
||||
|
||||
sub have_duplicate {
|
||||
my %seen;
|
||||
for (@_) {
|
||||
return 1 if exists $seen{$_};
|
||||
$seen{$_} = 1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
sub have_slash {
|
||||
for (@_) {
|
||||
return 1 if m{/};
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub display_dir {
|
||||
my ($d) = @_;
|
||||
return exists $dirabbrevs{$d} ? $dirabbrevs{$d} : $dirnames{$d};
|
||||
}
|
||||
|
||||
sub print_default_results {
|
||||
my %descrs;
|
||||
my $descrlen = 4; # "Test"
|
||||
for my $t (@subtests) {
|
||||
$descrs{$t} = $shorttests{$t}.": ".read_descr("$resultsdir/$t.descr");
|
||||
$descrlen = length $descrs{$t} if length $descrs{$t}>$descrlen;
|
||||
}
|
||||
|
||||
my %newdirabbrevs = %dirabbrevs;
|
||||
while (!have_duplicate(values %newdirabbrevs)) {
|
||||
%dirabbrevs = %newdirabbrevs;
|
||||
last if !have_slash(values %dirabbrevs);
|
||||
%newdirabbrevs = %dirabbrevs;
|
||||
for (values %newdirabbrevs) {
|
||||
s{^[^/]*/}{};
|
||||
}
|
||||
}
|
||||
|
||||
my %times;
|
||||
my @colwidth = ((0)x@dirs);
|
||||
for my $i (0..$#dirs) {
|
||||
my $w = length display_dir($dirs[$i]);
|
||||
$colwidth[$i] = $w if $w > $colwidth[$i];
|
||||
}
|
||||
for my $t (@subtests) {
|
||||
my $firstr;
|
||||
for my $i (0..$#dirs) {
|
||||
my $d = $dirs[$i];
|
||||
my $base = "$resultsdir/$prefixes{$d}$t";
|
||||
$times{$prefixes{$d}.$t} = [];
|
||||
foreach my $type (qw(times size)) {
|
||||
if (-e "$base.$type") {
|
||||
$times{$prefixes{$d}.$t} = [get_times("$base.$type")];
|
||||
last;
|
||||
}
|
||||
}
|
||||
my ($r,$u,$s) = @{$times{$prefixes{$d}.$t}};
|
||||
my $w = length format_times($r,$u,$s,$firstr);
|
||||
$colwidth[$i] = $w if $w > $colwidth[$i];
|
||||
$firstr = $r unless defined $firstr;
|
||||
}
|
||||
}
|
||||
my $totalwidth = 3*@dirs+$descrlen;
|
||||
$totalwidth += $_ for (@colwidth);
|
||||
|
||||
printf "%-${descrlen}s", "Test";
|
||||
for my $i (0..$#dirs) {
|
||||
printf " %-$colwidth[$i]s", display_dir($dirs[$i]);
|
||||
}
|
||||
print "\n";
|
||||
print "-"x$totalwidth, "\n";
|
||||
for my $t (@subtests) {
|
||||
printf "%-${descrlen}s", $descrs{$t};
|
||||
my $firstr;
|
||||
for my $i (0..$#dirs) {
|
||||
my $d = $dirs[$i];
|
||||
my ($r,$u,$s) = @{$times{$prefixes{$d}.$t}};
|
||||
printf " %-$colwidth[$i]s", format_times($r,$u,$s,$firstr);
|
||||
$firstr = $r unless defined $firstr;
|
||||
}
|
||||
print "\n";
|
||||
}
|
||||
}
|
||||
|
||||
sub print_sorted_results {
|
||||
my ($sortby) = @_;
|
||||
|
||||
if ($sortby ne "regression") {
|
||||
print "Only 'regression' is supported as '--sort-by' argument\n";
|
||||
usage();
|
||||
}
|
||||
|
||||
my @evolutions;
|
||||
for my $t (@subtests) {
|
||||
my ($prevr, $prevu, $prevs, $prevrev);
|
||||
for my $i (0..$#dirs) {
|
||||
my $d = $dirs[$i];
|
||||
my ($r, $u, $s) = get_times("$resultsdir/$prefixes{$d}$t.times");
|
||||
if ($i > 0 and defined $r and defined $prevr and $prevr > 0) {
|
||||
my $percent = 100.0 * ($r - $prevr) / $prevr;
|
||||
push @evolutions, { "percent" => $percent,
|
||||
"test" => $t,
|
||||
"prevrev" => $prevrev,
|
||||
"rev" => $d,
|
||||
"prevr" => $prevr,
|
||||
"r" => $r,
|
||||
"prevu" => $prevu,
|
||||
"u" => $u,
|
||||
"prevs" => $prevs,
|
||||
"s" => $s};
|
||||
}
|
||||
($prevr, $prevu, $prevs, $prevrev) = ($r, $u, $s, $d);
|
||||
}
|
||||
}
|
||||
|
||||
my @sorted_evolutions = sort { $b->{percent} <=> $a->{percent} } @evolutions;
|
||||
|
||||
for my $e (@sorted_evolutions) {
|
||||
printf "%+.1f%%", $e->{percent};
|
||||
print " " . $e->{test};
|
||||
print " " . format_times($e->{prevr}, $e->{prevu}, $e->{prevs});
|
||||
print " " . format_times($e->{r}, $e->{u}, $e->{s});
|
||||
print " " . display_dir($e->{prevrev});
|
||||
print " " . display_dir($e->{rev});
|
||||
print "\n";
|
||||
}
|
||||
}
|
||||
|
||||
sub print_codespeed_results {
|
||||
my ($subsection) = @_;
|
||||
|
||||
my $project = "Git";
|
||||
|
||||
my $executable = `uname -s -m`;
|
||||
chomp $executable;
|
||||
|
||||
if ($subsection) {
|
||||
$executable .= ", " . $subsection;
|
||||
}
|
||||
|
||||
my $environment;
|
||||
if ($reponame) {
|
||||
$environment = $reponame;
|
||||
} elsif (exists $ENV{GIT_PERF_REPO_NAME} and $ENV{GIT_PERF_REPO_NAME} ne "") {
|
||||
$environment = $ENV{GIT_PERF_REPO_NAME};
|
||||
} else {
|
||||
$environment = `uname -r`;
|
||||
chomp $environment;
|
||||
}
|
||||
|
||||
my @data;
|
||||
|
||||
for my $t (@subtests) {
|
||||
for my $d (@dirs) {
|
||||
my $commitid = $prefixes{$d};
|
||||
$commitid =~ s/^build_//;
|
||||
$commitid =~ s/\.$//;
|
||||
my ($result_value, $u, $s) = get_times("$resultsdir/$prefixes{$d}$t.times");
|
||||
|
||||
my %vals = (
|
||||
"commitid" => $commitid,
|
||||
"project" => $project,
|
||||
"branch" => $dirnames{$d},
|
||||
"executable" => $executable,
|
||||
"benchmark" => $shorttests{$t} . " " . read_descr("$resultsdir/$t.descr"),
|
||||
"environment" => $environment,
|
||||
"result_value" => $result_value,
|
||||
);
|
||||
push @data, \%vals;
|
||||
}
|
||||
}
|
||||
|
||||
require JSON;
|
||||
print JSON::to_json(\@data, {utf8 => 1, pretty => 1, canonical => 1}), "\n";
|
||||
}
|
||||
|
||||
binmode STDOUT, ":utf8" or die "PANIC on binmode: $!";
|
||||
|
||||
if ($codespeed) {
|
||||
print_codespeed_results($subsection);
|
||||
} elsif (defined $sortby) {
|
||||
print_sorted_results($sortby);
|
||||
} else {
|
||||
print_default_results();
|
||||
}
|
||||
Loading…
Add table
Add a link
Reference in a new issue