selftest: Subunit/Filter.pm only allow expected failures without errors
[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 ($result eq "error") {
104                 $self->{error_added}++;
105         }
106
107         if ($self->{strip_ok_output}) {
108                 unless ($result eq "success" or $result eq "xfail" or $result eq "skip") {
109                         print $self->{output}
110                 }
111         }
112         $self->{output} = undef;
113
114         Subunit::end_test($testname, $result, $reason);
115 }
116
117 sub skip_testsuite($;$)
118 {
119         my ($self, $name, $reason) = @_;
120         Subunit::skip_testsuite($name, $reason);
121 }
122
123 sub start_testsuite($;$)
124 {
125         my ($self, $name) = @_;
126         Subunit::start_testsuite($name);
127         $self->{error_added} = 0;
128         $self->{fail_added} = 0;
129         $self->{xfail_added} = 0;
130 }
131
132 sub end_testsuite($$;$)
133 {
134         my ($self, $name, $result, $reason) = @_;
135         my $xfail = 0;
136
137         $xfail = 1 if ($self->{xfail_added} > 0);
138         $xfail = 0 if ($self->{fail_added} > 0);
139         $xfail = 0 if ($self->{error_added} > 0);
140
141         if ($xfail and ($result eq "fail" or $result eq "failure")) {
142                 $result = "xfail";
143         }
144
145         if ($self->{fail_added} > 0 and $result ne "failure") {
146                 $result = "failure";
147                 $reason = "Subunit/Filer Reason" unless defined($reason);
148                 $reason .= "\n failures[$self->{fail_added}]";
149         }
150
151         if ($self->{error_added} > 0 and $result ne "error") {
152                 $result = "error";
153                 $reason = "Subunit/Filer Reason" unless defined($reason);
154                 $reason .= "\n errors[$self->{error_added}]";
155         }
156
157         Subunit::end_testsuite($name, $result, $reason);
158 }
159
160 sub testsuite_count($$)
161 {
162         my ($self, $count) = @_;
163         Subunit::testsuite_count($count);
164 }
165
166 sub new {
167         my ($class, $prefix, $expected_failures, $strip_ok_output) = @_;
168
169         my $self = { 
170                 prefix => $prefix,
171                 expected_failures => $expected_failures,
172                 strip_ok_output => $strip_ok_output,
173                 xfail_added => 0,
174         };
175         bless($self, $class);
176 }
177
178 1;