selftest: ignore empty lines in knownfailures
[ira/wip.git] / selftest / Subunit / Filter.pm
1 #!/usr/bin/perl
2 # Filter a subunit stream
3 # Copyright (C) Jelmer Vernooij <jelmer@samba.org>
4 # Published under the GNU GPL, v3 or later
5
6 package Subunit::Filter;
7
8 use strict;
9
10 sub read_test_regexes($)
11 {
12         my ($name) = @_;
13         my @ret = ();
14         open(LF, "<$name") or die("unable to read $name: $!");
15         while (<LF>) { 
16                 chomp; 
17                 next if (/^#/);
18                 next if (/^$/);
19                 if (/^(.*?)([ \t]+)\#([\t ]*)(.*?)$/) {
20                         push (@ret, [$1, $4]);
21                 } else {
22                         s/^(.*?)([ \t]+)\#([\t ]*)(.*?)$//;
23                         push (@ret, [$_, undef]); 
24                 }
25         }
26         close(LF);
27         return @ret;
28 }
29
30 sub find_in_list($$)
31 {
32         my ($list, $fullname) = @_;
33
34         foreach (@$list) {
35                 if ($fullname =~ /$$_[0]/) {
36                          return ($$_[1]) if ($$_[1]);
37                          return "";
38                 }
39         }
40
41         return undef;
42 }
43
44 sub control_msg()
45 {
46         # We regenerate control messages, so ignore this
47 }
48
49 sub report_time($$)
50 {
51         my ($self, $time) = @_;
52         Subunit::report_time($time);
53 }
54
55 sub output_msg($$)
56 {
57         my ($self, $msg) = @_;
58         unless(defined($self->{output})) {
59                 print $msg;
60         } else {
61                 $self->{output}.=$msg;
62         }
63 }
64
65 sub start_test($$)
66 {
67         my ($self, $testname) = @_;
68
69         if (defined($self->{prefix})) {
70                 $testname = $self->{prefix}.$testname;
71         }
72
73         if ($self->{strip_ok_output}) {
74                 $self->{output} = "";
75         }
76
77         Subunit::start_test($testname);
78 }
79
80 sub end_test($$$$$)
81 {
82         my ($self, $testname, $result, $unexpected, $reason) = @_;
83
84         if (defined($self->{prefix})) {
85                 $testname = $self->{prefix}.$testname;
86         }
87
88         if (($result eq "fail" or $result eq "failure") and not $unexpected) {
89                 $result = "xfail";
90                 $self->{xfail_added}++;
91         }
92         my $xfail_reason = find_in_list($self->{expected_failures}, $testname);
93         if (defined($xfail_reason) and ($result eq "fail" or $result eq "failure")) {
94                 $result = "xfail";
95                 $self->{xfail_added}++;
96                 $reason .= $xfail_reason;
97         }
98
99         if ($result eq "fail" or $result eq "failure") {
100                 $self->{fail_added}++;
101         }
102
103         if ($self->{strip_ok_output}) {
104                 unless ($result eq "success" or $result eq "xfail" or $result eq "skip") {
105                         print $self->{output}
106                 }
107         }
108         $self->{output} = undef;
109
110         Subunit::end_test($testname, $result, $reason);
111 }
112
113 sub skip_testsuite($;$)
114 {
115         my ($self, $name, $reason) = @_;
116         Subunit::skip_testsuite($name, $reason);
117 }
118
119 sub start_testsuite($;$)
120 {
121         my ($self, $name) = @_;
122         Subunit::start_testsuite($name);
123         $self->{fail_added} = 0;
124         $self->{xfail_added} = 0;
125 }
126
127 sub end_testsuite($$;$)
128 {
129         my ($self, $name, $result, $reason) = @_;
130         if ($self->{fail_added} == 0 and $self->{xfail_added} and
131             ($result eq "fail" or $result eq "failure")) {
132                 $result = "xfail";
133         }
134
135         Subunit::end_testsuite($name, $result, $reason);
136 }
137
138 sub testsuite_count($$)
139 {
140         my ($self, $count) = @_;
141         Subunit::testsuite_count($count);
142 }
143
144 sub new {
145         my ($class, $prefix, $expected_failures, $strip_ok_output) = @_;
146
147         my $self = { 
148                 prefix => $prefix,
149                 expected_failures => $expected_failures,
150                 strip_ok_output => $strip_ok_output,
151                 xfail_added => 0,
152         };
153         bless($self, $class);
154 }
155
156 1;