selftest: Fix subunit formatting, fix years when filtering subunit

streams.

diff --git a/selftest/Subunit.pm b/selftest/Subunit.pm
index 4fddeec8b131c9d6fee152dedb89ac6f448d14ee..71d65f0ee533ca7a0c6e4d2c9611b0c3f6655843 100644 (file)
--- 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->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;
                } 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) {
        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 "]\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 (file)
index 0000000..799b5dd
--- /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 b7a72217f3beccfb85a6f2575c5e3f1ebaa52458..cbc078765e43620e2367527e289163e4ea2219c1 100755 (executable)
--- a/selftest/filter-subunit.pl
+++ b/selftest/filter-subunit.pl
@@ -52,12 +52,12 @@ Jelmer Vernooij
 
 =cut
 
 
 =cut
 

-

 use Getopt::Long;
 use strict;
 use FindBin qw($RealBin $Script);
 use lib "$RealBin";
 use Subunit qw(parse_results);
 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;
 
 my $opt_expected_failures = undef;
 my $opt_help = 0;


@@ -76,47 +76,8 @@ if ($opt_help) {
        exit(0);
 }
 
        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)) {
 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 = {
 }
 
 my $statistics = {


@@ -130,75 +91,7 @@ my $statistics = {
        TESTS_SKIP => 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($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, []);
 
 
 parse_results($msg_ops, $statistics, *STDIN, []);
 

diff --git a/selftest/output/buildfarm.pm b/selftest/output/buildfarm.pm
index b2edca4b943bc0331f2a9c3e4505fa56181c5c8c..95c5423383b5be1dc296989cda96d2855b0b1d7b 100644 (file)
--- a/selftest/output/buildfarm.pm
+++ b/selftest/output/buildfarm.pm
@@ -38,6 +38,10 @@ sub new($$$) {
        bless($self, $class);
 }
 
        bless($self, $class);
 }
 

+sub testsuite_count($$)
+{
+}
+

 sub report_time($$)
 {
        my ($self, $time) = @_;
 sub report_time($$)
 {
        my ($self, $time) = @_;

diff --git a/selftest/output/html.pm b/selftest/output/html.pm
index 5b7a2301b56fd9b895af89dce91884e992fd8c28..8e42b65649ce164b000fa10bb6746b23b540a775 100644 (file)
--- a/selftest/output/html.pm
+++ b/selftest/output/html.pm
@@ -61,6 +61,10 @@ sub new($$$) {
        return $self;
 }
 
        return $self;
 }
 

+sub testsuite_count($$)
+{
+}
+

 sub print_html_header($$$)
 {
        my ($self, $title, $fh) = @_;
 sub print_html_header($$$)
 {
        my ($self, $title, $fh) = @_;


@@ -118,6 +122,7 @@ sub control_msg($$)
 {
        my ($self, $output) = @_;
 
 {
        my ($self, $output) = @_;
 

+       # Perhaps the CSS should hide this by default?

        $self->{msg} .=  "<span class=\"control\">$output<br/></span>\n";
 }
 
        $self->{msg} .=  "<span class=\"control\">$output<br/></span>\n";
 }
 


@@ -126,15 +131,17 @@ sub output_msg($$)
        my ($self, $output) = @_;
 
        unless (defined($self->{active_test})) {
        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/>";
        }
 }
 
        } 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";
 
 
        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};
 
        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\">";
        }
        } else {
                print INDEX "  <td class=\"resultFailure\">";
        }


@@ -180,16 +185,14 @@ sub end_testsuite($$$$)
        }
 
        if ($l == 0) {
        }
 
        if ($l == 0) {

-               if (not $unexpected) {
-                       print INDEX "OK";
-               } else {
-                       print INDEX "FAIL";
-               }
+               print INDEX uc($result);

        }
 
        print INDEX "</td>";
                
        print INDEX "</tr>\n";
        }
 
        print INDEX "</td>";
                
        print INDEX "</tr>\n";

+
+       $self->{NAME} = undef;

 }
 
 sub report_time($$)
 }
 
 sub report_time($$)

diff --git a/selftest/output/subunit.pm b/selftest/output/subunit.pm
index 6c032e6820b9d3c8041dc3665a40f078a9758a44..b543b687504979686ffb2a960a4522fa6a7e0ef5 100644 (file)
--- 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"; }
 
 
        if ($result eq "failure" and not $unexpected) { $result = "xfail"; }
 

-       Subunit::end_test($name, $result, $reason);
+       Subunit::end_testsuite($name, $result, $reason);

 }
 
 sub start_test($$)
 }
 
 sub start_test($$)

diff --git a/selftest/selftest.pl b/selftest/selftest.pl
index da2594395745f2ed79f10622fd3e919c7733a8b8..93a3ca27a940be37087a1656b77d3d6becb29022 100755 (executable)
--- a/selftest/selftest.pl
+++ b/selftest/selftest.pl
@@ -238,14 +238,11 @@ sub run_testsuite($$$$$)
        my $exitcode = $ret >> 8;
 
        Subunit::report_time(time());
        my $exitcode = $ret >> 8;
 
        Subunit::report_time(time());

-       my $reason = "Exit code was $exitcode";
-       my $result;

        if ($exitcode == 0) {
        if ($exitcode == 0) {

-               $result = "success";
+               Subunit::end_testsuite($name, "success");

        } else {
        } else {

-               $result = "failure";
+               Subunit::end_testsuite($name, "failure", "Exit code was $exitcode");

        }
        }

-       Subunit::end_testsuite($name, $result, $reason);

 
        cleanup_pcap($pcap_file, $exitcode);
 
 
        cleanup_pcap($pcap_file, $exitcode);