This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
The #11931 patching misbehaved.
[perl5.git] / lib / Test / Harness / t / test-harness.t
CommitLineData
2fe373ce
MS
1#!perl
2
3BEGIN {
4 chdir 't' if -d 't';
5 @INC = '../lib';
6}
7
8use strict;
9
10# For shutting up Test::Harness.
11# Has to work on 5.004, which doesn't have Tie::StdHandle.
12package My::Dev::Null;
13
14sub WRITE {}
15sub PRINT {}
16sub PRINTF {}
17sub TIEHANDLE {
18 my $class = shift;
19 my $fh = do { local *HANDLE; \*HANDLE };
20 return bless $fh, $class;
21}
22sub READ {}
23sub READLINE {}
24sub GETC {}
25
26
27package main;
28
29# Utility testing functions.
30my $test_num = 1;
31sub ok ($;$) {
32 my($test, $name) = @_;
33 my $okstring = '';
34 $okstring = "not " unless $test;
35 $okstring .= "ok $test_num";
36 $okstring .= " - $name" if defined $name;
37 print "$okstring\n";
38 $test_num++;
39}
40
41sub eqhash {
42 my($a1, $a2) = @_;
43 return 0 unless keys %$a1 == keys %$a2;
44
45 my $ok = 1;
46 foreach my $k (keys %$a1) {
47 $ok = $a1->{$k} eq $a2->{$k};
48 last unless $ok;
49 }
50
51 return $ok;
52}
53
54use vars qw($Total_tests %samples);
55
56my $loaded;
57BEGIN { $| = 1; $^W = 1; }
58END {print "not ok $test_num\n" unless $loaded;}
59print "1..$Total_tests\n";
60use Test::Harness;
61$loaded = 1;
62ok(1, 'compile');
63######################### End of black magic.
64
65BEGIN {
66 %samples = (
67 simple => {
68 total => {
69 bonus => 0,
70 max => 5,
71 'ok' => 5,
72 files => 1,
73 bad => 0,
74 good => 1,
75 tests => 1,
76 sub_skipped=> 0,
77 todo => 0,
78 skipped => 0,
79 },
80 failed => { },
81 all_ok => 1,
82 },
83 simple_fail => {
84 total => {
85 bonus => 0,
86 max => 5,
87 'ok' => 3,
88 files => 1,
89 bad => 1,
90 good => 0,
91 tests => 1,
92 sub_skipped => 0,
93 todo => 0,
94 skipped => 0,
95 },
96 failed => {
97 canon => '2 5',
98 },
99 all_ok => 0,
100 },
101 descriptive => {
102 total => {
103 bonus => 0,
104 max => 5,
105 'ok' => 5,
106 files => 1,
107 bad => 0,
108 good => 1,
109 tests => 1,
110 sub_skipped=> 0,
111 todo => 0,
112 skipped => 0,
113 },
114 failed => { },
115 all_ok => 1,
116 },
117 no_nums => {
118 total => {
119 bonus => 0,
120 max => 5,
121 'ok' => 4,
122 files => 1,
123 bad => 1,
124 good => 0,
125 tests => 1,
126 sub_skipped=> 0,
127 todo => 0,
128 skipped => 0,
129 },
130 failed => {
131 canon => '3',
132 },
133 all_ok => 0,
134 },
135 todo => {
136 total => {
137 bonus => 1,
138 max => 5,
139 'ok' => 5,
140 files => 1,
141 bad => 0,
142 good => 1,
143 tests => 1,
144 sub_skipped=> 0,
145 todo => 2,
146 skipped => 0,
147 },
148 failed => { },
149 all_ok => 1,
150 },
151 todo_inline => {
152 total => {
153 bonus => 1,
154 max => 3,
155 'ok' => 3,
156 files => 1,
157 bad => 0,
158 good => 1,
159 tests => 1,
160 sub_skipped => 0,
161 todo => 2,
162 skipped => 0,
163 },
164 failed => { },
165 all_ok => 1,
166 },
167 skip => {
168 total => {
169 bonus => 0,
170 max => 5,
171 'ok' => 5,
172 files => 1,
173 bad => 0,
174 good => 1,
175 tests => 1,
176 sub_skipped=> 1,
177 todo => 0,
178 skipped => 0,
179 },
180 failed => { },
181 all_ok => 1,
182 },
183 bailout => 0,
184 combined => {
185 total => {
186 bonus => 1,
187 max => 10,
188 'ok' => 8,
189 files => 1,
190 bad => 1,
191 good => 0,
192 tests => 1,
193 sub_skipped=> 1,
194 todo => 2,
195 skipped => 0
196 },
197 failed => {
198 canon => '3 9',
199 },
200 all_ok => 0,
201 },
202 duplicates => {
203 total => {
204 bonus => 0,
205 max => 10,
206 'ok' => 11,
207 files => 1,
208 bad => 1,
209 good => 0,
210 tests => 1,
211 sub_skipped=> 0,
212 todo => 0,
213 skipped => 0,
214 },
215 failed => {
216 canon => '??',
217 },
218 all_ok => 0,
219 },
220 header_at_end => {
221 total => {
222 bonus => 0,
223 max => 4,
224 'ok' => 4,
225 files => 1,
226 bad => 0,
227 good => 1,
228 tests => 1,
229 sub_skipped=> 0,
230 todo => 0,
231 skipped => 0,
232 },
233 failed => { },
234 all_ok => 1,
235 },
236 header_at_end_fail=> {
237 total => {
238 bonus => 0,
239 max => 4,
240 'ok' => 3,
241 files => 1,
242 bad => 1,
243 good => 0,
244 tests => 1,
245 sub_skipped=> 0,
246 todo => 0,
247 skipped => 0,
248 },
249 failed => {
250 canon => '2',
251 },
252 all_ok => 0,
253 },
254 skip_all => {
255 total => {
256 bonus => 0,
257 max => 0,
258 'ok' => 0,
259 files => 1,
260 bad => 0,
261 good => 1,
262 tests => 1,
263 sub_skipped=> 0,
264 todo => 0,
265 skipped => 1,
266 },
267 failed => { },
268 all_ok => 1,
269 },
270 with_comments => {
271 total => {
272 bonus => 2,
273 max => 5,
274 'ok' => 5,
275 files => 1,
276 bad => 0,
277 good => 1,
278 tests => 1,
279 sub_skipped=> 0,
280 todo => 4,
281 skipped => 0,
282 },
283 failed => { },
284 all_ok => 1,
285 },
286 );
287
288 $Total_tests = (keys(%samples) * 4);
289}
290
291tie *NULL, 'My::Dev::Null' or die $!;
292
293while (my($test, $expect) = each %samples) {
294 # _run_all_tests() runs the tests but skips the formatting.
295 my($totals, $failed);
296 eval {
297 select NULL; # _run_all_tests() isn't as quiet as it should be.
298 ($totals, $failed) =
299 Test::Harness::_run_all_tests("lib/sample-tests/$test");
300 };
301 select STDOUT;
302
303 unless( $@ ) {
304 ok( Test::Harness::_all_ok($totals) == $expect->{all_ok},
305 "$test - all ok" );
306 ok( defined $expect->{total}, "$test - has total" );
307 ok( eqhash( $expect->{total},
308 {map { $_=>$totals->{$_} } keys %{$expect->{total}}} ),
309 "$test - totals" );
310 ok( eqhash( $expect->{failed},
311 {map { $_=>$failed->{"lib/sample-tests/$test"}{$_} }
312 keys %{$expect->{failed}}} ),
313 "$test - failed" );
314 }
315 else { # special case for bailout
316 ok( ($test eq 'bailout' and $@ =~ /Further testing stopped: GERONI/i),
317 $test );
318 ok( 1, 'skipping for bailout' );
319 ok( 1, 'skipping for bailout' );
320 }
321}