Upgrade to CGI.pm-3.31. Includes version bump to CGI::Carp due to a Pod fix.
[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 },
73ea3450 420 bignum_many => {
421 total => {
422 bonus => 0,
423 max => 2,
424 'ok' => 11,
425 files => 1,
426 bad => 1,
427 good => 0,
428 tests => 1,
429 sub_skipped=> 0,
430 'todo' => 0,
431 skipped => 0,
432 },
433 failed => {
434 canon => '3-100000',
435 },
436 all_ok => 0,
437 },
6e5a998b 438 'shbang_misparse' => {
439 total => {
440 bonus => 0,
441 max => 2,
442 'ok' => 2,
443 files => 1,
444 bad => 0,
445 good => 1,
446 tests => 1,
447 sub_skipped=> 0,
448 'todo' => 0,
449 skipped => 0,
450 },
451 failed => { },
452 all_ok => 1,
453 },
a72fde19 454 too_many => {
455 total => {
456 bonus => 0,
457 max => 3,
458 'ok' => 7,
459 files => 1,
460 bad => 1,
461 good => 0,
462 tests => 1,
463 sub_skipped => 0,
464 'todo' => 0,
465 skipped => 0,
466 },
467 failed => {
468 canon => '4-7',
469 },
470 all_ok => 0,
471 },
0bf5423d 472 switches => {
473 total => {
474 bonus => 0,
475 max => 1,
476 'ok' => 1,
477 files => 1,
478 bad => 0,
479 good => 1,
480 tests => 1,
481 sub_skipped=> 0,
482 'todo' => 0,
483 skipped => 0,
484 },
485 failed => { },
486 all_ok => 1,
487 },
f0008e52 488 );
356733da 489
20f9f807 490my $tests_per_loop = 8;
491plan tests => (keys(%samples) * $tests_per_loop);
f0008e52 492
60e33a80 493use Test::Harness;
ca09b021 494my @_INC = map { qq{"-I$_"} } @INC;
495$Test::Harness::Switches = "@_INC -Mstrict";
2fe373ce 496
e4fc8a1e 497tie *NULL, 'Dev::Null' or die $!;
498
499for my $test ( sort keys %samples ) {
500SKIP: {
20f9f807 501 skip "-t introduced in 5.8.0", $tests_per_loop
502 if ($test eq 'taint_warn') && ($] < 5.008);
e4fc8a1e 503
504 my $expect = $samples{$test};
2fe373ce 505
20f9f807 506 # execute_tests() runs the tests but skips the formatting.
d5d4ec93 507 my $test_path = File::Spec->catfile($SAMPLE_TESTS, $test);
508
e4fc8a1e 509 print STDERR "# $test\n" if $ENV{TEST_VERBOSE};
5b1ebecd 510 my $totals;
511 my $failed;
512 my $warning = '';
2fe373ce 513 eval {
308957f5 514 local $SIG{__WARN__} = sub { $warning .= join '', @_; };
20f9f807 515 ($totals, $failed) = Test::Harness::execute_tests(tests => [$test_path], out => \*NULL);
2fe373ce 516 };
2fe373ce 517
a72fde19 518 # $? is unreliable in MacPerl, so we'll just fudge it.
519 $failed->{estat} = $die_estat if $IsMacPerl and $failed;
d5d4ec93 520
308957f5 521 SKIP: {
522 skip "special tests for bailout", 1 unless $test eq 'bailout';
523 like( $@, '/Further testing stopped: GERONI/i' );
524 }
525
526 SKIP: {
20f9f807 527 skip "don't apply to a bailout", 6 if $test eq 'bailout';
5b1ebecd 528 is( $@, '', '$@ is empty' );
308957f5 529 is( Test::Harness::_all_ok($totals), $expect->{all_ok},
530 "$test - all ok" );
531 ok( defined $expect->{total}, "$test - has total" );
356733da 532 is_deeply( {map { $_=>$totals->{$_} } keys %{$expect->{total}}},
533 $expect->{total},
308957f5 534 "$test - totals" );
d5d4ec93 535 is_deeply( {map { $_=>$failed->{$test_path}{$_} }
308957f5 536 keys %{$expect->{failed}}},
356733da 537 $expect->{failed},
308957f5 538 "$test - failed" );
20f9f807 539
540 skip "No tests were run", 1 unless $totals->{max};
541
542 my $output = Test::Harness::get_results($totals, $failed);
5b1ebecd 543 like( $output, '/All tests successful|List of Failed/', 'Got what looks like a valid summary' );
2fe373ce 544 }
308957f5 545
73ea3450 546 my $expected_warnings = "";
547 if ( $test eq "bignum" ) {
548 $expected_warnings = <<WARN;
d5d4ec93 549Enormous test number seen [test 136211425]
308957f5 550Can't detailize, too big.
551WARN
2fe373ce 552 }
73ea3450 553 elsif ( $test eq 'bignum_many' ) {
554 $expected_warnings = <<WARN;
555Enormous test number seen [test 100001]
556Can't detailize, too big.
557WARN
d5d4ec93 558 }
73ea3450 559 my $desc = $expected_warnings ? 'Got proper warnings' : 'No warnings';
560 is( $warning, $expected_warnings, "$test - $desc" );
561} # taint SKIP block
562} # for tests