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 control_msg()
  11 {
  12         # We regenerate control messages, so ignore this
  13 }
  14
  15 sub output_msg($$)
  16 {
  17         my ($self, $msg) = @_;
  18         print $msg;
  19 }
  20
  21 sub start_test($$)
  22 {
  23         my ($self, $testname) = @_;
  24
  25         if (defined($self->{prefix})) {
  26                 $testname = $self->{prefix}.$testname;
  27         }
  28
  29         Subunit::start_test($testname);
  30 }
  31
  32 sub end_test($$$$$)
  33 {
  34         my ($self, $testname, $result, $unexpected, $reason) = @_;
  35
  36         if (defined($self->{prefix})) {
  37                 $testname = $self->{prefix}.$testname;
  38         }
  39
  40         Subunit::end_test($testname, $result, $reason);
  41 }
  42
  43 sub skip_testsuite($;$)
  44 {
  45         my ($self, $name, $reason) = @_;
  46         Subunit::skip_testsuite($name, $reason);
  47 }
  48
  49 sub start_testsuite($;$)
  50 {
  51         my ($self, $name) = @_;
  52         Subunit::start_testsuite($name);
  53 }
  54
  55 sub end_testsuite($$;$)
  56 {
  57         my ($self, $name, $result, $reason) = @_;
  58         Subunit::end_testsuite($name, $result, $reason);
  59 }
  60
  61 sub new {
  62         my ($class, $prefix) = @_;
  63
  64         my $self = {
  65                 prefix => $prefix,
  66         };
  67         bless($self, $class);
  68 }
  69
  70 1;