selftest: Add subunit output format.
authorJelmer Vernooij <jelmer@samba.org>
Wed, 13 May 2009 17:42:41 +0000 (19:42 +0200)
committerJelmer Vernooij <jelmer@samba.org>
Wed, 3 Jun 2009 14:26:29 +0000 (16:26 +0200)
selftest/output/subunit.pm [new file with mode: 0644]
selftest/selftest.pl

diff --git a/selftest/output/subunit.pm b/selftest/output/subunit.pm
new file mode 100644 (file)
index 0000000..720fe72
--- /dev/null
@@ -0,0 +1,102 @@
+#!/usr/bin/perl
+# Subunit output for selftest
+# Copyright (C) 2009 Jelmer Vernooij <jelmer@samba.org>
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+package output::subunit;
+
+use Exporter;
+@ISA = qw(Exporter);
+
+use FindBin qw($RealBin);
+use lib "$RealBin/..";
+
+use Subunit qw(parse_results);
+
+use strict;
+
+sub new($) {
+       my ($class) = @_;
+       my $self = { };
+       bless($self, $class);
+}
+
+sub start_testsuite($$)
+{
+       my ($self, $name) = @_;
+
+       $self->{NAME} = $name;
+       
+       print "test: $self->{NAME}\n";
+}
+
+sub output_msg($$)
+{
+       my ($self, $output) = @_;
+
+       print $output;
+}
+
+sub control_msg($$)
+{
+       my ($self, $output) = @_;
+}
+
+sub end_testsuite($$$$$$)
+{
+       my ($self, $name, $result, $unexpected, $reason) = @_;
+
+       if ($result eq "failure" and not $unexpected) { $result = "xfail"; }
+
+       if ($reason) {
+               print "$result: $name [ $reason ]\n";
+       } else {
+               print "$result: $name\n";
+       }
+}
+
+sub start_test($$$)
+{
+       my ($self, $parents, $testname) = @_;
+
+       print "test: $testname\n";
+}
+
+sub end_test($$$$$)
+{
+       my ($self, $parents, $testname, $result, $unexpected, $reason) = @_;
+
+       if ($result eq "fail" and not $unexpected) { $result = "xfail"; }
+
+       if ($reason) {
+               print "$result: $testname [ $reason ]\n";
+       } else {
+               print "$result: $testname\n";
+       }
+}
+
+sub summary($)
+{
+       my ($self) = @_;
+}
+
+sub skip_testsuite($$$$)
+{
+       my ($self, $name, $reason) = @_;
+
+       print "skip: $name\n";
+}
+
+1;
index 36535235413fbb627f5f71d4eb2e2d2cffea8926..7e64208ff33626ac4e459e10ca7d7b16233bce90 100755 (executable)
@@ -686,6 +686,9 @@ if ($opt_format eq "buildfarm") {
        require output::html;
        mkdir("test-results", 0777);
        $msg_ops = new output::html("test-results", $statistics);
+} elsif ($opt_format eq "subunit") {
+       require output::subunit;
+       $msg_ops = new output::subunit();
 } else {
        die("Invalid output format '$opt_format'");
 }