2 # Filter a subunit stream
3 # Copyright (C) Jelmer Vernooij <jelmer@samba.org>
4 # Published under the GNU GPL, v3 or later
6 package Subunit::Filter;
10 sub read_test_regexes($)
14 open(LF, "<$name") or die("unable to read $name: $!");
18 if (/^(.*?)([ \t]+)\#([\t ]*)(.*?)$/) {
19 push (@ret, [$1, $4]);
21 s/^(.*?)([ \t]+)\#([\t ]*)(.*?)$//;
22 push (@ret, [$_, undef]);
31 my ($list, $fullname) = @_;
34 if ($fullname =~ /$$_[0]/) {
35 return ($$_[1]) if ($$_[1]);
45 # We regenerate control messages, so ignore this
50 my ($self, $time) = @_;
51 Subunit::report_time($time);
56 my ($self, $msg) = @_;
57 unless(defined($self->{output})) {
60 $self->{output}.=$msg;
66 my ($self, $testname) = @_;
68 if (defined($self->{prefix})) {
69 $testname = $self->{prefix}.$testname;
72 if ($self->{strip_ok_output}) {
76 Subunit::start_test($testname);
81 my ($self, $testname, $result, $unexpected, $reason) = @_;
83 if (defined($self->{prefix})) {
84 $testname = $self->{prefix}.$testname;
87 if (($result eq "fail" or $result eq "failure") and not $unexpected) {
89 $self->{xfail_added}++;
91 my $xfail_reason = find_in_list($self->{expected_failures}, $testname);
92 if (defined($xfail_reason) and ($result eq "fail" or $result eq "failure")) {
94 $self->{xfail_added}++;
95 $reason .= $xfail_reason;
98 if ($self->{strip_ok_output}) {
99 unless ($result eq "success" or $result eq "xfail" or $result eq "skip") {
100 print $self->{output}
103 $self->{output} = undef;
105 Subunit::end_test($testname, $result, $reason);
108 sub skip_testsuite($;$)
110 my ($self, $name, $reason) = @_;
111 Subunit::skip_testsuite($name, $reason);
114 sub start_testsuite($;$)
116 my ($self, $name) = @_;
117 Subunit::start_testsuite($name);
118 $self->{xfail_added} = 0;
121 sub end_testsuite($$;$)
123 my ($self, $name, $result, $reason) = @_;
124 if ($self->{xfail_added} and ($result eq "fail" or $result eq "failure")) {
128 Subunit::end_testsuite($name, $result, $reason);
131 sub testsuite_count($$)
133 my ($self, $count) = @_;
134 Subunit::testsuite_count($count);
138 my ($class, $prefix, $expected_failures, $strip_ok_output) = @_;
142 expected_failures => $expected_failures,
143 strip_ok_output => $strip_ok_output,
146 bless($self, $class);