1 files changed, 78 insertions, 28 deletions

diff --git a/t/perf/aggregate.perl b/t/perf/aggregate.perl
index 821cf1498b..bc865160e7 100755
--- a/t/perf/aggregate.perl
+++ b/t/perf/aggregate.perl
@@ -4,6 +4,7 @@ use lib '../../perl/build/lib';
 use strict;
 use warnings;
 use JSON;
+use Getopt::Long;
 use Git;
 
 sub get_times {
@@ -36,34 +37,34 @@ sub format_times {
 	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);
+}
+
 my (@dirs, %dirnames, %dirabbrevs, %prefixes, @tests,
-    $codespeed, $subsection, $reponame);
+    $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;
-	if ($arg eq "--codespeed") {
-		$codespeed = 1;
-		shift @ARGV;
-		next;
-	}
-	if ($arg eq "--subsection") {
-		shift @ARGV;
-		$subsection = $ARGV[0];
-		shift @ARGV;
-		if (! $subsection) {
-			die "empty subsection";
-		}
-		next;
-	}
-	if ($arg eq "--reponame") {
-		shift @ARGV;
-		$reponame = $ARGV[0];
-		shift @ARGV;
-		if (! $reponame) {
-			die "empty reponame";
-		}
-		next;
-	}
 	last if -f $arg or $arg eq "--";
 	if (! -d $arg) {
 		my $rev = Git::command_oneline(qw(rev-parse --verify), $arg);
@@ -147,6 +148,11 @@ sub have_slash {
 	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"
@@ -168,8 +174,7 @@ sub print_default_results {
 	my %times;
 	my @colwidth = ((0)x@dirs);
 	for my $i (0..$#dirs) {
-		my $d = $dirs[$i];
-		my $w = length (exists $dirabbrevs{$d} ? $dirabbrevs{$d} : $dirnames{$d});
+		my $w = length display_dir($dirs[$i]);
 		$colwidth[$i] = $w if $w > $colwidth[$i];
 	}
 	for my $t (@subtests) {
@@ -188,8 +193,7 @@ sub print_default_results {
 
 	printf "%-${descrlen}s", "Test";
 	for my $i (0..$#dirs) {
-		my $d = $dirs[$i];
-		printf "   %-$colwidth[$i]s", (exists $dirabbrevs{$d} ? $dirabbrevs{$d} : $dirnames{$d});
+		printf "   %-$colwidth[$i]s", display_dir($dirs[$i]);
 	}
 	print "\n";
 	print "-"x$totalwidth, "\n";
@@ -206,6 +210,50 @@ sub print_default_results {
 	}
 }
 
+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) = @_;
 
@@ -260,6 +308,8 @@ 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();
 }