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
6package Subunit::Filter;
7
8use strict;
9
10sub 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
29sub 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
43sub control_msg()
44{
45	# We regenerate control messages, so ignore this
46}
47
48sub report_time($$)
49{
50	my ($self, $time) = @_;
51	Subunit::report_time($time);
52}
53
54sub output_msg($$)
55{
56	my ($self, $msg) = @_;
57	unless(defined($self->{output})) {
58		print $msg;
59	} else {
60		$self->{output}.=$msg;
61	}
62}
63
64sub 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
79sub 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 ($self->{strip_ok_output}) {
99		unless ($result eq "success" or $result eq "xfail" or $result eq "skip") {
100			print $self->{output}
101		}
102	}
103	$self->{output} = undef;
104
105	Subunit::end_test($testname, $result, $reason);
106}
107
108sub skip_testsuite($;$)
109{
110	my ($self, $name, $reason) = @_;
111	Subunit::skip_testsuite($name, $reason);
112}
113
114sub start_testsuite($;$)
115{
116	my ($self, $name) = @_;
117	Subunit::start_testsuite($name);
118	$self->{xfail_added} = 0;
119}
120
121sub end_testsuite($$;$)
122{
123	my ($self, $name, $result, $reason) = @_;
124	if ($self->{xfail_added} and ($result eq "fail" or $result eq "failure")) {
125		$result = "xfail";
126	}
127
128	Subunit::end_testsuite($name, $result, $reason);
129}
130
131sub testsuite_count($$)
132{
133	my ($self, $count) = @_;
134	Subunit::testsuite_count($count);
135}
136
137sub new {
138	my ($class, $prefix, $expected_failures, $strip_ok_output) = @_;
139
140	my $self = {
141		prefix => $prefix,
142		expected_failures => $expected_failures,
143		strip_ok_output => $strip_ok_output,
144		xfail_added => 0,
145	};
146	bless($self, $class);
147}
148
1491;
150