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                 require Term::ReadKey;
  52                 my ($wchar, $hchar, $wpixels, $hpixels) = Term::ReadKey::GetTerminalSize();
  53                 foreach (1..$wchar) { $out.= " "; }
  54                 print "\r".substr($out, 0, $wchar);
  55         }
  56 }
  57
  58 sub output_msg($$)
  59 {
  60         my ($self, $output) = @_;
  61
  62         if ($self->{verbose}) {
  63                 require FileHandle;
  64                 print $output;
  65                 STDOUT->flush();
  66         } else {
  67                 $self->{test_output}->{$self->{NAME}} .= $output;
  68         }
  69 }
  70
  71 sub control_msg($$)
  72 {
  73         my ($self, $output) = @_;
  74
  75         $self->output_msg($output);
  76 }
  77
  78 sub end_testsuite($$$$$)
  79 {
  80         my ($self, $name, $result, $unexpected, $reason) = @_;
  81         my $out = "";
  82
  83         if ($unexpected) {
  84                 if ($result eq "success" and not defined($reason)) {
  85                         $reason = "Expected negative exit code, got positive exit code";
  86                 }
  87                 $self->output_msg("ERROR: $reason\n");
  88                 push (@{$self->{suitesfailed}}, $name);
  89         } else {
  90                 $self->{suites_ok}++;
  91         }
  92
  93         if ($unexpected and $self->{immediate} and not $self->{verbose}) {
  94                 $out .= $self->{test_output}->{$name};
  95         }
  96
  97
  98         print $out;
  99 }
 100
 101 sub start_test($$$)
 102 {
 103         my ($self, $parents, $testname) = @_;
 104
 105         if ($#$parents == -1) {
 106                 $self->start_testsuite($testname);
 107         }
 108 }
 109
 110 sub end_test($$$$$)
 111 {
 112         my ($self, $parents, $testname, $result, $unexpected, $reason) = @_;
 113
 114         if ($#$parents == -1) {
 115                 $self->end_testsuite($testname, $result, $unexpected, $reason);
 116                 return;
 117         }
 118
 119         my $append = "";
 120
 121         unless ($unexpected) {
 122                 $self->{test_output}->{$self->{NAME}} = "";
 123                 return;
 124         }
 125
 126         my $fullname = join(".", @$parents).".$testname";
 127
 128         $append = "UNEXPECTED($result): $testname ($fullname)\n";
 129
 130         $self->{test_output}->{$self->{NAME}} .= $append;
 131
 132         if ($self->{immediate} and not $self->{verbose}) {
 133                 print $self->{test_output}->{$self->{NAME}};
 134                 $self->{test_output}->{$self->{NAME}} = "";
 135         }
 136 }
 137
 138 sub summary($)
 139 {
 140         my ($self) = @_;
 141
 142         open(SUMMARY, ">$self->{summaryfile}");
 143
 144         if ($#{$self->{suitesfailed}} > -1) {
 145                 print SUMMARY "= Failed tests =\n";
 146
 147                 foreach (@{$self->{suitesfailed}}) {
 148                         print SUMMARY "== $_ ==\n";
 149                         print SUMMARY $self->{test_output}->{$_}."\n\n";
 150                 }
 151
 152                 print SUMMARY "\n";
 153         }
 154
 155         if (not $self->{immediate} and not $self->{verbose}) {
 156                 foreach (@{$self->{suitesfailed}}) {
 157                         print "===============================================================================\n";
 158                         print "FAIL: $_\n";
 159                         print $self->{test_output}->{$_};
 160                         print "\n";
 161                 }
 162         }
 163
 164         print SUMMARY "= Skipped tests =\n";
 165         foreach my $reason (keys %{$self->{skips}}) {
 166                 print SUMMARY "$reason\n";
 167                 foreach my $name (@{$self->{skips}->{$reason}}) {
 168                         print SUMMARY "\t$name\n";
 169                 }
 170                 print SUMMARY "\n";
 171         }
 172         close(SUMMARY);
 173
 174         print "\nA summary with detailed informations can be found in:\n  $self->{summaryfile}\n";
 175
 176         if ($#{$self->{suitesfailed}} == -1) {
 177                 my $ok = $self->{statistics}->{TESTS_EXPECTED_OK} +
 178                                  $self->{statistics}->{TESTS_EXPECTED_FAIL};
 179                 print "\nALL OK ($ok tests in $self->{suites_ok} testsuites)\n";
 180         } else {
 181                 print "\nFAILED ($self->{statistics}->{TESTS_UNEXPECTED_FAIL} failures and $self->{statistics}->{TESTS_ERROR} errors in ". ($#{$self->{suitesfailed}}+1) ." testsuites)\n";
 182         }
 183
 184 }
 185
 186 sub skip_testsuite($$)
 187 {
 188         my ($self, $name, $reason) = @_;
 189
 190         push (@{$self->{skips}->{$reason}}, $name);
 191
 192         $self->{totalsuites}--;
 193 }
 194
 195 1;