diff options
| -rwxr-xr-x | selftest/filter-xfail.pl | 162 |
1 files changed, 162 insertions, 0 deletions
diff --git a/selftest/filter-xfail.pl b/selftest/filter-xfail.pl new file mode 100755 index 00000000000..0e0c4e22bca --- /dev/null +++ b/selftest/filter-xfail.pl @@ -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; |