Commit | Line | Data |
356733da |
1 | #!/usr/bin/perl -w |
2fe373ce |
2 | |
3 | BEGIN { |
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 | |
d5201bd2 |
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 |
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 |
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 |
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 |
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 |
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 |
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 |
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 |
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 |
332 | max => '??', |
333 | failed => '??', |
334 | canon => '??', |
335 | }, |
336 | all_ok => 0, |
337 | }, |
356733da |
338 | |
f0008e52 |
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 |
354 | max => '??', |
355 | failed => '??', |
356 | canon => '??', |
357 | }, |
358 | all_ok => 0, |
359 | }, |
356733da |
360 | |
f0008e52 |
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 |
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 |
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 |
419 | |
420 | use Test::Harness; |
421 | use_ok('Test::Harness'); |
2fe373ce |
422 | |
2fe373ce |
423 | |
424 | tie *NULL, 'My::Dev::Null' or die $!; |
425 | |
ccf80546 |
426 | $SAMPLE_TESTS = VMS::Filespec::unixify($SAMPLE_TESTS) if $^O eq 'VMS'; |
427 | |
2fe373ce |
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 |
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 |
437 | catfile($SAMPLE_TESTS, $test) : |
438 | "$SAMPLE_TESTS/$test"); |
2fe373ce |
439 | }; |
440 | select STDOUT; |
441 | |
308957f5 |
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 |
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 |
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 |
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 | } |