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