[PATCH v1 2/2] perf/aggregate: add --sortbyregression option

[Christian Couder <christian.couder@xxxxxxxxx>]

One of the most interesting thing one can be interested
in when looking at performance test results is possible
performance regressions.

This new option makes it easy to spot such possible
regressions.

Signed-off-by: Christian Couder <chriscool@xxxxxxxxxxxxx>
---
 t/perf/aggregate.perl | 48 ++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 47 insertions(+), 1 deletion(-)

diff --git a/t/perf/aggregate.perl b/t/perf/aggregate.perl
index b9c0e3243d..9d032b286e 100755
--- a/t/perf/aggregate.perl
+++ b/t/perf/aggregate.perl
@@ -37,7 +37,7 @@ sub format_times {
 }
 
 my (@dirs, %dirnames, %dirabbrevs, %prefixes, @tests,
-    $codespeed, $subsection, $reponame);
+    $codespeed, $sortbyregression, $subsection, $reponame);
 while (scalar @ARGV) {
 	my $arg = $ARGV[0];
 	my $dir;
@@ -46,6 +46,11 @@ while (scalar @ARGV) {
 		shift @ARGV;
 		next;
 	}
+	if ($arg eq "--sortbyregression") {
+		$sortbyregression = 1;
+		shift @ARGV;
+		next;
+	}
 	if ($arg eq "--subsection") {
 		shift @ARGV;
 		$subsection = $ARGV[0];
@@ -209,6 +214,45 @@ sub print_default_results {
 	}
 }
 
+sub print_sortbyregression_results {
+	my ($subsection) = @_;
+
+	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) = @_;
 
@@ -263,6 +307,8 @@ binmode STDOUT, ":utf8" or die "PANIC on binmode: $!";
 
 if ($codespeed) {
 	print_codespeed_results($subsection);
+} elsif ($sortbyregression) {
+	print_sortbyregression_results($subsection);
 } else {
 	print_default_results();
 }
-- 
2.17.0.rc0.37.g8f476fabe9