summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--selftest/Subunit.pm8
-rw-r--r--selftest/Subunit/Filter.pm133
-rwxr-xr-xselftest/filter-subunit.pl113
-rw-r--r--selftest/output/buildfarm.pm4
-rw-r--r--selftest/output/html.pm31
-rw-r--r--selftest/output/subunit.pm2
-rwxr-xr-xselftest/selftest.pl7
7 files changed, 164 insertions, 134 deletions
diff --git a/selftest/Subunit.pm b/selftest/Subunit.pm
index 4fddeec8b1..71d65f0ee5 100644
--- a/selftest/Subunit.pm
+++ b/selftest/Subunit.pm
@@ -38,7 +38,7 @@ sub parse_results($$$$)
$msg_ops->start_test($1);
push (@$open_tests, $1);
} elsif (/^time: (\d+)-(\d+)-(\d+) (\d+):(\d+):(\d+)Z\n/) {
- $msg_ops->report_time(mktime($6, $5, $4, $3, $2, $1));
+ $msg_ops->report_time(mktime($6, $5, $4, $3, $2, $1-1900));
} elsif (/^(success|successful|failure|fail|skip|knownfail|error|xfail|skip-testsuite|testsuite-failure|testsuite-success|testsuite-error): (.*?)( \[)?([ \t]*)\n/) {
$msg_ops->control_msg($_);
my $result = $1;
@@ -197,11 +197,11 @@ sub end_testsuite($$;$)
my $result = shift;
my $reason = shift;
if ($reason) {
- print "testsuite-$result: $name [";
- print "$reason";
+ print "testsuite-$result: $name [\n";
+ print "$reason\n";
print "]\n";
} else {
- print "$result: $name\n";
+ print "testsuite-$result: $name\n";
}
}
diff --git a/selftest/Subunit/Filter.pm b/selftest/Subunit/Filter.pm
new file mode 100644
index 0000000000..799b5dd7fb
--- /dev/null
+++ b/selftest/Subunit/Filter.pm
@@ -0,0 +1,133 @@
+#!/usr/bin/perl
+# Filter a subunit stream
+# Copyright (C) Jelmer Vernooij <jelmer@samba.org>
+# Published under the GNU GPL, v3 or later
+
+package Subunit::Filter;
+
+use strict;
+
+sub read_test_regexes($)
+{
+ my ($name) = @_;
+ my @ret = ();
+ open(LF, "<$name") or die("unable to read $name: $!");
+ while (<LF>) {
+ chomp;
+ next if (/^#/);
+ if (/^(.*?)([ \t]+)\#([\t ]*)(.*?)$/) {
+ push (@ret, [$1, $4]);
+ } else {
+ s/^(.*?)([ \t]+)\#([\t ]*)(.*?)$//;
+ push (@ret, [$_, undef]);
+ }
+ }
+ close(LF);
+ return @ret;
+}
+
+sub find_in_list($$)
+{
+ my ($list, $fullname) = @_;
+
+ foreach (@$list) {
+ if ($fullname =~ /$$_[0]/) {
+ return ($$_[1]) if ($$_[1]);
+ return "";
+ }
+ }
+
+ return undef;
+}
+
+my $statistics = {
+ SUITES_FAIL => 0,
+
+ TESTS_UNEXPECTED_OK => 0,
+ TESTS_EXPECTED_OK => 0,
+ TESTS_UNEXPECTED_FAIL => 0,
+ TESTS_EXPECTED_FAIL => 0,
+ TESTS_ERROR => 0,
+ TESTS_SKIP => 0,
+};
+
+sub control_msg()
+{
+ # We regenerate control messages, so ignore this
+}
+
+sub report_time($$)
+{
+ my ($self, $time) = @_;
+ Subunit::report_time($time);
+}
+
+sub output_msg($$)
+{
+ my ($self, $msg) = @_;
+ print $msg;
+}
+
+sub start_test($$)
+{
+ my ($self, $testname) = @_;
+
+ if (defined($self->{prefix})) {
+ $testname = $self->{prefix}.$testname;
+ }
+
+ Subunit::start_test($testname);
+}
+
+sub end_test($$$$$)
+{
+ my ($self, $testname, $result, $unexpected, $reason) = @_;
+
+ if (defined($self->{prefix})) {
+ $testname = $self->{prefix}.$testname;
+ }
+
+ if (($result eq "fail" or $result eq "failure") and not $unexpected) { $result = "xfail"; }
+ my $xfail_reason = find_in_list($self->{expected_failures}, $testname);
+ if (defined($xfail_reason) and ($result eq "fail" or $result eq "failure")) {
+ $result = "xfail";
+ $reason .= $xfail_reason;
+ }
+
+ Subunit::end_test($testname, $result, $reason);
+}
+
+sub skip_testsuite($;$)
+{
+ Subunit::skip_testsuite(@_);
+}
+
+sub start_testsuite($;$)
+{
+ my ($self, $name) = @_;
+ Subunit::start_testsuite($name);
+}
+
+sub end_testsuite($$;$)
+{
+ my ($self, $name, $result, $reason) = @_;
+ Subunit::end_testsuite($name, $result, $reason);
+}
+
+sub testsuite_count($$)
+{
+ my ($self, $count) = @_;
+ Subunit::testsuite_count($count);
+}
+
+sub new {
+ my ($class, $prefix, $expected_failures) = @_;
+
+ my $self = {
+ prefix => $prefix,
+ expected_failures => $expected_failures,
+ };
+ bless($self, $class);
+}
+
+1;
diff --git a/selftest/filter-subunit.pl b/selftest/filter-subunit.pl
index b7a72217f3..cbc078765e 100755
--- a/selftest/filter-subunit.pl
+++ b/selftest/filter-subunit.pl
@@ -52,12 +52,12 @@ Jelmer Vernooij
=cut
-
use Getopt::Long;
use strict;
use FindBin qw($RealBin $Script);
use lib "$RealBin";
use Subunit qw(parse_results);
+use Subunit::Filter;
my $opt_expected_failures = undef;
my $opt_help = 0;
@@ -76,47 +76,8 @@ if ($opt_help) {
exit(0);
}
-sub read_test_regexes($)
-{
- my ($name) = @_;
- my @ret = ();
- open(LF, "<$name") or die("unable to read $name: $!");
- while (<LF>) {
- chomp;
- next if (/^#/);
- if (/^(.*?)([ \t]+)\#([\t ]*)(.*?)$/) {
- push (@ret, [$1, $4]);
- } else {
- s/^(.*?)([ \t]+)\#([\t ]*)(.*?)$//;
- push (@ret, [$_, undef]);
- }
- }
- close(LF);
- return @ret;
-}
-
if (defined($opt_expected_failures)) {
- @expected_failures = read_test_regexes($opt_expected_failures);
-}
-
-sub find_in_list($$)
-{
- my ($list, $fullname) = @_;
-
- foreach (@$list) {
- if ($fullname =~ /$$_[0]/) {
- return ($$_[1]) if ($$_[1]);
- return "NO REASON SPECIFIED";
- }
- }
-
- return undef;
-}
-
-sub expecting_failure($)
-{
- my ($name) = @_;
- return find_in_list(\@expected_failures, $name);
+ @expected_failures = Subunit::Filter::read_test_regexes($opt_expected_failures);
}
my $statistics = {
@@ -130,75 +91,7 @@ my $statistics = {
TESTS_SKIP => 0,
};
-sub control_msg()
-{
- # We regenerate control messages, so ignore this
-}
-
-sub report_time($$)
-{
- my ($self, $time) = @_;
- Subunit::report_time($time);
-}
-
-sub output_msg($$)
-{
- my ($self, $msg) = @_;
- print $msg;
-}
-
-sub start_test($$)
-{
- my ($self, $testname) = @_;
-
- if (defined($opt_prefix)) {
- $testname = $opt_prefix.$testname;
- }
-
- Subunit::start_test($testname);
-}
-
-sub end_test($$$$$)
-{
- my ($self, $testname, $result, $unexpected, $reason) = @_;
-
- if (defined($opt_prefix)) {
- $testname = $opt_prefix.$testname;
- }
-
- if (($result eq "fail" or $result eq "failure") and not $unexpected) { $result = "xfail"; }
- if (expecting_failure($testname) and ($result eq "fail" or $result eq "failure")) {
- $result = "xfail";
- }
-
- Subunit::end_test($testname, $result, $reason);
-}
-
-sub skip_testsuite($;$)
-{
- Subunit::skip_testsuite(@_);
-}
-
-sub start_testsuite($;$)
-{
- my ($self, $name) = @_;
- Subunit::start_testsuite($name);
-}
-
-sub end_testsuite($$;$)
-{
- my ($self, $name, $result, $reason) = @_;
- Subunit::end_testsuite($name, $result, $reason);
-}
-
-sub testsuite_count($$)
-{
- my ($self, $count) = @_;
- Subunit::testsuite_count($count);
-}
-
-my $msg_ops = {};
-bless $msg_ops;
+my $msg_ops = new Subunit::Filter($opt_prefix, \@expected_failures);
parse_results($msg_ops, $statistics, *STDIN, []);
diff --git a/selftest/output/buildfarm.pm b/selftest/output/buildfarm.pm
index b2edca4b94..95c5423383 100644
--- a/selftest/output/buildfarm.pm
+++ b/selftest/output/buildfarm.pm
@@ -38,6 +38,10 @@ sub new($$$) {
bless($self, $class);
}
+sub testsuite_count($$)
+{
+}
+
sub report_time($$)
{
my ($self, $time) = @_;
diff --git a/selftest/output/html.pm b/selftest/output/html.pm
index 5b7a2301b5..8e42b65649 100644
--- a/selftest/output/html.pm
+++ b/selftest/output/html.pm
@@ -61,6 +61,10 @@ sub new($$$) {
return $self;
}
+sub testsuite_count($$)
+{
+}
+
sub print_html_header($$$)
{
my ($self, $title, $fh) = @_;
@@ -118,6 +122,7 @@ sub control_msg($$)
{
my ($self, $output) = @_;
+ # Perhaps the CSS should hide this by default?
$self->{msg} .= "<span class=\"control\">$output<br/></span>\n";
}
@@ -126,15 +131,17 @@ sub output_msg($$)
my ($self, $output) = @_;
unless (defined($self->{active_test})) {
- print TEST "$output<br/>";
+ if (defined($self->{NAME})) {
+ print TEST "$output<br/>";
+ }
} else {
$self->{msg} .= "$output<br/>";
}
}
-sub end_testsuite($$$$)
+sub end_testsuite($$$)
{
- my ($self, $name, $result, $unexpected, $reason) = @_;
+ my ($self, $name, $result, $reason) = @_;
print TEST "</table>\n";
@@ -148,12 +155,10 @@ sub end_testsuite($$$$)
print INDEX " <td class=\"testSuite\"><a href=\"$self->{HTMLFILE}\">$name</a></td>\n";
my $st = $self->{local_statistics};
- if (not $unexpected) {
- if ($result eq "failure") {
- print INDEX " <td class=\"resultExpectedFailure\">";
- } else {
- print INDEX " <td class=\"resultOk\">";
- }
+ if ($result eq "xfail") {
+ print INDEX " <td class=\"resultExpectedFailure\">";
+ } elsif ($result eq "success") {
+ print INDEX " <td class=\"resultOk\">";
} else {
print INDEX " <td class=\"resultFailure\">";
}
@@ -180,16 +185,14 @@ sub end_testsuite($$$$)
}
if ($l == 0) {
- if (not $unexpected) {
- print INDEX "OK";
- } else {
- print INDEX "FAIL";
- }
+ print INDEX uc($result);
}
print INDEX "</td>";
print INDEX "</tr>\n";
+
+ $self->{NAME} = undef;
}
sub report_time($$)
diff --git a/selftest/output/subunit.pm b/selftest/output/subunit.pm
index 6c032e6820..b543b68750 100644
--- a/selftest/output/subunit.pm
+++ b/selftest/output/subunit.pm
@@ -66,7 +66,7 @@ sub end_testsuite($$$$$$)
if ($result eq "failure" and not $unexpected) { $result = "xfail"; }
- Subunit::end_test($name, $result, $reason);
+ Subunit::end_testsuite($name, $result, $reason);
}
sub start_test($$)
diff --git a/selftest/selftest.pl b/selftest/selftest.pl
index da25943957..93a3ca27a9 100755
--- a/selftest/selftest.pl
+++ b/selftest/selftest.pl
@@ -238,14 +238,11 @@ sub run_testsuite($$$$$)
my $exitcode = $ret >> 8;
Subunit::report_time(time());
- my $reason = "Exit code was $exitcode";
- my $result;
if ($exitcode == 0) {
- $result = "success";
+ Subunit::end_testsuite($name, "success");
} else {
- $result = "failure";
+ Subunit::end_testsuite($name, "failure", "Exit code was $exitcode");
}
- Subunit::end_testsuite($name, $result, $reason);
cleanup_pcap($pcap_file, $exitcode);