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 ($result eq "fail" or $result eq "failure") {
99 $self->{fail_added
}++;
102 if ($self->{strip_ok_output
}) {
103 unless ($result eq "success" or $result eq "xfail" or $result eq "skip") {
104 print $self->{output
}
107 $self->{output
} = undef;
109 Subunit
::end_test
($testname, $result, $reason);
112 sub skip_testsuite
($;$)
114 my ($self, $name, $reason) = @_;
115 Subunit
::skip_testsuite
($name, $reason);
118 sub start_testsuite
($;$)
120 my ($self, $name) = @_;
121 Subunit
::start_testsuite
($name);
122 $self->{fail_added
} = 0;
123 $self->{xfail_added
} = 0;
126 sub end_testsuite
($$;$)
128 my ($self, $name, $result, $reason) = @_;
129 if ($self->{fail_added
} == 0 and $self->{xfail_added
} and
130 ($result eq "fail" or $result eq "failure")) {
134 Subunit
::end_testsuite
($name, $result, $reason);
137 sub testsuite_count
($$)
139 my ($self, $count) = @_;
140 Subunit
::testsuite_count
($count);
144 my ($class, $prefix, $expected_failures, $strip_ok_output) = @_;
148 expected_failures
=> $expected_failures,
149 strip_ok_output
=> $strip_ok_output,
152 bless($self, $class);