diff options
| -rw-r--r-- | selftest/Subunit.pm | 8 | ||||
| -rw-r--r-- | selftest/Subunit/Filter.pm | 133 | ||||
| -rwxr-xr-x | selftest/filter-subunit.pl | 113 | ||||
| -rw-r--r-- | selftest/output/buildfarm.pm | 4 | ||||
| -rw-r--r-- | selftest/output/html.pm | 31 | ||||
| -rw-r--r-- | selftest/output/subunit.pm | 2 | ||||
| -rwxr-xr-x | selftest/selftest.pl | 7 |
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); |