summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rwxr-xr-xt/perf/aggregate.perl59
1 files changed, 58 insertions, 1 deletions
diff --git a/t/perf/aggregate.perl b/t/perf/aggregate.perl
index 890d85fa7b..48637ef64b 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, $sortby, $subsection, $reponame);
while (scalar @ARGV) {
my $arg = $ARGV[0];
my $dir;
@@ -46,6 +46,18 @@ while (scalar @ARGV) {
shift @ARGV;
next;
}
+ if ($arg =~ /--sort-by(?:=(.*))?/) {
+ shift @ARGV;
+ if (defined $1) {
+ $sortby = $1;
+ } else {
+ $sortby = shift @ARGV;
+ if (! defined $sortby) {
+ die "'--sort-by' requires an argument";
+ }
+ }
+ next;
+ }
if ($arg eq "--subsection") {
shift @ARGV;
$subsection = $ARGV[0];
@@ -209,6 +221,49 @@ sub print_default_results {
}
}
+sub print_sorted_results {
+ my ($sortby) = @_;
+
+ if ($sortby ne "regression") {
+ die "only 'regression' is supported as '--sort-by' argument";
+ }
+
+ 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 +318,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();
}