s3:winbindd_cm: use cli_state_is_connected() helper function
[kai/samba-autobuild/.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                 $self->{total_xfail}++;
92         }
93         my $xfail_reason = find_in_list($self->{expected_failures}, $testname);
94         if (defined($xfail_reason) and ($result eq "fail" or $result eq "failure")) {
95                 $result = "xfail";
96                 $self->{xfail_added}++;
97                 $self->{total_xfail}++;
98                 $reason .= $xfail_reason;
99         }
100
101         if ($result eq "fail" or $result eq "failure") {
102                 $self->{fail_added}++;
103                 $self->{total_fail}++;
104         }
105
106         if ($result eq "error") {
107                 $self->{error_added}++;
108                 $self->{total_error}++;
109         }
110
111         if ($self->{strip_ok_output}) {
112                 unless ($result eq "success" or $result eq "xfail" or $result eq "skip") {
113                         print $self->{output}
114                 }
115         }
116         $self->{output} = undef;
117
118         Subunit::end_test($testname, $result, $reason);
119 }
120
121 sub skip_testsuite($;$)
122 {
123         my ($self, $name, $reason) = @_;
124         Subunit::skip_testsuite($name, $reason);
125 }
126
127 sub start_testsuite($;$)
128 {
129         my ($self, $name) = @_;
130         Subunit::start_testsuite($name);
131
132         $self->{error_added} = 0;
133         $self->{fail_added} = 0;
134         $self->{xfail_added} = 0;
135 }
136
137 sub end_testsuite($$;$)
138 {
139         my ($self, $name, $result, $reason) = @_;
140         my $xfail = 0;
141
142         $xfail = 1 if ($self->{xfail_added} > 0);
143         $xfail = 0 if ($self->{fail_added} > 0);
144         $xfail = 0 if ($self->{error_added} > 0);
145
146         if ($xfail and ($result eq "fail" or $result eq "failure")) {
147                 $result = "xfail";
148         }
149
150         if ($self->{fail_added} > 0 and $result ne "failure") {
151                 $result = "failure";
152                 $reason = "Subunit/Filer Reason" unless defined($reason);
153                 $reason .= "\n failures[$self->{fail_added}]";
154         }
155
156         if ($self->{error_added} > 0 and $result ne "error") {
157                 $result = "error";
158                 $reason = "Subunit/Filer Reason" unless defined($reason);
159                 $reason .= "\n errors[$self->{error_added}]";
160         }
161
162         Subunit::end_testsuite($name, $result, $reason);
163 }
164
165 sub testsuite_count($$)
166 {
167         my ($self, $count) = @_;
168         Subunit::testsuite_count($count);
169 }
170
171 sub new {
172         my ($class, $prefix, $expected_failures, $strip_ok_output) = @_;
173
174         my $self = { 
175                 prefix => $prefix,
176                 expected_failures => $expected_failures,
177                 strip_ok_output => $strip_ok_output,
178                 xfail_added => 0,
179                 total_xfail => 0,
180                 total_error => 0,
181                 total_fail => 0
182         };
183         bless($self, $class);
184 }
185
186 1;