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