Sync with 2.16.2
[gitweb.git] / t / perf / aggregate.perl
index e40120848837c1ef78cf75d1724c69226823db15..821cf1498b78bbb5b43b2bda32bbcc88d580c31b 100755 (executable)
@@ -1,8 +1,9 @@
 #!/usr/bin/perl
 
-use lib '../../perl/blib/lib';
+use lib '../../perl/build/lib';
 use strict;
 use warnings;
+use JSON;
 use Git;
 
 sub get_times {
@@ -35,10 +36,34 @@ sub format_times {
        return $out;
 }
 
-my (@dirs, %dirnames, %dirabbrevs, %prefixes, @tests);
+my (@dirs, %dirnames, %dirabbrevs, %prefixes, @tests,
+    $codespeed, $subsection, $reponame);
 while (scalar @ARGV) {
        my $arg = $ARGV[0];
        my $dir;
+       if ($arg eq "--codespeed") {
+               $codespeed = 1;
+               shift @ARGV;
+               next;
+       }
+       if ($arg eq "--subsection") {
+               shift @ARGV;
+               $subsection = $ARGV[0];
+               shift @ARGV;
+               if (! $subsection) {
+                       die "empty subsection";
+               }
+               next;
+       }
+       if ($arg eq "--reponame") {
+               shift @ARGV;
+               $reponame = $ARGV[0];
+               shift @ARGV;
+               if (! $reponame) {
+                       die "empty reponame";
+               }
+               next;
+       }
        last if -f $arg or $arg eq "--";
        if (! -d $arg) {
                my $rev = Git::command_oneline(qw(rev-parse --verify), $arg);
@@ -70,8 +95,15 @@ sub format_times {
 }
 
 my $resultsdir = "test-results";
-if ($ENV{GIT_PERF_SUBSECTION} ne "") {
-       $resultsdir .= "/" . $ENV{GIT_PERF_SUBSECTION};
+
+if (! $subsection and
+    exists $ENV{GIT_PERF_SUBSECTION} and
+    $ENV{GIT_PERF_SUBSECTION} ne "") {
+       $subsection = $ENV{GIT_PERF_SUBSECTION};
+}
+
+if ($subsection) {
+       $resultsdir .= "/" . $subsection;
 }
 
 my @subtests;
@@ -100,13 +132,6 @@ sub read_descr {
        return $line;
 }
 
-my %descrs;
-my $descrlen = 4; # "Test"
-for my $t (@subtests) {
-       $descrs{$t} = $shorttests{$t}.": ".read_descr("$resultsdir/$t.descr");
-       $descrlen = length $descrs{$t} if length $descrs{$t}>$descrlen;
-}
-
 sub have_duplicate {
        my %seen;
        for (@_) {
@@ -122,54 +147,119 @@ sub have_slash {
        return 0;
 }
 
-my %newdirabbrevs = %dirabbrevs;
-while (!have_duplicate(values %newdirabbrevs)) {
-       %dirabbrevs = %newdirabbrevs;
-       last if !have_slash(values %dirabbrevs);
-       %newdirabbrevs = %dirabbrevs;
-       for (values %newdirabbrevs) {
-               s{^[^/]*/}{};
+sub print_default_results {
+       my %descrs;
+       my $descrlen = 4; # "Test"
+       for my $t (@subtests) {
+               $descrs{$t} = $shorttests{$t}.": ".read_descr("$resultsdir/$t.descr");
+               $descrlen = length $descrs{$t} if length $descrs{$t}>$descrlen;
        }
-}
 
-my %times;
-my @colwidth = ((0)x@dirs);
-for my $i (0..$#dirs) {
-       my $d = $dirs[$i];
-       my $w = length (exists $dirabbrevs{$d} ? $dirabbrevs{$d} : $dirnames{$d});
-       $colwidth[$i] = $w if $w > $colwidth[$i];
-}
-for my $t (@subtests) {
-       my $firstr;
+       my %newdirabbrevs = %dirabbrevs;
+       while (!have_duplicate(values %newdirabbrevs)) {
+               %dirabbrevs = %newdirabbrevs;
+               last if !have_slash(values %dirabbrevs);
+               %newdirabbrevs = %dirabbrevs;
+               for (values %newdirabbrevs) {
+                       s{^[^/]*/}{};
+               }
+       }
+
+       my %times;
+       my @colwidth = ((0)x@dirs);
        for my $i (0..$#dirs) {
                my $d = $dirs[$i];
-               $times{$prefixes{$d}.$t} = [get_times("$resultsdir/$prefixes{$d}$t.times")];
-               my ($r,$u,$s) = @{$times{$prefixes{$d}.$t}};
-               my $w = length format_times($r,$u,$s,$firstr);
+               my $w = length (exists $dirabbrevs{$d} ? $dirabbrevs{$d} : $dirnames{$d});
                $colwidth[$i] = $w if $w > $colwidth[$i];
-               $firstr = $r unless defined $firstr;
        }
-}
-my $totalwidth = 3*@dirs+$descrlen;
-$totalwidth += $_ for (@colwidth);
-
-binmode STDOUT, ":utf8" or die "PANIC on binmode: $!";
+       for my $t (@subtests) {
+               my $firstr;
+               for my $i (0..$#dirs) {
+                       my $d = $dirs[$i];
+                       $times{$prefixes{$d}.$t} = [get_times("$resultsdir/$prefixes{$d}$t.times")];
+                       my ($r,$u,$s) = @{$times{$prefixes{$d}.$t}};
+                       my $w = length format_times($r,$u,$s,$firstr);
+                       $colwidth[$i] = $w if $w > $colwidth[$i];
+                       $firstr = $r unless defined $firstr;
+               }
+       }
+       my $totalwidth = 3*@dirs+$descrlen;
+       $totalwidth += $_ for (@colwidth);
 
-printf "%-${descrlen}s", "Test";
-for my $i (0..$#dirs) {
-       my $d = $dirs[$i];
-       printf "   %-$colwidth[$i]s", (exists $dirabbrevs{$d} ? $dirabbrevs{$d} : $dirnames{$d});
-}
-print "\n";
-print "-"x$totalwidth, "\n";
-for my $t (@subtests) {
-       printf "%-${descrlen}s", $descrs{$t};
-       my $firstr;
+       printf "%-${descrlen}s", "Test";
        for my $i (0..$#dirs) {
                my $d = $dirs[$i];
-               my ($r,$u,$s) = @{$times{$prefixes{$d}.$t}};
-               printf "   %-$colwidth[$i]s", format_times($r,$u,$s,$firstr);
-               $firstr = $r unless defined $firstr;
+               printf "   %-$colwidth[$i]s", (exists $dirabbrevs{$d} ? $dirabbrevs{$d} : $dirnames{$d});
        }
        print "\n";
+       print "-"x$totalwidth, "\n";
+       for my $t (@subtests) {
+               printf "%-${descrlen}s", $descrs{$t};
+               my $firstr;
+               for my $i (0..$#dirs) {
+                       my $d = $dirs[$i];
+                       my ($r,$u,$s) = @{$times{$prefixes{$d}.$t}};
+                       printf "   %-$colwidth[$i]s", format_times($r,$u,$s,$firstr);
+                       $firstr = $r unless defined $firstr;
+               }
+               print "\n";
+       }
+}
+
+sub print_codespeed_results {
+       my ($subsection) = @_;
+
+       my $project = "Git";
+
+       my $executable = `uname -s -m`;
+       chomp $executable;
+
+       if ($subsection) {
+               $executable .= ", " . $subsection;
+       }
+
+       my $environment;
+       if ($reponame) {
+               $environment = $reponame;
+       } elsif (exists $ENV{GIT_PERF_REPO_NAME} and $ENV{GIT_PERF_REPO_NAME} ne "") {
+               $environment = $ENV{GIT_PERF_REPO_NAME};
+       } elsif (exists $ENV{GIT_TEST_INSTALLED} and $ENV{GIT_TEST_INSTALLED} ne "") {
+               $environment = $ENV{GIT_TEST_INSTALLED};
+               $environment =~ s|/bin-wrappers$||;
+       } else {
+               $environment = `uname -r`;
+               chomp $environment;
+       }
+
+       my @data;
+
+       for my $t (@subtests) {
+               for my $d (@dirs) {
+                       my $commitid = $prefixes{$d};
+                       $commitid =~ s/^build_//;
+                       $commitid =~ s/\.$//;
+                       my ($result_value, $u, $s) = get_times("$resultsdir/$prefixes{$d}$t.times");
+
+                       my %vals = (
+                               "commitid" => $commitid,
+                               "project" => $project,
+                               "branch" => $dirnames{$d},
+                               "executable" => $executable,
+                               "benchmark" => $shorttests{$t} . " " . read_descr("$resultsdir/$t.descr"),
+                               "environment" => $environment,
+                               "result_value" => $result_value,
+                           );
+                       push @data, \%vals;
+               }
+       }
+
+       print to_json(\@data, {utf8 => 1, pretty => 1, canonical => 1}), "\n";
+}
+
+binmode STDOUT, ":utf8" or die "PANIC on binmode: $!";
+
+if ($codespeed) {
+       print_codespeed_results($subsection);
+} else {
+       print_default_results();
 }