2 # Filter a subunit stream
3 # Copyright (C) Jelmer Vernooij <jelmer@samba.org>
4 # Published under the GNU GPL, v3 or later
10 filter-subunit - Filter a subunit stream
16 filter-subunit --prefix=PREFIX --known-failures=FILE < in-stream > out-stream
20 Simple Subunit stream filter that will change failures to known failures
21 based on a list of regular expressions.
29 Add the specified prefix to all test names.
31 =item I<--expected-failures>
33 Specify a file containing a list of tests that are expected to fail. Failures
34 for these tests will be counted as successes, successes will be counted as
37 The format for the file is, one entry per line:
39 TESTSUITE-NAME.TEST-NAME
41 The reason for a test can also be specified, by adding a hash sign (#) and the reason
46 selftest is licensed under the GNU General Public License L<http://www.gnu.org/licenses/gpl.html>.
58 use FindBin
qw($RealBin $Script);
60 use Subunit qw(parse_results);
62 my $opt_expected_failures = undef;
64 my $opt_prefix = undef;
65 my @expected_failures = ();
67 my $result = GetOptions
(
68 'expected-failures=s' => \
$opt_expected_failures,
69 'prefix=s' => \
$opt_prefix,
72 exit(1) if (not $result);
75 print "Usage: filter-subunit [--prefix=PREFIX] [--expected-failures=FILE]... < instream > outstream\n";
79 sub read_test_regexes
($)
83 open(LF
, "<$name") or die("unable to read $name: $!");
87 if (/^(.*?)([ \t]+)\#([\t ]*)(.*?)$/) {
88 push (@ret, [$1, $4]);
90 s/^(.*?)([ \t]+)\#([\t ]*)(.*?)$//;
91 push (@ret, [$_, undef]);
98 if (defined($opt_expected_failures)) {
99 @expected_failures = read_test_regexes
($opt_expected_failures);
104 my ($list, $fullname) = @_;
107 if ($fullname =~ /$$_[0]/) {
108 return ($$_[1]) if ($$_[1]);
109 return "NO REASON SPECIFIED";
116 sub expecting_failure
($)
119 return find_in_list
(\
@expected_failures, $name);
125 TESTS_UNEXPECTED_OK
=> 0,
126 TESTS_EXPECTED_OK
=> 0,
127 TESTS_UNEXPECTED_FAIL
=> 0,
128 TESTS_EXPECTED_FAIL
=> 0,
135 # We regenerate control messages, so ignore this
140 my ($self, $time) = @_;
141 Subunit
::report_time
($time);
146 my ($self, $msg) = @_;
152 my ($self, $testname) = @_;
154 if (defined($opt_prefix)) {
155 $testname = $opt_prefix.$testname;
158 Subunit
::start_test
($testname);
163 my ($self, $testname, $result, $unexpected, $reason) = @_;
165 if (defined($opt_prefix)) {
166 $testname = $opt_prefix.$testname;
169 if (($result eq "fail" or $result eq "failure") and not $unexpected) { $result = "xfail"; }
170 if (expecting_failure
($testname) and ($result eq "fail" or $result eq "failure")) {
174 Subunit
::end_test
($testname, $result, $reason);
177 sub skip_testsuite
($;$)
179 Subunit
::skip_testsuite
(@_);
182 sub start_testsuite
($;$)
184 my ($self, $name) = @_;
185 Subunit
::start_testsuite
($name);
188 sub end_testsuite
($$;$)
190 my ($self, $name, $result, $reason) = @_;
191 Subunit
::end_testsuite
($name, $result, $reason);
194 sub testsuite_count
($$)
196 my ($self, $count) = @_;
197 Subunit
::testsuite_count
($count);
203 parse_results
($msg_ops, $statistics, *STDIN
, []);