about summary refs log tree commit diff
path: root/third_party/git/t/perf/aggregate.perl
diff options
context:
space:
mode:
authorVincent Ambo <mail@tazj.in>2021-09-21T10·03+0300
committerVincent Ambo <mail@tazj.in>2021-09-21T11·29+0300
commit43b1791ec601732ac31195df96781a848360a9ac (patch)
treedaae8d638343295d2f1f7da955e556ef4c958864 /third_party/git/t/perf/aggregate.perl
parent2d8e7dc9d9c38127ec4ebd13aee8e8f586a43318 (diff)
chore(3p/git): Unvendor git and track patches instead r/2903
This was vendored a long time ago under the expectation that keeping
it in sync with cgit would be easier this way, but it has proven not
to be a big issue.

On the other hand, a vendored copy of git is an annoying maintenance
burden. It is much easier to rebase the single (dottime) patch that we
have.

This removes the vendored copy of git and instead passes the git
source code to cgit via `pkgs.srcOnly`, which includes the applied
patch so that cgit can continue rendering dottime.

Change-Id: If31f62dea7ce688fd1b9050204e9378019775f2b
Diffstat (limited to 'third_party/git/t/perf/aggregate.perl')
-rwxr-xr-xthird_party/git/t/perf/aggregate.perl356
1 files changed, 0 insertions, 356 deletions
diff --git a/third_party/git/t/perf/aggregate.perl b/third_party/git/t/perf/aggregate.perl
deleted file mode 100755
index 14e4cda287d7..000000000000
--- a/third_party/git/t/perf/aggregate.perl
+++ /dev/null
@@ -1,356 +0,0 @@
-#!/usr/bin/perl
-
-use lib '../../perl/build/lib';
-use strict;
-use warnings;
-use Getopt::Long;
-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;
-}
-
-sub sane_backticks {
-	open(my $fh, '-|', @_);
-	return <$fh>;
-}
-
-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 = sane_backticks(qw(git rev-parse --verify), $arg);
-		chomp $rev;
-		$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} = [get_times("$base.result")];
-			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.result");
-			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.result");
-
-			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();
-}