Commit | Line | Data |
---|---|---|
356733da | 1 | #!/usr/bin/perl -w |
2fe373ce MS |
2 | |
3 | BEGIN { | |
13287dd5 MS |
4 | if( $ENV{PERL_CORE} ) { |
5 | chdir 't'; | |
356733da MS |
6 | @INC = ('../lib', 'lib'); |
7 | } | |
8 | else { | |
9 | unshift @INC, 't/lib'; | |
13287dd5 | 10 | } |
2fe373ce MS |
11 | } |
12 | ||
d5201bd2 JH |
13 | use File::Spec::Functions; |
14 | ||
15 | my $SAMPLE_TESTS = $ENV{PERL_CORE} | |
16 | ? catdir(curdir(), 'lib', 'sample-tests') | |
17 | : catdir(curdir(), 't', 'sample-tests'); | |
13287dd5 | 18 | |
2fe373ce MS |
19 | use strict; |
20 | ||
21 | # For shutting up Test::Harness. | |
13287dd5 | 22 | # Has to work on 5.004 which doesn't have Tie::StdHandle. |
2fe373ce MS |
23 | package My::Dev::Null; |
24 | ||
25 | sub WRITE {} | |
26 | sub PRINT {} | |
27 | sub PRINTF {} | |
28 | sub TIEHANDLE { | |
29 | my $class = shift; | |
30 | my $fh = do { local *HANDLE; \*HANDLE }; | |
31 | return bless $fh, $class; | |
32 | } | |
33 | sub READ {} | |
34 | sub READLINE {} | |
35 | sub GETC {} | |
36 | ||
37 | ||
38 | package main; | |
39 | ||
356733da | 40 | use Test::More; |
2fe373ce | 41 | |
f0008e52 | 42 | my $IsVMS = $^O eq 'VMS'; |
d5201bd2 | 43 | my $IsMacOS = $^O eq 'MacOS'; |
2fe373ce | 44 | |
f0008e52 | 45 | # VMS uses native, not POSIX, exit codes. |
d5201bd2 | 46 | my $die_estat = $IsVMS ? 44 : $IsMacOS ? 0 : 1; |
356733da | 47 | |
f0008e52 MS |
48 | my %samples = ( |
49 | simple => { | |
50 | total => { | |
51 | bonus => 0, | |
52 | max => 5, | |
53 | 'ok' => 5, | |
54 | files => 1, | |
55 | bad => 0, | |
56 | good => 1, | |
57 | tests => 1, | |
58 | sub_skipped=> 0, | |
59 | 'todo' => 0, | |
60 | skipped => 0, | |
61 | }, | |
62 | failed => { }, | |
63 | all_ok => 1, | |
64 | }, | |
65 | simple_fail => { | |
66 | total => { | |
67 | bonus => 0, | |
68 | max => 5, | |
69 | 'ok' => 3, | |
70 | files => 1, | |
71 | bad => 1, | |
72 | good => 0, | |
73 | tests => 1, | |
74 | sub_skipped => 0, | |
75 | 'todo' => 0, | |
76 | skipped => 0, | |
77 | }, | |
78 | failed => { | |
79 | canon => '2 5', | |
80 | }, | |
81 | all_ok => 0, | |
82 | }, | |
83 | descriptive => { | |
84 | total => { | |
85 | bonus => 0, | |
86 | max => 5, | |
87 | 'ok' => 5, | |
88 | files => 1, | |
89 | bad => 0, | |
90 | good => 1, | |
91 | tests => 1, | |
92 | sub_skipped=> 0, | |
93 | 'todo' => 0, | |
94 | skipped => 0, | |
95 | }, | |
96 | failed => { }, | |
97 | all_ok => 1, | |
98 | }, | |
99 | no_nums => { | |
100 | total => { | |
101 | bonus => 0, | |
102 | max => 5, | |
103 | 'ok' => 4, | |
104 | files => 1, | |
105 | bad => 1, | |
106 | good => 0, | |
107 | tests => 1, | |
108 | sub_skipped=> 0, | |
109 | 'todo' => 0, | |
110 | skipped => 0, | |
111 | }, | |
112 | failed => { | |
113 | canon => '3', | |
114 | }, | |
115 | all_ok => 0, | |
116 | }, | |
117 | 'todo' => { | |
118 | total => { | |
119 | bonus => 1, | |
120 | max => 5, | |
121 | 'ok' => 5, | |
122 | files => 1, | |
123 | bad => 0, | |
124 | good => 1, | |
125 | tests => 1, | |
126 | sub_skipped=> 0, | |
127 | 'todo' => 2, | |
128 | skipped => 0, | |
129 | }, | |
130 | failed => { }, | |
131 | all_ok => 1, | |
132 | }, | |
133 | todo_inline => { | |
134 | total => { | |
135 | bonus => 1, | |
136 | max => 3, | |
137 | 'ok' => 3, | |
138 | files => 1, | |
139 | bad => 0, | |
140 | good => 1, | |
141 | tests => 1, | |
142 | sub_skipped => 0, | |
143 | 'todo' => 2, | |
144 | skipped => 0, | |
145 | }, | |
146 | failed => { }, | |
147 | all_ok => 1, | |
148 | }, | |
149 | 'skip' => { | |
150 | total => { | |
151 | bonus => 0, | |
152 | max => 5, | |
153 | 'ok' => 5, | |
154 | files => 1, | |
155 | bad => 0, | |
156 | good => 1, | |
157 | tests => 1, | |
158 | sub_skipped=> 1, | |
159 | 'todo' => 0, | |
160 | skipped => 0, | |
161 | }, | |
162 | failed => { }, | |
163 | all_ok => 1, | |
164 | }, | |
0be28027 JH |
165 | 'skip_nomsg' => { |
166 | total => { | |
167 | bonus => 0, | |
168 | max => 1, | |
169 | 'ok' => 1, | |
170 | files => 1, | |
171 | bad => 0, | |
172 | good => 1, | |
173 | tests => 1, | |
174 | sub_skipped=> 1, | |
175 | 'todo' => 0, | |
176 | skipped => 0, | |
177 | }, | |
178 | failed => { }, | |
179 | all_ok => 1, | |
180 | }, | |
f0008e52 MS |
181 | bailout => 0, |
182 | combined => { | |
183 | total => { | |
184 | bonus => 1, | |
185 | max => 10, | |
186 | 'ok' => 8, | |
187 | files => 1, | |
188 | bad => 1, | |
189 | good => 0, | |
190 | tests => 1, | |
191 | sub_skipped=> 1, | |
192 | 'todo' => 2, | |
193 | skipped => 0 | |
194 | }, | |
195 | failed => { | |
196 | canon => '3 9', | |
197 | }, | |
198 | all_ok => 0, | |
199 | }, | |
200 | duplicates => { | |
201 | total => { | |
202 | bonus => 0, | |
203 | max => 10, | |
204 | 'ok' => 11, | |
205 | files => 1, | |
206 | bad => 1, | |
207 | good => 0, | |
208 | tests => 1, | |
209 | sub_skipped=> 0, | |
210 | 'todo' => 0, | |
211 | skipped => 0, | |
212 | }, | |
213 | failed => { | |
214 | canon => '??', | |
215 | }, | |
216 | all_ok => 0, | |
217 | }, | |
218 | head_end => { | |
219 | total => { | |
220 | bonus => 0, | |
221 | max => 4, | |
222 | 'ok' => 4, | |
223 | files => 1, | |
224 | bad => 0, | |
225 | good => 1, | |
226 | tests => 1, | |
227 | sub_skipped=> 0, | |
228 | 'todo' => 0, | |
229 | skipped => 0, | |
230 | }, | |
231 | failed => { }, | |
232 | all_ok => 1, | |
233 | }, | |
234 | head_fail => { | |
235 | total => { | |
236 | bonus => 0, | |
237 | max => 4, | |
238 | 'ok' => 3, | |
239 | files => 1, | |
240 | bad => 1, | |
241 | good => 0, | |
242 | tests => 1, | |
243 | sub_skipped=> 0, | |
244 | 'todo' => 0, | |
245 | skipped => 0, | |
246 | }, | |
247 | failed => { | |
248 | canon => '2', | |
249 | }, | |
250 | all_ok => 0, | |
251 | }, | |
0be28027 JH |
252 | skipall => { |
253 | total => { | |
254 | bonus => 0, | |
255 | max => 0, | |
256 | 'ok' => 0, | |
257 | files => 1, | |
258 | bad => 0, | |
259 | good => 1, | |
260 | tests => 1, | |
261 | sub_skipped=> 0, | |
262 | 'todo' => 0, | |
263 | skipped => 1, | |
264 | }, | |
265 | failed => { }, | |
266 | all_ok => 1, | |
267 | }, | |
268 | skipall_nomsg => { | |
f0008e52 MS |
269 | total => { |
270 | bonus => 0, | |
271 | max => 0, | |
272 | 'ok' => 0, | |
273 | files => 1, | |
274 | bad => 0, | |
275 | good => 1, | |
276 | tests => 1, | |
277 | sub_skipped=> 0, | |
278 | 'todo' => 0, | |
279 | skipped => 1, | |
280 | }, | |
281 | failed => { }, | |
282 | all_ok => 1, | |
283 | }, | |
284 | with_comments => { | |
285 | total => { | |
286 | bonus => 2, | |
287 | max => 5, | |
288 | 'ok' => 5, | |
289 | files => 1, | |
290 | bad => 0, | |
291 | good => 1, | |
292 | tests => 1, | |
293 | sub_skipped=> 0, | |
294 | 'todo' => 4, | |
295 | skipped => 0, | |
296 | }, | |
297 | failed => { }, | |
298 | all_ok => 1, | |
299 | }, | |
300 | taint => { | |
301 | total => { | |
302 | bonus => 0, | |
303 | max => 1, | |
304 | 'ok' => 1, | |
305 | files => 1, | |
306 | bad => 0, | |
307 | good => 1, | |
308 | tests => 1, | |
309 | sub_skipped=> 0, | |
310 | 'todo' => 0, | |
311 | skipped => 0, | |
312 | }, | |
313 | failed => { }, | |
314 | all_ok => 1, | |
315 | }, | |
2fe373ce | 316 | |
f0008e52 MS |
317 | 'die' => { |
318 | total => { | |
319 | bonus => 0, | |
320 | max => 0, | |
321 | 'ok' => 0, | |
322 | files => 1, | |
323 | bad => 1, | |
324 | good => 0, | |
325 | tests => 1, | |
326 | sub_skipped=> 0, | |
327 | 'todo' => 0, | |
328 | skipped => 0, | |
329 | }, | |
330 | failed => { | |
331 | estat => $die_estat, | |
f0008e52 MS |
332 | max => '??', |
333 | failed => '??', | |
334 | canon => '??', | |
335 | }, | |
336 | all_ok => 0, | |
337 | }, | |
356733da | 338 | |
f0008e52 MS |
339 | die_head_end => { |
340 | total => { | |
341 | bonus => 0, | |
342 | max => 0, | |
343 | 'ok' => 4, | |
344 | files => 1, | |
345 | bad => 1, | |
346 | good => 0, | |
347 | tests => 1, | |
348 | sub_skipped=> 0, | |
349 | 'todo' => 0, | |
350 | skipped => 0, | |
351 | }, | |
352 | failed => { | |
353 | estat => $die_estat, | |
f0008e52 MS |
354 | max => '??', |
355 | failed => '??', | |
356 | canon => '??', | |
357 | }, | |
358 | all_ok => 0, | |
359 | }, | |
356733da | 360 | |
f0008e52 MS |
361 | die_last_minute => { |
362 | total => { | |
363 | bonus => 0, | |
364 | max => 4, | |
365 | 'ok' => 4, | |
366 | files => 1, | |
367 | bad => 1, | |
368 | good => 0, | |
369 | tests => 1, | |
370 | sub_skipped=> 0, | |
371 | 'todo' => 0, | |
372 | skipped => 0, | |
373 | }, | |
374 | failed => { | |
375 | estat => $die_estat, | |
f0008e52 MS |
376 | max => 4, |
377 | failed => 0, | |
378 | canon => '??', | |
379 | }, | |
380 | all_ok => 0, | |
381 | }, | |
382 | bignum => { | |
383 | total => { | |
384 | bonus => 0, | |
385 | max => 2, | |
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 | canon => '??', | |
397 | }, | |
398 | all_ok => 0, | |
399 | }, | |
6e5a998b MS |
400 | 'shbang_misparse' => { |
401 | total => { | |
402 | bonus => 0, | |
403 | max => 2, | |
404 | 'ok' => 2, | |
405 | files => 1, | |
406 | bad => 0, | |
407 | good => 1, | |
408 | tests => 1, | |
409 | sub_skipped=> 0, | |
410 | 'todo' => 0, | |
411 | skipped => 0, | |
412 | }, | |
413 | failed => { }, | |
414 | all_ok => 1, | |
415 | }, | |
f0008e52 | 416 | ); |
356733da | 417 | |
308957f5 | 418 | plan tests => (keys(%samples) * 7) + 1; |
f0008e52 MS |
419 | |
420 | use Test::Harness; | |
421 | use_ok('Test::Harness'); | |
2fe373ce | 422 | |
2fe373ce MS |
423 | |
424 | tie *NULL, 'My::Dev::Null' or die $!; | |
425 | ||
ccf80546 JH |
426 | $SAMPLE_TESTS = VMS::Filespec::unixify($SAMPLE_TESTS) if $^O eq 'VMS'; |
427 | ||
2fe373ce MS |
428 | while (my($test, $expect) = each %samples) { |
429 | # _run_all_tests() runs the tests but skips the formatting. | |
430 | my($totals, $failed); | |
308957f5 | 431 | my $warning; |
2fe373ce MS |
432 | eval { |
433 | select NULL; # _run_all_tests() isn't as quiet as it should be. | |
308957f5 | 434 | local $SIG{__WARN__} = sub { $warning .= join '', @_; }; |
2fe373ce | 435 | ($totals, $failed) = |
5b865721 | 436 | Test::Harness::_run_all_tests($^O eq 'MacOS' ? |
66bb7cd3 JH |
437 | catfile($SAMPLE_TESTS, $test) : |
438 | "$SAMPLE_TESTS/$test"); | |
2fe373ce MS |
439 | }; |
440 | select STDOUT; | |
441 | ||
308957f5 JH |
442 | SKIP: { |
443 | skip "special tests for bailout", 1 unless $test eq 'bailout'; | |
444 | like( $@, '/Further testing stopped: GERONI/i' ); | |
445 | } | |
446 | ||
447 | SKIP: { | |
448 | skip "don't apply to a bailout", 5 if $test eq 'bailout'; | |
449 | is( $@, '' ); | |
450 | is( Test::Harness::_all_ok($totals), $expect->{all_ok}, | |
451 | "$test - all ok" ); | |
452 | ok( defined $expect->{total}, "$test - has total" ); | |
356733da MS |
453 | is_deeply( {map { $_=>$totals->{$_} } keys %{$expect->{total}}}, |
454 | $expect->{total}, | |
308957f5 | 455 | "$test - totals" ); |
5b865721 | 456 | is_deeply( {map { $_=>$failed->{$^O eq 'MacOS' ? |
b70f73b7 JH |
457 | catfile($SAMPLE_TESTS, $test) : |
458 | "$SAMPLE_TESTS/$test"}{$_} } | |
308957f5 | 459 | keys %{$expect->{failed}}}, |
356733da | 460 | $expect->{failed}, |
308957f5 | 461 | "$test - failed" ); |
2fe373ce | 462 | } |
308957f5 JH |
463 | |
464 | SKIP: { | |
465 | skip "special tests for bignum", 1 unless $test eq 'bignum'; | |
466 | is( $warning, <<WARN ); | |
467 | Enourmous test number seen [test 100001] | |
468 | Can't detailize, too big. | |
469 | Enourmous test number seen [test 136211425] | |
470 | Can't detailize, too big. | |
471 | WARN | |
472 | ||
2fe373ce | 473 | } |
308957f5 | 474 | |
2fe373ce | 475 | } |