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