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 | |
13287dd5 |
13 | my $SAMPLE_TESTS = $ENV{PERL_CORE} ? "lib/sample-tests" : "t/sample-tests"; |
14 | |
2fe373ce |
15 | use strict; |
16 | |
17 | # For shutting up Test::Harness. |
13287dd5 |
18 | # Has to work on 5.004 which doesn't have Tie::StdHandle. |
2fe373ce |
19 | package My::Dev::Null; |
20 | |
21 | sub WRITE {} |
22 | sub PRINT {} |
23 | sub PRINTF {} |
24 | sub TIEHANDLE { |
25 | my $class = shift; |
26 | my $fh = do { local *HANDLE; \*HANDLE }; |
27 | return bless $fh, $class; |
28 | } |
29 | sub READ {} |
30 | sub READLINE {} |
31 | sub GETC {} |
32 | |
33 | |
34 | package main; |
35 | |
356733da |
36 | use Test::More; |
2fe373ce |
37 | |
f0008e52 |
38 | my $IsVMS = $^O eq 'VMS'; |
2fe373ce |
39 | |
f0008e52 |
40 | # VMS uses native, not POSIX, exit codes. |
41 | my $die_estat = $IsVMS ? 44 : 1; |
42 | my $die_wstat = $IsVMS ? 1024 : 256; |
356733da |
43 | |
f0008e52 |
44 | my %samples = ( |
45 | simple => { |
46 | total => { |
47 | bonus => 0, |
48 | max => 5, |
49 | 'ok' => 5, |
50 | files => 1, |
51 | bad => 0, |
52 | good => 1, |
53 | tests => 1, |
54 | sub_skipped=> 0, |
55 | 'todo' => 0, |
56 | skipped => 0, |
57 | }, |
58 | failed => { }, |
59 | all_ok => 1, |
60 | }, |
61 | simple_fail => { |
62 | total => { |
63 | bonus => 0, |
64 | max => 5, |
65 | 'ok' => 3, |
66 | files => 1, |
67 | bad => 1, |
68 | good => 0, |
69 | tests => 1, |
70 | sub_skipped => 0, |
71 | 'todo' => 0, |
72 | skipped => 0, |
73 | }, |
74 | failed => { |
75 | canon => '2 5', |
76 | }, |
77 | all_ok => 0, |
78 | }, |
79 | descriptive => { |
80 | total => { |
81 | bonus => 0, |
82 | max => 5, |
83 | 'ok' => 5, |
84 | files => 1, |
85 | bad => 0, |
86 | good => 1, |
87 | tests => 1, |
88 | sub_skipped=> 0, |
89 | 'todo' => 0, |
90 | skipped => 0, |
91 | }, |
92 | failed => { }, |
93 | all_ok => 1, |
94 | }, |
95 | no_nums => { |
96 | total => { |
97 | bonus => 0, |
98 | max => 5, |
99 | 'ok' => 4, |
100 | files => 1, |
101 | bad => 1, |
102 | good => 0, |
103 | tests => 1, |
104 | sub_skipped=> 0, |
105 | 'todo' => 0, |
106 | skipped => 0, |
107 | }, |
108 | failed => { |
109 | canon => '3', |
110 | }, |
111 | all_ok => 0, |
112 | }, |
113 | 'todo' => { |
114 | total => { |
115 | bonus => 1, |
116 | max => 5, |
117 | 'ok' => 5, |
118 | files => 1, |
119 | bad => 0, |
120 | good => 1, |
121 | tests => 1, |
122 | sub_skipped=> 0, |
123 | 'todo' => 2, |
124 | skipped => 0, |
125 | }, |
126 | failed => { }, |
127 | all_ok => 1, |
128 | }, |
129 | todo_inline => { |
130 | total => { |
131 | bonus => 1, |
132 | max => 3, |
133 | 'ok' => 3, |
134 | files => 1, |
135 | bad => 0, |
136 | good => 1, |
137 | tests => 1, |
138 | sub_skipped => 0, |
139 | 'todo' => 2, |
140 | skipped => 0, |
141 | }, |
142 | failed => { }, |
143 | all_ok => 1, |
144 | }, |
145 | 'skip' => { |
146 | total => { |
147 | bonus => 0, |
148 | max => 5, |
149 | 'ok' => 5, |
150 | files => 1, |
151 | bad => 0, |
152 | good => 1, |
153 | tests => 1, |
154 | sub_skipped=> 1, |
155 | 'todo' => 0, |
156 | skipped => 0, |
157 | }, |
158 | failed => { }, |
159 | all_ok => 1, |
160 | }, |
161 | bailout => 0, |
162 | combined => { |
163 | total => { |
164 | bonus => 1, |
165 | max => 10, |
166 | 'ok' => 8, |
167 | files => 1, |
168 | bad => 1, |
169 | good => 0, |
170 | tests => 1, |
171 | sub_skipped=> 1, |
172 | 'todo' => 2, |
173 | skipped => 0 |
174 | }, |
175 | failed => { |
176 | canon => '3 9', |
177 | }, |
178 | all_ok => 0, |
179 | }, |
180 | duplicates => { |
181 | total => { |
182 | bonus => 0, |
183 | max => 10, |
184 | 'ok' => 11, |
185 | files => 1, |
186 | bad => 1, |
187 | good => 0, |
188 | tests => 1, |
189 | sub_skipped=> 0, |
190 | 'todo' => 0, |
191 | skipped => 0, |
192 | }, |
193 | failed => { |
194 | canon => '??', |
195 | }, |
196 | all_ok => 0, |
197 | }, |
198 | head_end => { |
199 | total => { |
200 | bonus => 0, |
201 | max => 4, |
202 | 'ok' => 4, |
203 | files => 1, |
204 | bad => 0, |
205 | good => 1, |
206 | tests => 1, |
207 | sub_skipped=> 0, |
208 | 'todo' => 0, |
209 | skipped => 0, |
210 | }, |
211 | failed => { }, |
212 | all_ok => 1, |
213 | }, |
214 | head_fail => { |
215 | total => { |
216 | bonus => 0, |
217 | max => 4, |
218 | 'ok' => 3, |
219 | files => 1, |
220 | bad => 1, |
221 | good => 0, |
222 | tests => 1, |
223 | sub_skipped=> 0, |
224 | 'todo' => 0, |
225 | skipped => 0, |
226 | }, |
227 | failed => { |
228 | canon => '2', |
229 | }, |
230 | all_ok => 0, |
231 | }, |
232 | skip_all => { |
233 | total => { |
234 | bonus => 0, |
235 | max => 0, |
236 | 'ok' => 0, |
237 | files => 1, |
238 | bad => 0, |
239 | good => 1, |
240 | tests => 1, |
241 | sub_skipped=> 0, |
242 | 'todo' => 0, |
243 | skipped => 1, |
244 | }, |
245 | failed => { }, |
246 | all_ok => 1, |
247 | }, |
248 | with_comments => { |
249 | total => { |
250 | bonus => 2, |
251 | max => 5, |
252 | 'ok' => 5, |
253 | files => 1, |
254 | bad => 0, |
255 | good => 1, |
256 | tests => 1, |
257 | sub_skipped=> 0, |
258 | 'todo' => 4, |
259 | skipped => 0, |
260 | }, |
261 | failed => { }, |
262 | all_ok => 1, |
263 | }, |
264 | taint => { |
265 | total => { |
266 | bonus => 0, |
267 | max => 1, |
268 | 'ok' => 1, |
269 | files => 1, |
270 | bad => 0, |
271 | good => 1, |
272 | tests => 1, |
273 | sub_skipped=> 0, |
274 | 'todo' => 0, |
275 | skipped => 0, |
276 | }, |
277 | failed => { }, |
278 | all_ok => 1, |
279 | }, |
2fe373ce |
280 | |
f0008e52 |
281 | 'die' => { |
282 | total => { |
283 | bonus => 0, |
284 | max => 0, |
285 | 'ok' => 0, |
286 | files => 1, |
287 | bad => 1, |
288 | good => 0, |
289 | tests => 1, |
290 | sub_skipped=> 0, |
291 | 'todo' => 0, |
292 | skipped => 0, |
293 | }, |
294 | failed => { |
295 | estat => $die_estat, |
296 | wstat => $die_wstat, |
297 | max => '??', |
298 | failed => '??', |
299 | canon => '??', |
300 | }, |
301 | all_ok => 0, |
302 | }, |
356733da |
303 | |
f0008e52 |
304 | die_head_end => { |
305 | total => { |
306 | bonus => 0, |
307 | max => 0, |
308 | 'ok' => 4, |
309 | files => 1, |
310 | bad => 1, |
311 | good => 0, |
312 | tests => 1, |
313 | sub_skipped=> 0, |
314 | 'todo' => 0, |
315 | skipped => 0, |
316 | }, |
317 | failed => { |
318 | estat => $die_estat, |
319 | wstat => $die_wstat, |
320 | max => '??', |
321 | failed => '??', |
322 | canon => '??', |
323 | }, |
324 | all_ok => 0, |
325 | }, |
356733da |
326 | |
f0008e52 |
327 | die_last_minute => { |
328 | total => { |
329 | bonus => 0, |
330 | max => 4, |
331 | 'ok' => 4, |
332 | files => 1, |
333 | bad => 1, |
334 | good => 0, |
335 | tests => 1, |
336 | sub_skipped=> 0, |
337 | 'todo' => 0, |
338 | skipped => 0, |
339 | }, |
340 | failed => { |
341 | estat => $die_estat, |
342 | wstat => $die_wstat, |
343 | max => 4, |
344 | failed => 0, |
345 | canon => '??', |
346 | }, |
347 | all_ok => 0, |
348 | }, |
349 | bignum => { |
350 | total => { |
351 | bonus => 0, |
352 | max => 2, |
353 | 'ok' => 4, |
354 | files => 1, |
355 | bad => 1, |
356 | good => 0, |
357 | tests => 1, |
358 | sub_skipped=> 0, |
359 | 'todo' => 0, |
360 | skipped => 0, |
361 | }, |
362 | failed => { |
363 | canon => '??', |
364 | }, |
365 | all_ok => 0, |
366 | }, |
367 | ); |
356733da |
368 | |
f0008e52 |
369 | plan tests => (keys(%samples) * 4) + 1; |
370 | |
371 | use Test::Harness; |
372 | use_ok('Test::Harness'); |
2fe373ce |
373 | |
2fe373ce |
374 | |
375 | tie *NULL, 'My::Dev::Null' or die $!; |
376 | |
377 | while (my($test, $expect) = each %samples) { |
378 | # _run_all_tests() runs the tests but skips the formatting. |
379 | my($totals, $failed); |
380 | eval { |
381 | select NULL; # _run_all_tests() isn't as quiet as it should be. |
382 | ($totals, $failed) = |
13287dd5 |
383 | Test::Harness::_run_all_tests("$SAMPLE_TESTS/$test"); |
2fe373ce |
384 | }; |
385 | select STDOUT; |
386 | |
387 | unless( $@ ) { |
356733da |
388 | is( Test::Harness::_all_ok($totals), $expect->{all_ok}, |
2fe373ce |
389 | "$test - all ok" ); |
390 | ok( defined $expect->{total}, "$test - has total" ); |
356733da |
391 | is_deeply( {map { $_=>$totals->{$_} } keys %{$expect->{total}}}, |
392 | $expect->{total}, |
2fe373ce |
393 | "$test - totals" ); |
356733da |
394 | is_deeply( {map { $_=>$failed->{"$SAMPLE_TESTS/$test"}{$_} } |
395 | keys %{$expect->{failed}}}, |
396 | $expect->{failed}, |
2fe373ce |
397 | "$test - failed" ); |
398 | } |
399 | else { # special case for bailout |
356733da |
400 | is( $test, 'bailout' ); |
401 | like( $@, '/Further testing stopped: GERONI/i', $test ); |
402 | pass( 'skipping for bailout' ); |
403 | pass( 'skipping for bailout' ); |
2fe373ce |
404 | } |
405 | } |