selftest/output/plain.pm

   1 #!/usr/bin/perl
   2
   3 package output::plain;
   4 use Exporter;
   5 @ISA = qw(Exporter);
   6
   7 use FindBin qw($RealBin);
   8 use lib "$RealBin/..";
   9
  10 use strict;
  11
  12 sub new($$$$$$$) {
  13         my ($class, $summaryfile, $verbose, $immediate, $statistics, $totaltests) = @_;
  14         my $self = {
  15                 verbose => $verbose,
  16                 immediate => $immediate,
  17                 statistics => $statistics,
  18                 start_time => time(),
  19                 test_output => {},
  20                 suitesfailed => [],
  21                 suites_ok => 0,
  22                 skips => {},
  23                 summaryfile => $summaryfile,
  24                 index => 0,
  25                 totalsuites => $totaltests,
  26         };
  27         bless($self, $class);
  28 }
  29
  30 sub output_msg($$);
  31
  32 sub start_testsuite($$)
  33 {
  34         my ($self, $name) = @_;
  35
  36         $self->{index}++;
  37         $self->{NAME} = $name;
  38         $self->{START_TIME} = time();
  39
  40         my $duration = $self->{START_TIME} - $self->{start_time};
  41
  42         $self->{test_output}->{$name} = "" unless($self->{verbose});
  43
  44         my $out = "";
  45         $out .= "[$self->{index}/$self->{totalsuites} in ".$duration."s";
  46         $out .= sprintf(", %d errors", ($#{$self->{suitesfailed}}+1)) if ($#{$self->{suitesfailed}} > -1);
  47         $out .= "] $name";
  48         if ($self->{immediate}) {
  49                 print "$out\n";
  50         } else {
  51                 print "$out: ";
  52         }
  53 }
  54
  55 sub output_msg($$)
  56 {
  57         my ($self, $output) = @_;
  58
  59         if ($self->{verbose}) {
  60                 require FileHandle;
  61                 print $output;
  62                 STDOUT->flush();
  63         } else {
  64                 $self->{test_output}->{$self->{NAME}} .= $output;
  65         }
  66 }
  67
  68 sub control_msg($$)
  69 {
  70         my ($self, $output) = @_;
  71
  72         $self->output_msg($output);
  73 }
  74
  75 sub end_testsuite($$$$$)
  76 {
  77         my ($self, $name, $result, $unexpected, $reason) = @_;
  78         my $out = "";
  79
  80         if ($unexpected) {
  81                 if ($result eq "success" and not defined($reason)) {
  82                         $reason = "Expected negative exit code, got positive exit code";
  83                 }
  84                 $self->output_msg("ERROR: $reason\n");
  85                 push (@{$self->{suitesfailed}}, $name);
  86         } else {
  87                 $self->{suites_ok}++;
  88         }
  89
  90         if ($unexpected and $self->{immediate} and not $self->{verbose}) {
  91                 $out .= $self->{test_output}->{$name};
  92         }
  93
  94         if (not $self->{immediate}) {
  95                 if (not $unexpected) {
  96                         $out .= " ok\n";
  97                 } else {
  98                         $out .= " " . uc($result) . "\n";
  99                 }
 100         }
 101
 102         print $out;
 103 }
 104
 105 sub start_test($$$)
 106 {
 107         my ($self, $parents, $testname) = @_;
 108
 109         if ($#$parents == -1) {
 110                 $self->start_testsuite($testname);
 111         }
 112 }
 113
 114 sub end_test($$$$$)
 115 {
 116         my ($self, $parents, $testname, $result, $unexpected, $reason) = @_;
 117
 118         if ($#$parents == -1) {
 119                 $self->end_testsuite($testname, $result, $unexpected, $reason);
 120                 return;
 121         }
 122
 123         my $append = "";
 124
 125         unless ($unexpected) {
 126                 $self->{test_output}->{$self->{NAME}} = "";
 127                 if (not $self->{immediate}) {
 128                         if ($result eq "failure") { print "f"; }
 129                         elsif ($result eq "skip") { print "s"; }
 130                         elsif ($result eq "success") { print "."; }
 131                         else { print "?($result)"; }
 132                 }
 133                 return;
 134         }
 135
 136         my $fullname = join(".", @$parents).".$testname";
 137
 138         $append = "UNEXPECTED($result): $testname ($fullname)\n";
 139
 140         $self->{test_output}->{$self->{NAME}} .= $append;
 141
 142         if ($self->{immediate} and not $self->{verbose}) {
 143                 print $self->{test_output}->{$self->{NAME}};
 144                 $self->{test_output}->{$self->{NAME}} = "";
 145         }
 146
 147         if (not $self->{immediate}) {
 148                 if ($result eq "error") { print "E"; }
 149                 elsif ($result eq "failure") { print "F"; }
 150                 elsif ($result eq "success") { print "S"; }
 151                 else { print "?"; }
 152         }
 153 }
 154
 155 sub summary($)
 156 {
 157         my ($self) = @_;
 158
 159         open(SUMMARY, ">$self->{summaryfile}");
 160
 161         if ($#{$self->{suitesfailed}} > -1) {
 162                 print SUMMARY "= Failed tests =\n";
 163
 164                 foreach (@{$self->{suitesfailed}}) {
 165                         print SUMMARY "== $_ ==\n";
 166                         print SUMMARY $self->{test_output}->{$_}."\n\n";
 167                 }
 168
 169                 print SUMMARY "\n";
 170         }
 171
 172         if (not $self->{immediate} and not $self->{verbose}) {
 173                 foreach (@{$self->{suitesfailed}}) {
 174                         print "===============================================================================\n";
 175                         print "FAIL: $_\n";
 176                         print $self->{test_output}->{$_};
 177                         print "\n";
 178                 }
 179         }
 180
 181         print SUMMARY "= Skipped tests =\n";
 182         foreach my $reason (keys %{$self->{skips}}) {
 183                 print SUMMARY "$reason\n";
 184                 foreach my $name (@{$self->{skips}->{$reason}}) {
 185                         print SUMMARY "\t$name\n";
 186                 }
 187                 print SUMMARY "\n";
 188         }
 189         close(SUMMARY);
 190
 191         print "\nA summary with detailed information can be found in:\n  $self->{summaryfile}\n";
 192
 193         if ($#{$self->{suitesfailed}} == -1) {
 194                 my $ok = $self->{statistics}->{TESTS_EXPECTED_OK} +
 195                                  $self->{statistics}->{TESTS_EXPECTED_FAIL};
 196                 print "\nALL OK ($ok tests in $self->{suites_ok} testsuites)\n";
 197         } else {
 198                 print "\nFAILED ($self->{statistics}->{TESTS_UNEXPECTED_FAIL} failures and $self->{statistics}->{TESTS_ERROR} errors in ". ($#{$self->{suitesfailed}}+1) ." testsuites)\n";
 199         }
 200
 201 }
 202
 203 sub skip_testsuite($$)
 204 {
 205         my ($self, $name, $reason) = @_;
 206
 207         push (@{$self->{skips}->{$reason}}, $name);
 208
 209         $self->{totalsuites}--;
 210 }
 211
 212 1;