b7df762b1aef9c5a00e23bd4b6a7e399081671ed
[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                 if (/^(.*?)([ \t]+)\#([\t ]*)(.*?)$/) {
19                         push (@ret, [$1, $4]);
20                 } else {
21                         s/^(.*?)([ \t]+)\#([\t ]*)(.*?)$//;
22                         push (@ret, [$_, undef]); 
23                 }
24         }
25         close(LF);
26         return @ret;
27 }
28
29 sub find_in_list($$)
30 {
31         my ($list, $fullname) = @_;
32
33         foreach (@$list) {
34                 if ($fullname =~ /$$_[0]/) {
35                          return ($$_[1]) if ($$_[1]);
36                          return "";
37                 }
38         }
39
40         return undef;
41 }
42
43 sub control_msg()
44 {
45         # We regenerate control messages, so ignore this
46 }
47
48 sub report_time($$)
49 {
50         my ($self, $time) = @_;
51         Subunit::report_time($time);
52 }
53
54 sub output_msg($$)
55 {
56         my ($self, $msg) = @_;
57         unless(defined($self->{output})) {
58                 print $msg;
59         } else {
60                 $self->{output}.=$msg;
61         }
62 }
63
64 sub start_test($$)
65 {
66         my ($self, $testname) = @_;
67
68         if (defined($self->{prefix})) {
69                 $testname = $self->{prefix}.$testname;
70         }
71
72         if ($self->{strip_ok_output}) {
73                 $self->{output} = "";
74         }
75
76         Subunit::start_test($testname);
77 }
78
79 sub end_test($$$$$)
80 {
81         my ($self, $testname, $result, $unexpected, $reason) = @_;
82
83         if (defined($self->{prefix})) {
84                 $testname = $self->{prefix}.$testname;
85         }
86
87         if (($result eq "fail" or $result eq "failure") and not $unexpected) {
88                 $result = "xfail";
89                 $self->{xfail_added}++;
90         }
91         my $xfail_reason = find_in_list($self->{expected_failures}, $testname);
92         if (defined($xfail_reason) and ($result eq "fail" or $result eq "failure")) {
93                 $result = "xfail";
94                 $self->{xfail_added}++;
95                 $reason .= $xfail_reason;
96         }
97
98         if ($result eq "fail" or $result eq "failure") {
99                 $self->{fail_added}++;
100         }
101
102         if ($self->{strip_ok_output}) {
103                 unless ($result eq "success" or $result eq "xfail" or $result eq "skip") {
104                         print $self->{output}
105                 }
106         }
107         $self->{output} = undef;
108
109         Subunit::end_test($testname, $result, $reason);
110 }
111
112 sub skip_testsuite($;$)
113 {
114         my ($self, $name, $reason) = @_;
115         Subunit::skip_testsuite($name, $reason);
116 }
117
118 sub start_testsuite($;$)
119 {
120         my ($self, $name) = @_;
121         Subunit::start_testsuite($name);
122         $self->{fail_added} = 0;
123         $self->{xfail_added} = 0;
124 }
125
126 sub end_testsuite($$;$)
127 {
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")) {
131                 $result = "xfail";
132         }
133
134         Subunit::end_testsuite($name, $result, $reason);
135 }
136
137 sub testsuite_count($$)
138 {
139         my ($self, $count) = @_;
140         Subunit::testsuite_count($count);
141 }
142
143 sub new {
144         my ($class, $prefix, $expected_failures, $strip_ok_output) = @_;
145
146         my $self = { 
147                 prefix => $prefix,
148                 expected_failures => $expected_failures,
149                 strip_ok_output => $strip_ok_output,
150                 xfail_added => 0,
151         };
152         bless($self, $class);
153 }
154
155 1;