selftest: Add script to filter out known failures from a subunit stream.
[ira/wip.git] / selftest / filter-xfail.pl
1 #!/usr/bin/perl
2 # Fix fail -> xfail in subunit streams based on a list of regular expressions
3 # Copyright (C) Jelmer Vernooij <jelmer@samba.org>
4 # Published under the GNU GPL, v3 or later
5
6 =pod
7
8 =head1 NAME
9
10 filter-xfail - Filter known failures in a subunit stream
11
12 =head1 SYNOPSIS
13
14 filter-xfail --help
15
16 filter-xfail --known-failures=FILE < in-stream > out-stream
17
18 =head1 DESCRIPTION
19
20 Simple Subunit stream filter that will change failures to known failures 
21 based on a list of regular expressions.
22
23 =head1 OPTIONS
24
25 =over 4
26
27 =item I<--expected-failures>
28
29 Specify a file containing a list of tests that are expected to fail. Failures 
30 for these tests will be counted as successes, successes will be counted as 
31 failures.
32
33 The format for the file is, one entry per line:
34
35 TESTSUITE-NAME.TEST-NAME
36
37 The reason for a test can also be specified, by adding a hash sign (#) and the reason 
38 after the test name.
39
40 =head1 LICENSE
41
42 selftest is licensed under the GNU General Public License L<http://www.gnu.org/licenses/gpl.html>.
43
44
45 =head1 AUTHOR
46
47 Jelmer Vernooij
48
49 =cut
50
51
52 use Getopt::Long;
53 use strict;
54 use FindBin qw($RealBin $Script);
55 use lib "$RealBin";
56 use Subunit qw(parse_results);
57
58 my $opt_expected_failures = undef;
59 my @expected_failures = ();
60
61 my $result = GetOptions(
62                 'expected-failures=s' => \$opt_expected_failures,
63         );
64 exit(1) if (not $result);
65
66 sub read_test_regexes($)
67 {
68         my ($name) = @_;
69         my @ret = ();
70         open(LF, "<$name") or die("unable to read $name: $!");
71         while (<LF>) { 
72                 chomp; 
73                 next if (/^#/);
74                 if (/^(.*?)([ \t]+)\#([\t ]*)(.*?)$/) {
75                         push (@ret, [$1, $4]);
76                 } else {
77                         s/^(.*?)([ \t]+)\#([\t ]*)(.*?)$//;
78                         push (@ret, [$_, undef]); 
79                 }
80         }
81         close(LF);
82         return @ret;
83 }
84
85 if (defined($opt_expected_failures)) {
86         @expected_failures = read_test_regexes($opt_expected_failures);
87 }
88
89 sub find_in_list($$)
90 {
91         my ($list, $fullname) = @_;
92
93         foreach (@$list) {
94                 if ($fullname =~ /$$_[0]/) {
95                          return ($$_[1]) if ($$_[1]);
96                          return "NO REASON SPECIFIED";
97                 }
98         }
99
100         return undef;
101 }
102
103 sub expecting_failure($)
104 {
105         my ($name) = @_;
106         return find_in_list(\@expected_failures, $name);
107 }
108
109 my $statistics = {
110         SUITES_FAIL => 0,
111
112         TESTS_UNEXPECTED_OK => 0,
113         TESTS_EXPECTED_OK => 0,
114         TESTS_UNEXPECTED_FAIL => 0,
115         TESTS_EXPECTED_FAIL => 0,
116         TESTS_ERROR => 0,
117         TESTS_SKIP => 0,
118 };
119
120 sub control_msg()
121 {
122         # We regenerate control messages, so ignore this
123 }
124
125 sub report_time($$)
126 {
127         my ($self, $time) = @_;
128         Subunit::report_time($time);
129 }
130
131 sub output_msg($$)
132 {
133         my ($self, $msg) = @_;
134         print $msg;
135 }
136
137 sub start_test($$$)
138 {
139         my ($self, $parents, $testname) = @_;
140
141         Subunit::start_test($testname);
142 }
143
144 sub end_test($$$$$)
145 {
146         my ($self, $parents, $testname, $result, $unexpected, $reason) = @_;
147
148         if (($result eq "fail" or $result eq "failure") and not $unexpected) { $result = "xfail"; }
149         my $fullname = join(".", @$parents) . ".$testname";
150         if (expecting_failure($fullname) and ($result eq "fail" or $result eq "failure")) {
151                 $result = "xfail";
152         }
153
154         Subunit::end_test($testname, $result, $reason);
155 }
156
157 my $msg_ops = {};
158 bless $msg_ops;
159
160 parse_results($msg_ops, $statistics, *STDIN, sub { return 0; }, []);
161
162 0;