selftest: Fix subunit formatting, fix years when filtering subunit
[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 my $statistics = {
44         SUITES_FAIL => 0,
45
46         TESTS_UNEXPECTED_OK => 0,
47         TESTS_EXPECTED_OK => 0,
48         TESTS_UNEXPECTED_FAIL => 0,
49         TESTS_EXPECTED_FAIL => 0,
50         TESTS_ERROR => 0,
51         TESTS_SKIP => 0,
52 };
53
54 sub control_msg()
55 {
56         # We regenerate control messages, so ignore this
57 }
58
59 sub report_time($$)
60 {
61         my ($self, $time) = @_;
62         Subunit::report_time($time);
63 }
64
65 sub output_msg($$)
66 {
67         my ($self, $msg) = @_;
68         print $msg;
69 }
70
71 sub start_test($$)
72 {
73         my ($self, $testname) = @_;
74
75         if (defined($self->{prefix})) {
76                 $testname = $self->{prefix}.$testname;
77         }
78
79         Subunit::start_test($testname);
80 }
81
82 sub end_test($$$$$)
83 {
84         my ($self, $testname, $result, $unexpected, $reason) = @_;
85
86         if (defined($self->{prefix})) {
87                 $testname = $self->{prefix}.$testname;
88         }
89
90         if (($result eq "fail" or $result eq "failure") and not $unexpected) { $result = "xfail"; }
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                 $reason .= $xfail_reason;
95         }
96
97         Subunit::end_test($testname, $result, $reason);
98 }
99
100 sub skip_testsuite($;$)
101 {
102         Subunit::skip_testsuite(@_);
103 }
104
105 sub start_testsuite($;$)
106 {
107         my ($self, $name) = @_;
108         Subunit::start_testsuite($name);
109 }
110
111 sub end_testsuite($$;$)
112 {
113         my ($self, $name, $result, $reason) = @_;
114         Subunit::end_testsuite($name, $result, $reason);
115 }
116
117 sub testsuite_count($$)
118 {
119         my ($self, $count) = @_;
120         Subunit::testsuite_count($count);
121 }
122
123 sub new {
124         my ($class, $prefix, $expected_failures) = @_;
125
126         my $self = { 
127                 prefix => $prefix,
128                 expected_failures => $expected_failures,
129         };
130         bless($self, $class);
131 }
132
133 1;