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 / strap-analyze.t
CommitLineData
13287dd5
MS
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
13287dd5 13use strict;
6e5a998b 14use Test::More;
d5d4ec93
MS
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');
13287dd5 21
d5201bd2 22
943b127a 23my $IsMacOS = $^O eq 'MacOS';
d5d4ec93 24my $IsVMS = $^O eq 'VMS';
13287dd5 25
f0008e52 26# VMS uses native, not POSIX, exit codes.
943b127a 27my $die_exit = $IsVMS ? 44 : $IsMacOS ? 0 : 1;
c0bb2de7
MS
28
29# We can only predict that the wait status should be zero or not.
30my $wait_non_zero = 1;
f0008e52 31
13287dd5
MS
32my %samples = (
33 combined => {
34 passing => 0,
35
356733da
MS
36 'exit' => 0,
37 'wait' => 0,
38
13287dd5
MS
39 max => 10,
40 seen => 10,
41
42 'ok' => 8,
43 'todo' => 2,
44 'skip' => 1,
45 bonus => 1,
46
47 details => [ { 'ok' => 1, actual_ok => 1 },
48 { 'ok' => 1, actual_ok => 1,
49 name => 'basset hounds got long ears',
50 },
51 { 'ok' => 0, actual_ok => 0,
52 name => 'all hell broke lose',
53 },
54 { 'ok' => 1, actual_ok => 1,
55 type => 'todo'
56 },
57 { 'ok' => 1, actual_ok => 1 },
58 { 'ok' => 1, actual_ok => 1 },
59 { 'ok' => 1, actual_ok => 1,
60 type => 'skip',
61 reason => 'contract negociations'
62 },
63 { 'ok' => 1, actual_ok => 1 },
64 { 'ok' => 0, actual_ok => 0 },
65 { 'ok' => 1, actual_ok => 0,
66 type => 'todo'
67 },
68 ]
69 },
70
71 descriptive => {
72 passing => 1,
73
356733da
MS
74 'wait' => 0,
75 'exit' => 0,
76
13287dd5
MS
77 max => 5,
78 seen => 5,
79
80 'ok' => 5,
81 'todo' => 0,
82 'skip' => 0,
83 bonus => 0,
84
85 details => [ { 'ok' => 1, actual_ok => 1,
86 name => 'Interlock activated'
87 },
88 { 'ok' => 1, actual_ok => 1,
89 name => 'Megathrusters are go',
90 },
91 { 'ok' => 1, actual_ok => 1,
92 name => 'Head formed',
93 },
94 { 'ok' => 1, actual_ok => 1,
95 name => 'Blazing sword formed'
96 },
97 { 'ok' => 1, actual_ok => 1,
98 name => 'Robeast destroyed'
99 },
100 ],
101 },
102
103 duplicates => {
104 passing => 0,
105
356733da
MS
106 'exit' => 0,
107 'wait' => 0,
108
13287dd5
MS
109 max => 10,
110 seen => 11,
111
112 'ok' => 11,
113 'todo' => 0,
114 'skip' => 0,
115 bonus => 0,
116
117 details => [ ({ 'ok' => 1, actual_ok => 1 }) x 10
118 ],
119 },
120
121 head_end => {
122 passing => 1,
123
356733da
MS
124 'exit' => 0,
125 'wait' => 0,
126
13287dd5
MS
127 max => 4,
128 seen => 4,
129
130 'ok' => 4,
131 'todo' => 0,
132 'skip' => 0,
133 bonus => 0,
134
135 details => [ ({ 'ok' => 1, actual_ok => 1 }) x 4
136 ],
137 },
138
139 lone_not_bug => {
140 passing => 1,
141
356733da
MS
142 'exit' => 0,
143 'wait' => 0,
144
13287dd5
MS
145 max => 4,
146 seen => 4,
147
148 'ok' => 4,
149 'todo' => 0,
150 'skip' => 0,
151 bonus => 0,
152
153 details => [ ({ 'ok' => 1, actual_ok => 1 }) x 4
154 ],
155 },
156
157 head_fail => {
158 passing => 0,
159
356733da
MS
160 'exit' => 0,
161 'wait' => 0,
162
13287dd5
MS
163 max => 4,
164 seen => 4,
165
166 'ok' => 3,
167 'todo' => 0,
168 'skip' => 0,
169 bonus => 0,
170
171 details => [ { 'ok' => 1, actual_ok => 1 },
172 { 'ok' => 0, actual_ok => 0 },
173 ({ 'ok'=> 1, actual_ok => 1 }) x 2
174 ],
175 },
308957f5 176
13287dd5
MS
177 simple => {
178 passing => 1,
179
356733da
MS
180 'exit' => 0,
181 'wait' => 0,
182
13287dd5
MS
183 max => 5,
184 seen => 5,
308957f5 185
13287dd5
MS
186 'ok' => 5,
187 'todo' => 0,
188 'skip' => 0,
189 bonus => 0,
308957f5 190
13287dd5
MS
191 details => [ ({ 'ok' => 1, actual_ok => 1 }) x 5
192 ]
193 },
194
195 simple_fail => {
196 passing => 0,
197
356733da
MS
198 'exit' => 0,
199 'wait' => 0,
200
13287dd5
MS
201 max => 5,
202 seen => 5,
308957f5 203
13287dd5
MS
204 'ok' => 3,
205 'todo' => 0,
206 'skip' => 0,
207 bonus => 0,
308957f5 208
13287dd5
MS
209 details => [ { 'ok' => 1, actual_ok => 1 },
210 { 'ok' => 0, actual_ok => 0 },
211 { 'ok' => 1, actual_ok => 1 },
212 { 'ok' => 1, actual_ok => 1 },
213 { 'ok' => 0, actual_ok => 0 },
214 ]
215 },
216
217 'skip' => {
218 passing => 1,
219
356733da
MS
220 'exit' => 0,
221 'wait' => 0,
222
13287dd5
MS
223 max => 5,
224 seen => 5,
225
226 'ok' => 5,
227 'todo' => 0,
228 'skip' => 1,
229 bonus => 0,
308957f5 230
13287dd5
MS
231 details => [ { 'ok' => 1, actual_ok => 1 },
232 { 'ok' => 1, actual_ok => 1,
233 type => 'skip',
234 reason => 'rain delay',
235 },
236 ({ 'ok' => 1, actual_ok => 1 }) x 3
237 ]
238 },
239
0be28027
JH
240 'skip_nomsg' => {
241 passing => 1,
242
243 'exit' => 0,
244 'wait' => 0,
245
246 max => 1,
247 seen => 1,
248
249 'ok' => 1,
250 'todo' => 0,
251 'skip' => 1,
252 bonus => 0,
253
254 details => [ { 'ok' => 1, actual_ok => 1,
255 type => 'skip',
256 reason => '',
257 },
258 ]
259 },
260
261 skipall => {
13287dd5
MS
262 passing => 1,
263
356733da
MS
264 'exit' => 0,
265 'wait' => 0,
266
13287dd5
MS
267 max => 0,
268 seen => 0,
269 skip_all => 'rope',
270
271 'ok' => 0,
272 'todo' => 0,
273 'skip' => 0,
274 bonus => 0,
308957f5 275
13287dd5
MS
276 details => [],
277 },
278
0be28027
JH
279 skipall_nomsg => {
280 passing => 1,
281
282 'exit' => 0,
283 'wait' => 0,
284
285 max => 0,
286 seen => 0,
287
288 'ok' => 0,
289 'todo' => 0,
290 'skip' => 0,
291 bonus => 0,
292
293 details => [],
294 },
295
13287dd5
MS
296 'todo' => {
297 passing => 1,
298
356733da
MS
299 'exit' => 0,
300 'wait' => 0,
301
13287dd5
MS
302 max => 5,
303 seen => 5,
308957f5 304
13287dd5
MS
305 'ok' => 5,
306 'todo' => 2,
307 'skip' => 0,
308 bonus => 1,
309
310 details => [ { 'ok' => 1, actual_ok => 1 },
311 { 'ok' => 1, actual_ok => 1,
312 type => 'todo' },
313 { 'ok' => 1, actual_ok => 0,
314 type => 'todo' },
315 ({ 'ok' => 1, actual_ok => 1 }) x 2
316 ],
317 },
318 taint => {
319 passing => 1,
320
356733da
MS
321 'exit' => 0,
322 'wait' => 0,
323
13287dd5
MS
324 max => 1,
325 seen => 1,
326
327 'ok' => 1,
328 'todo' => 0,
329 'skip' => 0,
330 bonus => 0,
331
332 details => [ { 'ok' => 1, actual_ok => 1,
333 name => '- -T honored'
334 },
335 ],
336 },
337 vms_nit => {
338 passing => 0,
339
356733da
MS
340 'exit' => 0,
341 'wait' => 0,
342
13287dd5
MS
343 max => 2,
344 seen => 2,
345
346 'ok' => 1,
347 'todo' => 0,
348 'skip' => 0,
349 bonus => 0,
350
351 details => [ { 'ok' => 0, actual_ok => 0 },
352 { 'ok' => 1, actual_ok => 1 },
353 ],
356733da
MS
354 },
355 'die' => {
356 passing => 0,
357
f0008e52 358 'exit' => $die_exit,
c0bb2de7 359 'wait' => $wait_non_zero,
356733da
MS
360
361 max => 0,
362 seen => 0,
363
364 'ok' => 0,
365 'todo' => 0,
366 'skip' => 0,
367 bonus => 0,
368
369 details => []
370 },
371
372 die_head_end => {
373 passing => 0,
374
f0008e52 375 'exit' => $die_exit,
c0bb2de7 376 'wait' => $wait_non_zero,
356733da
MS
377
378 max => 0,
379 seen => 4,
380
381 'ok' => 4,
382 'todo' => 0,
383 'skip' => 0,
384 bonus => 0,
385
386 details => [ ({ 'ok' => 1, actual_ok => 1 }) x 4
387 ],
388 },
389
390 die_last_minute => {
391 passing => 0,
392
f0008e52 393 'exit' => $die_exit,
c0bb2de7 394 'wait' => $wait_non_zero,
356733da
MS
395
396 max => 4,
397 seen => 4,
398
399 'ok' => 4,
400 'todo' => 0,
401 'skip' => 0,
402 bonus => 0,
403
404 details => [ ({ 'ok' => 1, actual_ok => 1 }) x 4
405 ],
406 },
407
408 bignum => {
409 passing => 0,
410
411 'exit' => 0,
412 'wait' => 0,
413
414 max => 2,
415 seen => 4,
308957f5 416
356733da
MS
417 'ok' => 4,
418 'todo' => 0,
419 'skip' => 0,
420 bonus => 0,
308957f5 421
356733da
MS
422 details => [ { 'ok' => 1, actual_ok => 1 },
423 { 'ok' => 1, actual_ok => 1 },
424 ]
425 },
6e5a998b
MS
426
427 'shbang_misparse' =>{
428 passing => 1,
429
430 'exit' => 0,
431 'wait' => 0,
432
433 max => 2,
434 seen => 2,
435
436 'ok' => 2,
437 'todo' => 0,
438 'skip' => 0,
439 bonus => 0,
440
441 details => [ ({ 'ok' => 1, actual_ok => 1 }) x 2 ]
442 },
13287dd5
MS
443);
444
d5d4ec93 445plan tests => (keys(%samples) * 4) + 3;
6e5a998b
MS
446
447use_ok('Test::Harness::Straps');
448
356733da 449$SIG{__WARN__} = sub {
d5d4ec93 450 warn @_ unless $_[0] =~ /^Enormous test number/ ||
356733da
MS
451 $_[0] =~ /^Can't detailize/
452};
13287dd5 453while( my($test, $expect) = each %samples ) {
308957f5
JH
454 for (0..$#{$expect->{details}}) {
455 $expect->{details}[$_]{type} = ''
456 unless exists $expect->{details}[$_]{type};
457 $expect->{details}[$_]{name} = ''
458 unless exists $expect->{details}[$_]{name};
459 $expect->{details}[$_]{reason} = ''
460 unless exists $expect->{details}[$_]{reason};
461 }
462
d5d4ec93 463 my $test_path = File::Spec->catfile($SAMPLE_TESTS, $test);
13287dd5 464 my $strap = Test::Harness::Straps->new;
d5d4ec93 465 my %results = $strap->analyze_file($test_path);
308957f5 466
356733da 467 is_deeply($results{details}, $expect->{details}, "$test details" );
13287dd5
MS
468
469 delete $expect->{details};
470 delete $results{details};
c0bb2de7 471
d5d4ec93 472 SKIP: {
943b127a 473 skip '$? unreliable in MacPerl', 2 if $IsMacOS;
d5d4ec93
MS
474
475 # We can only check if it's zero or non-zero.
476 is( !!$results{'wait'}, !!$expect->{'wait'}, 'wait status' );
477 delete $results{'wait'};
478 delete $expect->{'wait'};
479
480 # Have to check the exit status seperately so we can skip it
481 # in MacPerl.
482 is( $results{'exit'}, $expect->{'exit'} );
483 delete $results{'exit'};
484 delete $expect->{'exit'};
485 }
c0bb2de7 486
f0008e52 487 is_deeply(\%results, $expect, " the rest $test" );
13287dd5 488}
0be28027
JH
489
490
491my $strap = Test::Harness::Straps->new;
492ok( !$strap->analyze_file('I_dont_exist') );
493is( $strap->{error}, "I_dont_exist does not exist" );