Merge branch 'master' of ssh://git.samba.org/data/git/samba into selftest
[kai/samba-autobuild/.git] / 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 informations 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;