selftest: Add script to filter out known failures from a subunit stream.
authorJelmer Vernooij <jelmer@samba.org>
Wed, 3 Jun 2009 16:10:15 +0000 (18:10 +0200)
committerJelmer Vernooij <jelmer@samba.org>
Thu, 11 Jun 2009 17:59:58 +0000 (19:59 +0200)
selftest/filter-xfail.pl [new file with mode: 0755]

diff --git a/selftest/filter-xfail.pl b/selftest/filter-xfail.pl
new file mode 100755 (executable)
index 0000000..0e0c4e2
--- /dev/null
@@ -0,0 +1,162 @@
+#!/usr/bin/perl
+# Fix fail -> xfail in subunit streams based on a list of regular expressions
+# Copyright (C) Jelmer Vernooij <jelmer@samba.org>
+# Published under the GNU GPL, v3 or later
+
+=pod
+
+=head1 NAME
+
+filter-xfail - Filter known failures in a subunit stream
+
+=head1 SYNOPSIS
+
+filter-xfail --help
+
+filter-xfail --known-failures=FILE < in-stream > out-stream
+
+=head1 DESCRIPTION
+
+Simple Subunit stream filter that will change failures to known failures 
+based on a list of regular expressions.
+
+=head1 OPTIONS
+
+=over 4
+
+=item I<--expected-failures>
+
+Specify a file containing a list of tests that are expected to fail. Failures 
+for these tests will be counted as successes, successes will be counted as 
+failures.
+
+The format for the file is, one entry per line:
+
+TESTSUITE-NAME.TEST-NAME
+
+The reason for a test can also be specified, by adding a hash sign (#) and the reason 
+after the test name.
+
+=head1 LICENSE
+
+selftest is licensed under the GNU General Public License L<http://www.gnu.org/licenses/gpl.html>.
+
+
+=head1 AUTHOR
+
+Jelmer Vernooij
+
+=cut
+
+
+use Getopt::Long;
+use strict;
+use FindBin qw($RealBin $Script);
+use lib "$RealBin";
+use Subunit qw(parse_results);
+
+my $opt_expected_failures = undef;
+my @expected_failures = ();
+
+my $result = GetOptions(
+               'expected-failures=s' => \$opt_expected_failures,
+       );
+exit(1) if (not $result);
+
+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);
+}
+
+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, $parents, $testname) = @_;
+
+       Subunit::start_test($testname);
+}
+
+sub end_test($$$$$)
+{
+       my ($self, $parents, $testname, $result, $unexpected, $reason) = @_;
+
+       if (($result eq "fail" or $result eq "failure") and not $unexpected) { $result = "xfail"; }
+       my $fullname = join(".", @$parents) . ".$testname";
+       if (expecting_failure($fullname) and ($result eq "fail" or $result eq "failure")) {
+               $result = "xfail";
+       }
+
+       Subunit::end_test($testname, $result, $reason);
+}
+
+my $msg_ops = {};
+bless $msg_ops;
+
+parse_results($msg_ops, $statistics, *STDIN, sub { return 0; }, []);
+
+0;