33use lib ' ../../perl/blib/lib' ;
44use strict;
55use warnings;
6+ use JSON;
67use Git;
78
89sub get_times {
@@ -35,10 +36,15 @@ sub format_times {
3536 return $out ;
3637}
3738
38- my (@dirs , %dirnames , %dirabbrevs , %prefixes , @tests );
39+ my (@dirs , %dirnames , %dirabbrevs , %prefixes , @tests , $codespeed );
3940while (scalar @ARGV ) {
4041 my $arg = $ARGV [0];
4142 my $dir ;
43+ if ($arg eq " --codespeed" ) {
44+ $codespeed = 1;
45+ shift @ARGV ;
46+ next ;
47+ }
4248 last if -f $arg or $arg eq " --" ;
4349 if (! -d $arg ) {
4450 my $rev = Git::command_oneline(qw( rev-parse --verify) , $arg );
@@ -70,8 +76,10 @@ sub format_times {
7076}
7177
7278my $resultsdir = " test-results" ;
73- if ($ENV {GIT_PERF_SUBSECTION } ne " " ) {
79+ my $results_section = " " ;
80+ if (exists $ENV {GIT_PERF_SUBSECTION } and $ENV {GIT_PERF_SUBSECTION } ne " " ) {
7481 $resultsdir .= " /" . $ENV {GIT_PERF_SUBSECTION };
82+ $results_section = $ENV {GIT_PERF_SUBSECTION };
7583}
7684
7785my @subtests ;
@@ -100,13 +108,6 @@ sub read_descr {
100108 return $line ;
101109}
102110
103- my %descrs ;
104- my $descrlen = 4; # "Test"
105- for my $t (@subtests ) {
106- $descrs {$t } = $shorttests {$t }." : " .read_descr(" $resultsdir /$t .descr" );
107- $descrlen = length $descrs {$t } if length $descrs {$t }>$descrlen ;
108- }
109-
110111sub have_duplicate {
111112 my %seen ;
112113 for (@_ ) {
@@ -122,54 +123,117 @@ sub have_slash {
122123 return 0;
123124}
124125
125- my %newdirabbrevs = %dirabbrevs ;
126- while (!have_duplicate(values %newdirabbrevs )) {
127- %dirabbrevs = %newdirabbrevs ;
128- last if !have_slash(values %dirabbrevs );
129- %newdirabbrevs = %dirabbrevs ;
130- for (values %newdirabbrevs ) {
131- s { ^[^/]*/} {} ;
126+ sub print_default_results {
127+ my %descrs ;
128+ my $descrlen = 4; # "Test"
129+ for my $t (@subtests ) {
130+ $descrs {$t } = $shorttests {$t }." : " .read_descr(" $resultsdir /$t .descr" );
131+ $descrlen = length $descrs {$t } if length $descrs {$t }>$descrlen ;
132132 }
133- }
134133
135- my %times ;
136- my @colwidth = ((0)x@dirs );
137- for my $i (0..$#dirs ) {
138- my $d = $dirs [$i ];
139- my $w = length (exists $dirabbrevs {$d } ? $dirabbrevs {$d } : $dirnames {$d });
140- $colwidth [$i ] = $w if $w > $colwidth [$i ];
141- }
142- for my $t (@subtests ) {
143- my $firstr ;
134+ my %newdirabbrevs = %dirabbrevs ;
135+ while (!have_duplicate(values %newdirabbrevs )) {
136+ %dirabbrevs = %newdirabbrevs ;
137+ last if !have_slash(values %dirabbrevs );
138+ %newdirabbrevs = %dirabbrevs ;
139+ for (values %newdirabbrevs ) {
140+ s { ^[^/]*/} {} ;
141+ }
142+ }
143+
144+ my %times ;
145+ my @colwidth = ((0)x@dirs );
144146 for my $i (0..$#dirs ) {
145147 my $d = $dirs [$i ];
146- $times {$prefixes {$d }.$t } = [get_times(" $resultsdir /$prefixes {$d }$t .times" )];
147- my ($r ,$u ,$s ) = @{$times {$prefixes {$d }.$t }};
148- my $w = length format_times($r ,$u ,$s ,$firstr );
148+ my $w = length (exists $dirabbrevs {$d } ? $dirabbrevs {$d } : $dirnames {$d });
149149 $colwidth [$i ] = $w if $w > $colwidth [$i ];
150- $firstr = $r unless defined $firstr ;
151150 }
152- }
153- my $totalwidth = 3*@dirs +$descrlen ;
154- $totalwidth += $_ for (@colwidth );
155-
156- binmode STDOUT , " :utf8" or die " PANIC on binmode: $! " ;
151+ for my $t (@subtests ) {
152+ my $firstr ;
153+ for my $i (0..$#dirs ) {
154+ my $d = $dirs [$i ];
155+ $times {$prefixes {$d }.$t } = [get_times(" $resultsdir /$prefixes {$d }$t .times" )];
156+ my ($r ,$u ,$s ) = @{$times {$prefixes {$d }.$t }};
157+ my $w = length format_times($r ,$u ,$s ,$firstr );
158+ $colwidth [$i ] = $w if $w > $colwidth [$i ];
159+ $firstr = $r unless defined $firstr ;
160+ }
161+ }
162+ my $totalwidth = 3*@dirs +$descrlen ;
163+ $totalwidth += $_ for (@colwidth );
157164
158- printf " %-${descrlen} s" , " Test" ;
159- for my $i (0..$#dirs ) {
160- my $d = $dirs [$i ];
161- printf " %-$colwidth [$i ]s" , (exists $dirabbrevs {$d } ? $dirabbrevs {$d } : $dirnames {$d });
162- }
163- print " \n " ;
164- print " -" x$totalwidth , " \n " ;
165- for my $t (@subtests ) {
166- printf " %-${descrlen} s" , $descrs {$t };
167- my $firstr ;
165+ printf " %-${descrlen} s" , " Test" ;
168166 for my $i (0..$#dirs ) {
169167 my $d = $dirs [$i ];
170- my ($r ,$u ,$s ) = @{$times {$prefixes {$d }.$t }};
171- printf " %-$colwidth [$i ]s" , format_times($r ,$u ,$s ,$firstr );
172- $firstr = $r unless defined $firstr ;
168+ printf " %-$colwidth [$i ]s" , (exists $dirabbrevs {$d } ? $dirabbrevs {$d } : $dirnames {$d });
173169 }
174170 print " \n " ;
171+ print " -" x$totalwidth , " \n " ;
172+ for my $t (@subtests ) {
173+ printf " %-${descrlen} s" , $descrs {$t };
174+ my $firstr ;
175+ for my $i (0..$#dirs ) {
176+ my $d = $dirs [$i ];
177+ my ($r ,$u ,$s ) = @{$times {$prefixes {$d }.$t }};
178+ printf " %-$colwidth [$i ]s" , format_times($r ,$u ,$s ,$firstr );
179+ $firstr = $r unless defined $firstr ;
180+ }
181+ print " \n " ;
182+ }
183+ }
184+
185+ sub print_codespeed_results {
186+ my ($results_section ) = @_ ;
187+
188+ my $project = " Git" ;
189+
190+ my $executable = ` uname -s -m` ;
191+ chomp $executable ;
192+
193+ if ($results_section ne " " ) {
194+ $executable .= " , " . $results_section ;
195+ }
196+
197+ my $environment ;
198+ if (exists $ENV {GIT_PERF_REPO_NAME } and $ENV {GIT_PERF_REPO_NAME } ne " " ) {
199+ $environment = $ENV {GIT_PERF_REPO_NAME };
200+ } elsif (exists $ENV {GIT_TEST_INSTALLED } and $ENV {GIT_TEST_INSTALLED } ne " " ) {
201+ $environment = $ENV {GIT_TEST_INSTALLED };
202+ $environment =~ s | /bin-wrappers$|| ;
203+ } else {
204+ $environment = ` uname -r` ;
205+ chomp $environment ;
206+ }
207+
208+ my @data ;
209+
210+ for my $t (@subtests ) {
211+ for my $d (@dirs ) {
212+ my $commitid = $prefixes {$d };
213+ $commitid =~ s / ^build_// ;
214+ $commitid =~ s /\. $// ;
215+ my ($result_value , $u , $s ) = get_times(" $resultsdir /$prefixes {$d }$t .times" );
216+
217+ my %vals = (
218+ " commitid" => $commitid ,
219+ " project" => $project ,
220+ " branch" => $dirnames {$d },
221+ " executable" => $executable ,
222+ " benchmark" => $shorttests {$t } . " " . read_descr(" $resultsdir /$t .descr" ),
223+ " environment" => $environment ,
224+ " result_value" => $result_value ,
225+ );
226+ push @data , \%vals ;
227+ }
228+ }
229+
230+ print to_json(\@data , {utf8 => 1, pretty => 1}), " \n " ;
231+ }
232+
233+ binmode STDOUT , " :utf8" or die " PANIC on binmode: $! " ;
234+
235+ if ($codespeed ) {
236+ print_codespeed_results($results_section );
237+ } else {
238+ print_default_results();
175239}
0 commit comments