about summary refs log tree commit diff
path: root/third_party/git/t/perf/aggregate.perl
diff options
context:
space:
mode:
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();
-}