@@ -37,7 +37,7 @@ sub format_times {
3737}
3838
3939my (@dirs , %dirnames , %dirabbrevs , %prefixes , @tests ,
40- $codespeed , $subsection , $reponame );
40+ $codespeed , $sortby , $ subsection , $reponame );
4141while (scalar @ARGV ) {
4242 my $arg = $ARGV [0];
4343 my $dir ;
@@ -46,6 +46,18 @@ sub format_times {
4646 shift @ARGV ;
4747 next ;
4848 }
49+ if ($arg =~ / --sort-by(?:=(.*))?/ ) {
50+ shift @ARGV ;
51+ if (defined $1 ) {
52+ $sortby = $1 ;
53+ } else {
54+ $sortby = shift @ARGV ;
55+ if (! defined $sortby ) {
56+ die " '--sort-by' requires an argument" ;
57+ }
58+ }
59+ next ;
60+ }
4961 if ($arg eq " --subsection" ) {
5062 shift @ARGV ;
5163 $subsection = $ARGV [0];
@@ -147,6 +159,11 @@ sub have_slash {
147159 return 0;
148160}
149161
162+ sub display_dir {
163+ my ($d ) = @_ ;
164+ return exists $dirabbrevs {$d } ? $dirabbrevs {$d } : $dirnames {$d };
165+ }
166+
150167sub print_default_results {
151168 my %descrs ;
152169 my $descrlen = 4; # "Test"
@@ -168,8 +185,7 @@ sub print_default_results {
168185 my %times ;
169186 my @colwidth = ((0)x@dirs );
170187 for my $i (0..$#dirs ) {
171- my $d = $dirs [$i ];
172- my $w = length (exists $dirabbrevs {$d } ? $dirabbrevs {$d } : $dirnames {$d });
188+ my $w = length display_dir($dirs [$i ]);
173189 $colwidth [$i ] = $w if $w > $colwidth [$i ];
174190 }
175191 for my $t (@subtests ) {
@@ -188,8 +204,7 @@ sub print_default_results {
188204
189205 printf " %-${descrlen} s" , " Test" ;
190206 for my $i (0..$#dirs ) {
191- my $d = $dirs [$i ];
192- printf " %-$colwidth [$i ]s" , (exists $dirabbrevs {$d } ? $dirabbrevs {$d } : $dirnames {$d });
207+ printf " %-$colwidth [$i ]s" , display_dir($dirs [$i ]);
193208 }
194209 print " \n " ;
195210 print " -" x$totalwidth , " \n " ;
@@ -206,6 +221,49 @@ sub print_default_results {
206221 }
207222}
208223
224+ sub print_sorted_results {
225+ my ($sortby ) = @_ ;
226+
227+ if ($sortby ne " regression" ) {
228+ die " only 'regression' is supported as '--sort-by' argument" ;
229+ }
230+
231+ my @evolutions ;
232+ for my $t (@subtests ) {
233+ my ($prevr , $prevu , $prevs , $prevrev );
234+ for my $i (0..$#dirs ) {
235+ my $d = $dirs [$i ];
236+ my ($r , $u , $s ) = get_times(" $resultsdir /$prefixes {$d }$t .times" );
237+ if ($i > 0 and defined $r and defined $prevr and $prevr > 0) {
238+ my $percent = 100.0 * ($r - $prevr ) / $prevr ;
239+ push @evolutions , { " percent" => $percent ,
240+ " test" => $t ,
241+ " prevrev" => $prevrev ,
242+ " rev" => $d ,
243+ " prevr" => $prevr ,
244+ " r" => $r ,
245+ " prevu" => $prevu ,
246+ " u" => $u ,
247+ " prevs" => $prevs ,
248+ " s" => $s };
249+ }
250+ ($prevr , $prevu , $prevs , $prevrev ) = ($r , $u , $s , $d );
251+ }
252+ }
253+
254+ my @sorted_evolutions = sort { $b -> {percent } <=> $a -> {percent } } @evolutions ;
255+
256+ for my $e (@sorted_evolutions ) {
257+ printf " %+.1f%%" , $e -> {percent };
258+ print " " . $e -> {test };
259+ print " " . format_times($e -> {prevr }, $e -> {prevu }, $e -> {prevs });
260+ print " " . format_times($e -> {r }, $e -> {u }, $e -> {s });
261+ print " " . display_dir($e -> {prevrev });
262+ print " " . display_dir($e -> {rev });
263+ print " \n " ;
264+ }
265+ }
266+
209267sub print_codespeed_results {
210268 my ($subsection ) = @_ ;
211269
@@ -260,6 +318,8 @@ sub print_codespeed_results {
260318
261319if ($codespeed ) {
262320 print_codespeed_results($subsection );
321+ } elsif (defined $sortby ) {
322+ print_sorted_results($sortby );
263323} else {
264324 print_default_results();
265325}
0 commit comments