diff options
| -rwxr-xr-x | t/perf/aggregate.perl | 59 |
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(); } |