selftest: Fix subunit formatting, fix years when filtering subunit

streams.

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);