This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Integrate from macperl:
[perl5.git] / lib / Test / Harness / t / test-harness.t
CommitLineData
356733da 1#!/usr/bin/perl -w
2fe373ce
MS
2
3BEGIN {
13287dd5
MS
4 if( $ENV{PERL_CORE} ) {
5 chdir 't';
356733da
MS
6 @INC = ('../lib', 'lib');
7 }
8 else {
9 unshift @INC, 't/lib';
13287dd5 10 }
2fe373ce
MS
11}
12
d5d4ec93
MS
13use strict;
14use File::Spec;
d5201bd2 15
d5d4ec93 16my $Curdir = File::Spec->curdir;
d5201bd2 17my $SAMPLE_TESTS = $ENV{PERL_CORE}
d5d4ec93
MS
18 ? File::Spec->catdir($Curdir, 'lib', 'sample-tests')
19 : File::Spec->catdir($Curdir, 't', 'sample-tests');
13287dd5 20
2fe373ce
MS
21
22# For shutting up Test::Harness.
13287dd5 23# Has to work on 5.004 which doesn't have Tie::StdHandle.
2fe373ce
MS
24package My::Dev::Null;
25
26sub WRITE {}
27sub PRINT {}
28sub PRINTF {}
29sub TIEHANDLE {
30 my $class = shift;
31 my $fh = do { local *HANDLE; \*HANDLE };
32 return bless $fh, $class;
33}
34sub READ {}
35sub READLINE {}
36sub GETC {}
37
38
39package main;
40
356733da 41use Test::More;
2fe373ce 42
943b127a 43my $IsMacOS = $^O eq 'MacOS';
d5d4ec93 44my $IsVMS = $^O eq 'VMS';
2fe373ce 45
f0008e52 46# VMS uses native, not POSIX, exit codes.
943b127a 47my $die_estat = $IsVMS ? 44 : $IsMacOS ? 0 : 1;
356733da 48
f0008e52
MS
49my %samples = (
50 simple => {
51 total => {
52 bonus => 0,
53 max => 5,
54 'ok' => 5,
55 files => 1,
56 bad => 0,
57 good => 1,
58 tests => 1,
59 sub_skipped=> 0,
60 'todo' => 0,
61 skipped => 0,
62 },
63 failed => { },
64 all_ok => 1,
65 },
66 simple_fail => {
67 total => {
68 bonus => 0,
69 max => 5,
70 'ok' => 3,
71 files => 1,
72 bad => 1,
73 good => 0,
74 tests => 1,
75 sub_skipped => 0,
76 'todo' => 0,
77 skipped => 0,
78 },
79 failed => {
80 canon => '2 5',
81 },
82 all_ok => 0,
83 },
84 descriptive => {
85 total => {
86 bonus => 0,
87 max => 5,
88 'ok' => 5,
89 files => 1,
90 bad => 0,
91 good => 1,
92 tests => 1,
93 sub_skipped=> 0,
94 'todo' => 0,
95 skipped => 0,
96 },
97 failed => { },
98 all_ok => 1,
99 },
100 no_nums => {
101 total => {
102 bonus => 0,
103 max => 5,
104 'ok' => 4,
105 files => 1,
106 bad => 1,
107 good => 0,
108 tests => 1,
109 sub_skipped=> 0,
110 'todo' => 0,
111 skipped => 0,
112 },
113 failed => {
114 canon => '3',
115 },
116 all_ok => 0,
117 },
118 'todo' => {
119 total => {
120 bonus => 1,
121 max => 5,
122 'ok' => 5,
123 files => 1,
124 bad => 0,
125 good => 1,
126 tests => 1,
127 sub_skipped=> 0,
128 'todo' => 2,
129 skipped => 0,
130 },
131 failed => { },
132 all_ok => 1,
133 },
134 todo_inline => {
135 total => {
136 bonus => 1,
137 max => 3,
138 'ok' => 3,
139 files => 1,
140 bad => 0,
141 good => 1,
142 tests => 1,
143 sub_skipped => 0,
144 'todo' => 2,
145 skipped => 0,
146 },
147 failed => { },
148 all_ok => 1,
149 },
150 'skip' => {
151 total => {
152 bonus => 0,
153 max => 5,
154 'ok' => 5,
155 files => 1,
156 bad => 0,
157 good => 1,
158 tests => 1,
159 sub_skipped=> 1,
160 'todo' => 0,
161 skipped => 0,
162 },
163 failed => { },
164 all_ok => 1,
165 },
0be28027
JH
166 'skip_nomsg' => {
167 total => {
168 bonus => 0,
169 max => 1,
170 'ok' => 1,
171 files => 1,
172 bad => 0,
173 good => 1,
174 tests => 1,
175 sub_skipped=> 1,
176 'todo' => 0,
177 skipped => 0,
178 },
179 failed => { },
180 all_ok => 1,
181 },
f0008e52
MS
182 bailout => 0,
183 combined => {
184 total => {
185 bonus => 1,
186 max => 10,
187 'ok' => 8,
188 files => 1,
189 bad => 1,
190 good => 0,
191 tests => 1,
192 sub_skipped=> 1,
193 'todo' => 2,
194 skipped => 0
195 },
196 failed => {
197 canon => '3 9',
198 },
199 all_ok => 0,
200 },
201 duplicates => {
202 total => {
203 bonus => 0,
204 max => 10,
205 'ok' => 11,
206 files => 1,
207 bad => 1,
208 good => 0,
209 tests => 1,
210 sub_skipped=> 0,
211 'todo' => 0,
212 skipped => 0,
213 },
214 failed => {
215 canon => '??',
216 },
217 all_ok => 0,
218 },
219 head_end => {
220 total => {
221 bonus => 0,
222 max => 4,
223 'ok' => 4,
224 files => 1,
225 bad => 0,
226 good => 1,
227 tests => 1,
228 sub_skipped=> 0,
229 'todo' => 0,
230 skipped => 0,
231 },
232 failed => { },
233 all_ok => 1,
234 },
235 head_fail => {
236 total => {
237 bonus => 0,
238 max => 4,
239 'ok' => 3,
240 files => 1,
241 bad => 1,
242 good => 0,
243 tests => 1,
244 sub_skipped=> 0,
245 'todo' => 0,
246 skipped => 0,
247 },
248 failed => {
249 canon => '2',
250 },
251 all_ok => 0,
252 },
0be28027
JH
253 skipall => {
254 total => {
255 bonus => 0,
256 max => 0,
257 'ok' => 0,
258 files => 1,
259 bad => 0,
260 good => 1,
261 tests => 1,
262 sub_skipped=> 0,
263 'todo' => 0,
264 skipped => 1,
265 },
266 failed => { },
267 all_ok => 1,
268 },
269 skipall_nomsg => {
f0008e52
MS
270 total => {
271 bonus => 0,
272 max => 0,
273 'ok' => 0,
274 files => 1,
275 bad => 0,
276 good => 1,
277 tests => 1,
278 sub_skipped=> 0,
279 'todo' => 0,
280 skipped => 1,
281 },
282 failed => { },
283 all_ok => 1,
284 },
285 with_comments => {
286 total => {
287 bonus => 2,
288 max => 5,
289 'ok' => 5,
290 files => 1,
291 bad => 0,
292 good => 1,
293 tests => 1,
294 sub_skipped=> 0,
295 'todo' => 4,
296 skipped => 0,
297 },
298 failed => { },
299 all_ok => 1,
300 },
301 taint => {
302 total => {
303 bonus => 0,
304 max => 1,
305 'ok' => 1,
306 files => 1,
307 bad => 0,
308 good => 1,
309 tests => 1,
310 sub_skipped=> 0,
311 'todo' => 0,
312 skipped => 0,
313 },
314 failed => { },
315 all_ok => 1,
316 },
2fe373ce 317
f0008e52
MS
318 'die' => {
319 total => {
320 bonus => 0,
321 max => 0,
322 'ok' => 0,
323 files => 1,
324 bad => 1,
325 good => 0,
326 tests => 1,
327 sub_skipped=> 0,
328 'todo' => 0,
329 skipped => 0,
330 },
331 failed => {
332 estat => $die_estat,
f0008e52
MS
333 max => '??',
334 failed => '??',
335 canon => '??',
336 },
337 all_ok => 0,
338 },
356733da 339
f0008e52
MS
340 die_head_end => {
341 total => {
342 bonus => 0,
343 max => 0,
344 'ok' => 4,
345 files => 1,
346 bad => 1,
347 good => 0,
348 tests => 1,
349 sub_skipped=> 0,
350 'todo' => 0,
351 skipped => 0,
352 },
353 failed => {
354 estat => $die_estat,
f0008e52
MS
355 max => '??',
356 failed => '??',
357 canon => '??',
358 },
359 all_ok => 0,
360 },
356733da 361
f0008e52
MS
362 die_last_minute => {
363 total => {
364 bonus => 0,
365 max => 4,
366 'ok' => 4,
367 files => 1,
368 bad => 1,
369 good => 0,
370 tests => 1,
371 sub_skipped=> 0,
372 'todo' => 0,
373 skipped => 0,
374 },
375 failed => {
376 estat => $die_estat,
f0008e52
MS
377 max => 4,
378 failed => 0,
379 canon => '??',
380 },
381 all_ok => 0,
382 },
383 bignum => {
384 total => {
385 bonus => 0,
386 max => 2,
387 'ok' => 4,
388 files => 1,
389 bad => 1,
390 good => 0,
391 tests => 1,
392 sub_skipped=> 0,
393 'todo' => 0,
394 skipped => 0,
395 },
396 failed => {
397 canon => '??',
398 },
399 all_ok => 0,
400 },
6e5a998b
MS
401 'shbang_misparse' => {
402 total => {
403 bonus => 0,
404 max => 2,
405 'ok' => 2,
406 files => 1,
407 bad => 0,
408 good => 1,
409 tests => 1,
410 sub_skipped=> 0,
411 'todo' => 0,
412 skipped => 0,
413 },
414 failed => { },
415 all_ok => 1,
416 },
f0008e52 417 );
356733da 418
d5d4ec93 419plan tests => (keys(%samples) * 8) + 1;
f0008e52
MS
420
421use Test::Harness;
422use_ok('Test::Harness');
2fe373ce 423
2fe373ce
MS
424
425tie *NULL, 'My::Dev::Null' or die $!;
426
427while (my($test, $expect) = each %samples) {
428 # _run_all_tests() runs the tests but skips the formatting.
429 my($totals, $failed);
d5d4ec93
MS
430 my $warning = '';
431 my $test_path = File::Spec->catfile($SAMPLE_TESTS, $test);
432
2fe373ce
MS
433 eval {
434 select NULL; # _run_all_tests() isn't as quiet as it should be.
308957f5 435 local $SIG{__WARN__} = sub { $warning .= join '', @_; };
2fe373ce 436 ($totals, $failed) =
d5d4ec93 437 Test::Harness::_run_all_tests($test_path);
2fe373ce
MS
438 };
439 select STDOUT;
440
d5d4ec93 441 # $? is unreliable in MacPerl, so we'll simply fudge it.
943b127a 442 $failed->{estat} = $die_estat if $IsMacOS and $failed;
d5d4ec93 443
308957f5
JH
444 SKIP: {
445 skip "special tests for bailout", 1 unless $test eq 'bailout';
446 like( $@, '/Further testing stopped: GERONI/i' );
447 }
448
449 SKIP: {
450 skip "don't apply to a bailout", 5 if $test eq 'bailout';
451 is( $@, '' );
452 is( Test::Harness::_all_ok($totals), $expect->{all_ok},
453 "$test - all ok" );
454 ok( defined $expect->{total}, "$test - has total" );
356733da
MS
455 is_deeply( {map { $_=>$totals->{$_} } keys %{$expect->{total}}},
456 $expect->{total},
308957f5 457 "$test - totals" );
d5d4ec93 458 is_deeply( {map { $_=>$failed->{$test_path}{$_} }
308957f5 459 keys %{$expect->{failed}}},
356733da 460 $expect->{failed},
308957f5 461 "$test - failed" );
2fe373ce 462 }
308957f5
JH
463
464 SKIP: {
465 skip "special tests for bignum", 1 unless $test eq 'bignum';
466 is( $warning, <<WARN );
d5d4ec93 467Enormous test number seen [test 100001]
308957f5 468Can't detailize, too big.
d5d4ec93 469Enormous test number seen [test 136211425]
308957f5
JH
470Can't detailize, too big.
471WARN
472
2fe373ce 473 }
308957f5 474
d5d4ec93
MS
475 SKIP: {
476 skip "bignum has known warnings", 1 if $test eq 'bignum';
477 is( $warning, '' );
478 }
2fe373ce 479}