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 ($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
 108 sub skip_testsuite($;$)
 109 {
 110         my ($self, $name, $reason) = @_;
 111         Subunit::skip_testsuite($name, $reason);
 112 }
 113
 114 sub start_testsuite($;$)
 115 {
 116         my ($self, $name) = @_;
 117         Subunit::start_testsuite($name);
 118         $self->{xfail_added} = 0;
 119 }
 120
 121 sub 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
 131 sub testsuite_count($$)
 132 {
 133         my ($self, $count) = @_;
 134         Subunit::testsuite_count($count);
 135 }
 136
 137 sub 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
 149 1;