Allow test reporting

Comes with the default P6C reporter (install Net::HTTP first), and will use the cpan testers if Zef::CPANReporter is installed.
ugexe · May 17, 2017 · 040a9ac · 040a9ac
1 parent 8006f99
commit 040a9ac
Show file tree

Hide file tree

Showing 6 changed files with 131 additions and 27 deletions.
diff --git a/META6.json b/META6.json
@@ -28,8 +28,9 @@
         "Zef::Distribution::DependencySpecification" : "lib/Zef/Distribution/DependencySpecification.pm6",
         "Zef::Distribution::Local"                   : "lib/Zef/Distribution/Local.pm6",
 
-        "Zef::Service::FetchPath" : "lib/Zef/Service/FetchPath.pm6",
-        "Zef::Service::TAP"       : "lib/Zef/Service/TAP.pm6",
+        "Zef::Service::FetchPath"   : "lib/Zef/Service/FetchPath.pm6",
+        "Zef::Service::TAP"         : "lib/Zef/Service/TAP.pm6",
+        "Zef::Service::P6CReporter" : "lib/Zef/Service/P6CReporter.pm6",
 
         "Zef::Service::Shell::Build"  : "lib/Zef/Service/Shell/Build.pm6",
         "Zef::Service::Shell::Test"   : "lib/Zef/Service/Shell/Test.pm6",

diff --git a/lib/Zef/Report.pm6 b/lib/Zef/Report.pm6
@@ -4,23 +4,21 @@ class Zef::Report does Pluggable does Reporter {
     method report($dist, Supplier :$logger) {
         my $reporters := self.plugins.grep(*.so).cache;
 
-        my @report_enabled  = self.plugins.map(*.short-name);
-        my @report_disabled = self.backends.map(*.<short-name>).grep({ $_ ~~ none(@report_enabled) });
-
-        my $got = first *.defined, gather for $reporters -> $reporter {
+        my $reports := $reporters.map: -> $reporter {
             if ?$logger {
                 $logger.emit({ level => DEBUG, stage => REPORT, phase => START, payload => self, message => "Reporting with plugin: {$reporter.^name}" });
                 $reporter.stdout.Supply.act: -> $out { $logger.emit({ level => VERBOSE, stage => REPORT, phase => LIVE, message => $out }) }
                 $reporter.stderr.Supply.act: -> $err { $logger.emit({ level => ERROR,   stage => REPORT, phase => LIVE, message => $err }) }
             }
 
-            my $out = try $reporter.report($dist);
+            my $report = try $reporter.report($dist);
 
             $reporter.stdout.done;
             $reporter.stderr.done;
-            take $out;
+
+            $report;
         }
 
-        $got;
+        $reports;
     }
 }
diff --git a/lib/Zef/Service/P6CReporter.pm6 b/lib/Zef/Service/P6CReporter.pm6
@@ -0,0 +1,73 @@
+use v6;
+use Zef;
+
+class Zef::Service::P6CReporter does Messenger does Reporter {
+
+    method report($event) {
+        # TODO: put this into the plugin architecture
+        state $probe = (try require Net::HTTP::POST) !~~ Nil ?? True !! False;
+        once { say "!!!> Install Net::HTTP to enable p6c test reporting" unless $probe }
+        if $probe {
+            my $candi := $event.<payload>;
+
+            my $report-json = to-json({
+                :name($candi.dist.name),
+                :version(first *.defined, $candi.dist.meta<ver version>),
+                :dependencies($candi.dist.meta<depends>),
+                :metainfo($candi.dist.meta.hash),
+                :build-output($candi.^find_method('build-results') ?? $candi.build-results.Str !! Str),
+                :build-passed($candi.^find_method('build-results') ?? $candi.build-results.map(*.so).all.so !! True),
+                :test-output($candi.^find_method('test-results') ?? $candi.test-results.Str !! Str),
+                :test-passed($candi.^find_method('test-results') ?? $candi.test-results.map(*.so).all.so !! True),
+                :distro({
+                    :name($*DISTRO.name),
+                    :version($*DISTRO.version.Str),
+                    :auth($*DISTRO.auth),
+                    :release($*DISTRO.release),
+                }),
+                :kernel({
+                    :name($*KERNEL.name),
+                    :version($*KERNEL.version.Str),
+                    :auth($*KERNEL.auth),
+                    :release($*KERNEL.release),
+                    :hardware($*KERNEL.hardware),
+                    :arch($*KERNEL.arch),
+                    :bits($*KERNEL.bits),
+                }),
+                :perl({
+                    :name($*PERL.name),
+                    :version($*PERL.version.Str),
+                    :auth($*PERL.auth),
+                    :compiler({
+                        :name($*PERL.compiler.name),
+                        :version($*PERL.compiler.version.Str),
+                        :auth($*PERL.compiler.auth),
+                        :release($*PERL.compiler.release),
+                        :build-date($*PERL.compiler.build-date.Str),
+                        :codename($*PERL.compiler.codename),
+                    }),
+                }),
+                :vm({
+                    :name($*VM.name),
+                    :version($*VM.version.Str),
+                    :auth($*VM.auth),
+                    :config($*VM.config),
+                    :properties($*VM.?properties),
+                    :precomp-ext($*VM.precomp-ext),
+                    :precomp-target($*VM.precomp-target),
+                    :prefix($*VM.prefix.Str),
+                }),
+            });
+
+            my $response = ::('Net::HTTP::POST')("http://testers.perl6.org/report", body => $report-json.encode);
+            my $test-id  = try { $response.content(:force).Int };
+
+            $test-id
+                ?? $.stdout.emit("Report for {$candi.dist.identity} will be available at http://testers.p6c.org/reports/{$test-id}.html")
+                !! $.stderr.emit("Encountered problems sending test report for {$event<payload>.dist.identity}");
+
+            return $test-id;
+        }
+    }
+}
+
diff --git a/lib/Zef/Service/TAP.pm6 b/lib/Zef/Service/TAP.pm6
@@ -17,33 +17,54 @@ class Zef::Service::TAP does Tester does Messenger {
 
         my $stdout = $*OUT;
         my $stderr = $*ERR;
+        my $out-supply = $.stdout;
+        my $err-supply = $.stderr;
         my $out;
         my $err;
         my $cwd = $*CWD;
+
+        my class OUT_CAPTURE is IO::Handle {
+            method print(*@_) {
+                $out ~= @_.join("\n");
+                my $self = self;
+                $*OUT = $stdout;
+                $out-supply.emit($_) for @_;
+                $*OUT = $self;
+                True;
+            }
+            method flush {}
+        }
+
+        my class ERR_CAPTURE is IO::Handle {
+            method print(*@_) {
+                $err ~= @_.join("\n");
+                my $self = self;
+                $*ERR = $stderr;
+                $err-supply.emit($_) for @_;
+                $*ERR = $self;
+                True;
+            }
+            method flush {}
+        }
+
         my $result = try {
             require TAP;
             chdir($path);
-            my $*OUT = class {
-                also is IO::Handle;
-                method print(*@_) { $out ~= @_.join("\n") }
-                method flush {}
-            }.new;
-            my $*ERR = class {
-                also is IO::Handle;
-                method print(*@_) { $err ~= @_.join("\n") }
-                method flush {}
-            }.new;
+            $*OUT = OUT_CAPTURE.new;
+            $*ERR = ERR_CAPTURE.new;
             my @incdirs  = $path.IO.child('lib').absolute, |@includes;
             my @handlers = ::("TAP::Harness::SourceHandler::Perl6").new(:@incdirs);
             my $parser   = ::("TAP::Harness").new(:@handlers);
             my $promise  = $parser.run(@test-files>>.relative($path));
-            $promise.result;
+            my $result = $promise.result;
+            $result;
         }
+        chdir($cwd);
+
+        $out-supply.done;
+        $err-supply.done;
         $*OUT = $stdout;
         $*ERR = $stderr;
-        $.stdout.emit($out);
-        $.stderr.emit($err);
-        chdir($cwd);
 
         $result.failed == 0 && not $result.errors ?? True !! False;
     }

diff --git a/lib/Zef/Test.pm6 b/lib/Zef/Test.pm6
@@ -8,18 +8,23 @@ class Zef::Test does Pluggable {
 
         my $stdmerge;
 
+        my sub save-test-output($str) {
+            state $lock = Lock.new;
+            $lock.protect({ $stdmerge ~= $str });
+        }
+
         if ?$logger {
             $logger.emit({ level => DEBUG, stage => TEST, phase => START, payload => self, message => "Testing with plugin: {$tester.^name}" });
-            $tester.stdout.Supply.grep(*.defined).act: -> $out { $stdmerge ~= $out; $logger.emit({ level => VERBOSE, stage => TEST, phase => LIVE, message => $out }) }
-            $tester.stderr.Supply.grep(*.defined).act: -> $err { $stdmerge ~= $err; $logger.emit({ level => ERROR,   stage => TEST, phase => LIVE, message => $err }) }
+            $tester.stdout.Supply.grep(*.defined).act: -> $out { save-test-output($out); $logger.emit({ level => VERBOSE, stage => TEST, phase => LIVE, message => $out }) }
+            $tester.stderr.Supply.grep(*.defined).act: -> $err { save-test-output($err); $logger.emit({ level => ERROR,   stage => TEST, phase => LIVE, message => $err }) }
         }
 
         my @got = try $tester.test($path, :@includes);
 
         $tester.stdout.done;
         $tester.stderr.done;
 
-        @got does role :: { method Str { $stdmerge } }; # boolify for pass/fail, stringify for report
+        @got does role :: { method Str { $stdmerge } };
 
         @got;
     }

diff --git a/resources/config.json b/resources/config.json
@@ -10,9 +10,15 @@
     },
     "Report" : [
         { 
+            "short-name" : "p6ctesters",
+            "enabled" : 1,
+            "module" : "Zef::Service::P6CReporter"
+        },
+        {
             "short-name" : "cpantesters",
             "enabled" : 1,
-            "module" : "Zef::Reporter"
+            "module" : "Zef::CPANReporter",
+            "comment" : "Third party plugin - zef install Zef::Reporter::CPAN"
         }
     ],
     "Repository" : [