source: vendor/perl/5.8.8/lib/Test/Harness/t/strap-analyze.t@ 3181

Last change on this file since 3181 was 3181, checked in by bird, 18 years ago

perl 5.8.8
File size: 12.9 KB
Line 
1#!/usr/bin/perl -w
2
3BEGIN {
4 if( $ENV{PERL_CORE} ) {
5 chdir 't';
6 @INC = ('../lib', 'lib');
7 }
8 else {
9 unshift @INC, 't/lib';
10 }
11}
12
13use strict;
14use Test::More;
15use File::Spec;
16
17my $Curdir = File::Spec->curdir;
18my $SAMPLE_TESTS = $ENV{PERL_CORE}
19 ? File::Spec->catdir($Curdir, 'lib', 'sample-tests')
20 : File::Spec->catdir($Curdir, 't', 'sample-tests');
21
22
23my $IsMacPerl = $^O eq 'MacOS';
24my $IsVMS = $^O eq 'VMS';
25
26# VMS uses native, not POSIX, exit codes.
27my $die_exit = $IsVMS ? 44 : 1;
28
29# We can only predict that the wait status should be zero or not.
30my $wait_non_zero = 1;
31
32my %samples = (
33 bignum => {
34 bonus => 0,
35 details => [
36 {
37 actual_ok => 1,
38 ok => 1
39 },
40 {
41 actual_ok => 1,
42 ok => 1
43 }
44 ],
45 'exit' => 0,
46 max => 2,
47 ok => 4,
48 passing => 0,
49 seen => 4,
50 skip => 0,
51 todo => 0,
52 'wait' => 0
53 },
54 combined => {
55 bonus => 1,
56 details => [
57 {
58 actual_ok => 1,
59 ok => 1
60 },
61 {
62 actual_ok => 1,
63 name => "basset hounds got long ears",
64 ok => 1
65 },
66 {
67 actual_ok => 0,
68 name => "all hell broke lose",
69 ok => 0
70 },
71 {
72 actual_ok => 1,
73 ok => 1,
74 type => "todo"
75 },
76 {
77 actual_ok => 1,
78 ok => 1
79 },
80 {
81 actual_ok => 1,
82 ok => 1
83 },
84 {
85 actual_ok => 1,
86 ok => 1,
87 reason => "contract negociations",
88 type => "skip"
89 },
90 {
91 actual_ok => 1,
92 ok => 1
93 },
94 {
95 actual_ok => 0,
96 ok => 0
97 },
98 {
99 actual_ok => 0,
100 ok => 1,
101 type => "todo"
102 }
103 ],
104 'exit' => 0,
105 max => 10,
106 ok => 8,
107 passing => 0,
108 seen => 10,
109 skip => 1,
110 todo => 2,
111 'wait' => 0
112 },
113 descriptive => {
114 bonus => 0,
115 details => [
116 {
117 actual_ok => 1,
118 name => "Interlock activated",
119 ok => 1
120 },
121 {
122 actual_ok => 1,
123 name => "Megathrusters are go",
124 ok => 1
125 },
126 {
127 actual_ok => 1,
128 name => "Head formed",
129 ok => 1
130 },
131 {
132 actual_ok => 1,
133 name => "Blazing sword formed",
134 ok => 1
135 },
136 {
137 actual_ok => 1,
138 name => "Robeast destroyed",
139 ok => 1
140 }
141 ],
142 'exit' => 0,
143 max => 5,
144 ok => 5,
145 passing => 1,
146 seen => 5,
147 skip => 0,
148 todo => 0,
149 'wait' => 0
150 },
151 'die' => {
152 bonus => 0,
153 details => [],
154 'exit' => $die_exit,
155 max => 0,
156 ok => 0,
157 passing => 0,
158 seen => 0,
159 skip => 0,
160 todo => 0,
161 'wait' => $wait_non_zero
162 },
163 die_head_end => {
164 bonus => 0,
165 details => [
166 ({
167 actual_ok => 1,
168 ok => 1
169 }) x 4,
170 ],
171 'exit' => $die_exit,
172 max => 0,
173 ok => 4,
174 passing => 0,
175 seen => 4,
176 skip => 0,
177 todo => 0,
178 'wait' => $wait_non_zero
179 },
180 die_last_minute => {
181 bonus => 0,
182 details => [
183 ({
184 actual_ok => 1,
185 ok => 1
186 }) x 4,
187 ],
188 'exit' => $die_exit,
189 max => 4,
190 ok => 4,
191 passing => 0,
192 seen => 4,
193 skip => 0,
194 todo => 0,
195 'wait' => $wait_non_zero
196 },
197 duplicates => {
198 bonus => 0,
199 details => [
200 ({
201 actual_ok => 1,
202 ok => 1
203 }) x 10,
204 ],
205 'exit' => 0,
206 max => 10,
207 ok => 11,
208 passing => 0,
209 seen => 11,
210 skip => 0,
211 todo => 0,
212 'wait' => 0
213 },
214 head_end => {
215 bonus => 0,
216 details => [
217 ({
218 actual_ok => 1,
219 ok => 1
220 }) x 3,
221 {
222 actual_ok => 1,
223 diagnostics => "comment\nmore ignored stuff\nand yet more\n",
224 ok => 1
225 }
226 ],
227 'exit' => 0,
228 max => 4,
229 ok => 4,
230 passing => 1,
231 seen => 4,
232 skip => 0,
233 todo => 0,
234 'wait' => 0
235 },
236 head_fail => {
237 bonus => 0,
238 details => [
239 {
240 actual_ok => 1,
241 ok => 1
242 },
243 {
244 actual_ok => 0,
245 ok => 0
246 },
247 {
248 actual_ok => 1,
249 ok => 1
250 },
251 {
252 actual_ok => 1,
253 diagnostics => "comment\nmore ignored stuff\nand yet more\n",
254 ok => 1
255 }
256 ],
257 'exit' => 0,
258 max => 4,
259 ok => 3,
260 passing => 0,
261 seen => 4,
262 skip => 0,
263 todo => 0,
264 'wait' => 0
265 },
266 lone_not_bug => {
267 bonus => 0,
268 details => [
269 ({
270 actual_ok => 1,
271 ok => 1
272 }) x 4,
273 ],
274 'exit' => 0,
275 max => 4,
276 ok => 4,
277 passing => 1,
278 seen => 4,
279 skip => 0,
280 todo => 0,
281 'wait' => 0
282 },
283 no_output => {
284 bonus => 0,
285 details => [],
286 'exit' => 0,
287 max => 0,
288 ok => 0,
289 passing => 0,
290 seen => 0,
291 skip => 0,
292 todo => 0,
293 'wait' => 0
294 },
295 shbang_misparse => {
296 bonus => 0,
297 details => [
298 ({
299 actual_ok => 1,
300 ok => 1
301 }) x 2,
302 ],
303 'exit' => 0,
304 max => 2,
305 ok => 2,
306 passing => 1,
307 seen => 2,
308 skip => 0,
309 todo => 0,
310 'wait' => 0
311 },
312 simple => {
313 bonus => 0,
314 details => [
315 ({
316 actual_ok => 1,
317 ok => 1
318 }) x 5,
319 ],
320 'exit' => 0,
321 max => 5,
322 ok => 5,
323 passing => 1,
324 seen => 5,
325 skip => 0,
326 todo => 0,
327 'wait' => 0
328 },
329 simple_fail => {
330 bonus => 0,
331 details => [
332 {
333 actual_ok => 1,
334 ok => 1
335 },
336 {
337 actual_ok => 0,
338 ok => 0
339 },
340 {
341 actual_ok => 1,
342 ok => 1
343 },
344 {
345 actual_ok => 1,
346 ok => 1
347 },
348 {
349 actual_ok => 0,
350 ok => 0
351 }
352 ],
353 'exit' => 0,
354 max => 5,
355 ok => 3,
356 passing => 0,
357 seen => 5,
358 skip => 0,
359 todo => 0,
360 'wait' => 0
361 },
362 skip => {
363 bonus => 0,
364 details => [
365 {
366 actual_ok => 1,
367 ok => 1
368 },
369 {
370 actual_ok => 1,
371 ok => 1,
372 reason => "rain delay",
373 type => "skip"
374 },
375 ({
376 actual_ok => 1,
377 ok => 1
378 }) x 3,
379 ],
380 'exit' => 0,
381 max => 5,
382 ok => 5,
383 passing => 1,
384 seen => 5,
385 skip => 1,
386 todo => 0,
387 'wait' => 0
388 },
389 skip_nomsg => {
390 bonus => 0,
391 details => [
392 {
393 actual_ok => 1,
394 ok => 1,
395 reason => "",
396 type => "skip"
397 }
398 ],
399 'exit' => 0,
400 max => 1,
401 ok => 1,
402 passing => 1,
403 seen => 1,
404 skip => 1,
405 todo => 0,
406 'wait' => 0
407 },
408 skipall => {
409 bonus => 0,
410 details => [],
411 'exit' => 0,
412 max => 0,
413 ok => 0,
414 passing => 1,
415 seen => 0,
416 skip => 0,
417 skip_all => "rope",
418 todo => 0,
419 'wait' => 0
420 },
421 skipall_nomsg => {
422 bonus => 0,
423 details => [],
424 'exit' => 0,
425 max => 0,
426 ok => 0,
427 passing => 1,
428 seen => 0,
429 skip => 0,
430 skip_all => "",
431 todo => 0,
432 'wait' => 0
433 },
434 taint => {
435 bonus => 0,
436 details => [
437 {
438 actual_ok => 1,
439 name => "-T honored",
440 ok => 1
441 }
442 ],
443 'exit' => 0,
444 max => 1,
445 ok => 1,
446 passing => 1,
447 seen => 1,
448 skip => 0,
449 todo => 0,
450 'wait' => 0
451 },
452 todo => {
453 bonus => 1,
454 details => [
455 {
456 actual_ok => 1,
457 ok => 1
458 },
459 {
460 actual_ok => 1,
461 ok => 1,
462 type => "todo"
463 },
464 {
465 actual_ok => 0,
466 ok => 1,
467 type => "todo"
468 },
469 ({
470 actual_ok => 1,
471 ok => 1
472 }) x 2,
473 ],
474 'exit' => 0,
475 max => 5,
476 ok => 5,
477 passing => 1,
478 seen => 5,
479 skip => 0,
480 todo => 2,
481 'wait' => 0
482 },
483 vms_nit => {
484 bonus => 0,
485 details => [
486 {
487 actual_ok => 0,
488 ok => 0
489 },
490 {
491 actual_ok => 1,
492 ok => 1
493 }
494 ],
495 'exit' => 0,
496 max => 2,
497 ok => 1,
498 passing => 0,
499 seen => 2,
500 skip => 0,
501 todo => 0,
502 'wait' => 0
503 },
504 with_comments => {
505 bonus => 2,
506 details => [
507 {
508 actual_ok => 0,
509 diagnostics => "Failed test 1 in t/todo.t at line 9 *TODO*\n",
510 ok => 1,
511 type => "todo"
512 },
513 {
514 actual_ok => 1,
515 ok => 1,
516 reason => "at line 10 TODO?!)",
517 type => "todo"
518 },
519 {
520 actual_ok => 1,
521 ok => 1
522 },
523 {
524 actual_ok => 0,
525 diagnostics => "Test 4 got: '0' (t/todo.t at line 12 *TODO*)\n Expected: '1' (need more tuits)\n",
526 ok => 1,
527 type => "todo"
528 },
529 {
530 actual_ok => 1,
531 diagnostics => "woo\n",
532 ok => 1,
533 reason => "at line 13 TODO?!)",
534 type => "todo"
535 }
536 ],
537 'exit' => 0,
538 max => 5,
539 ok => 5,
540 passing => 1,
541 seen => 5,
542 skip => 0,
543 todo => 4,
544 'wait' => 0
545 },
546);
547plan tests => (keys(%samples) * 5) + 3;
548
549use Test::Harness::Straps;
550my @_INC = map { qq{"-I$_"} } @INC;
551$Test::Harness::Switches = "@_INC -Mstrict";
552
553$SIG{__WARN__} = sub {
554 warn @_ unless $_[0] =~ /^Enormous test number/ ||
555 $_[0] =~ /^Can't detailize/
556};
557
558for my $test ( sort keys %samples ) {
559 print "# Working on $test\n";
560 my $expect = $samples{$test};
561
562 for my $n ( 0..$#{$expect->{details}} ) {
563 for my $field ( qw( type name reason ) ) {
564 $expect->{details}[$n]{$field} = '' unless exists $expect->{details}[$n]{$field};
565 }
566 }
567
568 my $test_path = File::Spec->catfile($SAMPLE_TESTS, $test);
569 my $strap = Test::Harness::Straps->new;
570 isa_ok( $strap, 'Test::Harness::Straps' );
571 my %results = $strap->analyze_file($test_path);
572
573 is_deeply($results{details}, $expect->{details}, qq{details of "$test"} );
574
575 delete $expect->{details};
576 delete $results{details};
577
578 SKIP: {
579 skip '$? unreliable in MacPerl', 2 if $IsMacPerl;
580
581 # We can only check if it's zero or non-zero.
582 is( !!$results{'wait'}, !!$expect->{'wait'}, 'wait status' );
583 delete $results{'wait'};
584 delete $expect->{'wait'};
585
586 # Have to check the exit status seperately so we can skip it
587 # in MacPerl.
588 is( $results{'exit'}, $expect->{'exit'} );
589 delete $results{'exit'};
590 delete $expect->{'exit'};
591 }
592
593 is_deeply(\%results, $expect, qq{ the rest of "$test"} );
594} # for %samples
595
596NON_EXISTENT_FILE: {
597 my $strap = Test::Harness::Straps->new;
598 isa_ok( $strap, 'Test::Harness::Straps' );
599 ok( !$strap->analyze_file('I_dont_exist') );
600 is( $strap->{error}, "I_dont_exist does not exist" );
601}
Note: See TracBrowser for help on using the repository browser.