Commit | Line | Data |
b965d173 |
1 | #!/usr/bin/perl -w |
2 | |
3 | use strict; |
4 | |
5 | BEGIN { |
2a7f4b9b |
6 | if ( $ENV{PERL_CORE} ) { |
b965d173 |
7 | chdir 't'; |
2a7f4b9b |
8 | @INC = ( '../lib', 'lib' ); |
b965d173 |
9 | } |
10 | else { |
2a7f4b9b |
11 | use lib 't/lib'; |
b965d173 |
12 | } |
13 | } |
14 | |
f7c69158 |
15 | use Test::More tests => 282; |
b965d173 |
16 | use IO::c55Capture; |
17 | |
18 | use File::Spec; |
19 | |
20 | use TAP::Parser; |
f7c69158 |
21 | use TAP::Parser::IteratorFactory; |
b965d173 |
22 | |
23 | sub _get_results { |
24 | my $parser = shift; |
25 | my @results; |
26 | while ( defined( my $result = $parser->next ) ) { |
27 | push @results => $result; |
28 | } |
29 | return @results; |
30 | } |
31 | |
2a7f4b9b |
32 | my ( $PARSER, $PLAN, $PRAGMA, $TEST, $COMMENT, $BAILOUT, $UNKNOWN, $YAML, $VERSION ) = qw( |
b965d173 |
33 | TAP::Parser |
34 | TAP::Parser::Result::Plan |
2a7f4b9b |
35 | TAP::Parser::Result::Pragma |
b965d173 |
36 | TAP::Parser::Result::Test |
37 | TAP::Parser::Result::Comment |
38 | TAP::Parser::Result::Bailout |
39 | TAP::Parser::Result::Unknown |
40 | TAP::Parser::Result::YAML |
41 | TAP::Parser::Result::Version |
42 | ); |
43 | |
f7c69158 |
44 | my $factory = TAP::Parser::IteratorFactory->new; |
45 | |
b965d173 |
46 | my $tap = <<'END_TAP'; |
47 | TAP version 13 |
48 | 1..7 |
49 | ok 1 - input file opened |
50 | ... this is junk |
51 | not ok first line of the input valid # todo some data |
52 | # this is a comment |
53 | ok 3 - read the rest of the file |
54 | not ok 4 - this is a real failure |
55 | --- YAML! |
56 | ... |
57 | ok 5 # skip we have no description |
58 | ok 6 - you shall not pass! # TODO should have failed |
59 | not ok 7 - Gandalf wins. Game over. # TODO 'bout time! |
60 | END_TAP |
61 | |
62 | can_ok $PARSER, 'new'; |
63 | my $parser = $PARSER->new( { tap => $tap } ); |
64 | isa_ok $parser, $PARSER, '... and the object it returns'; |
65 | |
66 | ok $ENV{TAP_VERSION}, 'TAP_VERSION env variable should be set'; |
67 | |
68 | # results() is sane? |
69 | |
70 | my @results = _get_results($parser); |
71 | is scalar @results, 12, '... and there should be one for each line'; |
72 | |
73 | my $version = shift @results; |
74 | isa_ok $version, $VERSION; |
75 | is $version->version, '13', '... and the version should be 13'; |
76 | |
77 | # check the test plan |
78 | |
79 | my $result = shift @results; |
80 | isa_ok $result, $PLAN; |
81 | can_ok $result, 'type'; |
82 | is $result->type, 'plan', '... and it should report the correct type'; |
83 | ok $result->is_plan, '... and it should identify itself as a plan'; |
84 | is $result->plan, '1..7', '... and identify the plan'; |
85 | ok !$result->directive, '... and this plan should not have a directive'; |
86 | ok !$result->explanation, '... or a directive explanation'; |
87 | is $result->as_string, '1..7', |
88 | '... and have the correct string representation'; |
89 | is $result->raw, '1..7', '... and raw() should return the original line'; |
90 | |
91 | # a normal, passing test |
92 | |
93 | my $test = shift @results; |
94 | isa_ok $test, $TEST; |
95 | is $test->type, 'test', '... and it should report the correct type'; |
96 | ok $test->is_test, '... and it should identify itself as a test'; |
97 | is $test->ok, 'ok', '... and it should have the correct ok()'; |
98 | ok $test->is_ok, '... and the correct boolean version of is_ok()'; |
99 | ok $test->is_actual_ok, |
100 | '... and the correct boolean version of is_actual_ok()'; |
101 | is $test->number, 1, '... and have the correct test number'; |
102 | is $test->description, '- input file opened', |
103 | '... and the correct description'; |
104 | ok !$test->directive, '... and not have a directive'; |
105 | ok !$test->explanation, '... or a directive explanation'; |
106 | ok !$test->has_skip, '... and it is not a SKIPped test'; |
107 | ok !$test->has_todo, '... nor a TODO test'; |
108 | is $test->as_string, 'ok 1 - input file opened', |
109 | '... and its string representation should be correct'; |
110 | is $test->raw, 'ok 1 - input file opened', |
111 | '... and raw() should return the original line'; |
112 | |
113 | # junk lines should be preserved |
114 | |
115 | my $unknown = shift @results; |
116 | isa_ok $unknown, $UNKNOWN; |
117 | is $unknown->type, 'unknown', '... and it should report the correct type'; |
118 | ok $unknown->is_unknown, '... and it should identify itself as unknown'; |
119 | is $unknown->as_string, '... this is junk', |
120 | '... and its string representation should be returned verbatim'; |
121 | is $unknown->raw, '... this is junk', |
122 | '... and raw() should return the original line'; |
123 | |
124 | # a failing test, which also happens to have a directive |
125 | |
126 | my $failed = shift @results; |
127 | isa_ok $failed, $TEST; |
128 | is $failed->type, 'test', '... and it should report the correct type'; |
129 | ok $failed->is_test, '... and it should identify itself as a test'; |
130 | is $failed->ok, 'not ok', '... and it should have the correct ok()'; |
131 | ok $failed->is_ok, '... and TODO tests should always pass'; |
132 | ok !$failed->is_actual_ok, |
133 | '... and the correct boolean version of is_actual_ok ()'; |
134 | is $failed->number, 2, '... and have the correct failed number'; |
135 | is $failed->description, 'first line of the input valid', |
136 | '... and the correct description'; |
137 | is $failed->directive, 'TODO', '... and should have the correct directive'; |
138 | is $failed->explanation, 'some data', |
139 | '... and the correct directive explanation'; |
140 | ok !$failed->has_skip, '... and it is not a SKIPped failed'; |
141 | ok $failed->has_todo, '... but it is a TODO succeeded'; |
142 | is $failed->as_string, |
143 | 'not ok 2 first line of the input valid # TODO some data', |
144 | '... and its string representation should be correct'; |
145 | is $failed->raw, 'not ok first line of the input valid # todo some data', |
146 | '... and raw() should return the original line'; |
147 | |
148 | # comments |
149 | |
150 | my $comment = shift @results; |
151 | isa_ok $comment, $COMMENT; |
152 | is $comment->type, 'comment', '... and it should report the correct type'; |
153 | ok $comment->is_comment, '... and it should identify itself as a comment'; |
154 | is $comment->comment, 'this is a comment', |
155 | '... and you should be able to fetch the comment'; |
156 | is $comment->as_string, '# this is a comment', |
157 | '... and have the correct string representation'; |
158 | is $comment->raw, '# this is a comment', |
159 | '... and raw() should return the original line'; |
160 | |
161 | # another normal, passing test |
162 | |
163 | $test = shift @results; |
164 | isa_ok $test, $TEST; |
165 | is $test->type, 'test', '... and it should report the correct type'; |
166 | ok $test->is_test, '... and it should identify itself as a test'; |
167 | is $test->ok, 'ok', '... and it should have the correct ok()'; |
168 | ok $test->is_ok, '... and the correct boolean version of is_ok()'; |
169 | ok $test->is_actual_ok, |
170 | '... and the correct boolean version of is_actual_ok()'; |
171 | is $test->number, 3, '... and have the correct test number'; |
172 | is $test->description, '- read the rest of the file', |
173 | '... and the correct description'; |
174 | ok !$test->directive, '... and not have a directive'; |
175 | ok !$test->explanation, '... or a directive explanation'; |
176 | ok !$test->has_skip, '... and it is not a SKIPped test'; |
177 | ok !$test->has_todo, '... nor a TODO test'; |
178 | is $test->as_string, 'ok 3 - read the rest of the file', |
179 | '... and its string representation should be correct'; |
180 | is $test->raw, 'ok 3 - read the rest of the file', |
181 | '... and raw() should return the original line'; |
182 | |
183 | # a failing test |
184 | |
185 | $failed = shift @results; |
186 | isa_ok $failed, $TEST; |
187 | is $failed->type, 'test', '... and it should report the correct type'; |
188 | ok $failed->is_test, '... and it should identify itself as a test'; |
189 | is $failed->ok, 'not ok', '... and it should have the correct ok()'; |
190 | ok !$failed->is_ok, '... and the tests should not have passed'; |
191 | ok !$failed->is_actual_ok, |
192 | '... and the correct boolean version of is_actual_ok ()'; |
193 | is $failed->number, 4, '... and have the correct failed number'; |
194 | is $failed->description, '- this is a real failure', |
195 | '... and the correct description'; |
196 | ok !$failed->directive, '... and should have no directive'; |
197 | ok !$failed->explanation, '... and no directive explanation'; |
198 | ok !$failed->has_skip, '... and it is not a SKIPped failed'; |
199 | ok !$failed->has_todo, '... and not a TODO test'; |
200 | is $failed->as_string, 'not ok 4 - this is a real failure', |
201 | '... and its string representation should be correct'; |
202 | is $failed->raw, 'not ok 4 - this is a real failure', |
203 | '... and raw() should return the original line'; |
204 | |
205 | # Some YAML |
206 | my $yaml = shift @results; |
207 | isa_ok $yaml, $YAML; |
208 | is $yaml->type, 'yaml', '... and it should report the correct type'; |
209 | ok $yaml->is_yaml, '... and it should identify itself as yaml'; |
210 | is_deeply $yaml->data, 'YAML!', '... and data should be correct'; |
211 | |
212 | # ok 5 # skip we have no description |
213 | # skipped test |
214 | |
215 | $test = shift @results; |
216 | isa_ok $test, $TEST; |
217 | is $test->type, 'test', '... and it should report the correct type'; |
218 | ok $test->is_test, '... and it should identify itself as a test'; |
219 | is $test->ok, 'ok', '... and it should have the correct ok()'; |
220 | ok $test->is_ok, '... and the correct boolean version of is_ok()'; |
221 | ok $test->is_actual_ok, |
222 | '... and the correct boolean version of is_actual_ok()'; |
223 | is $test->number, 5, '... and have the correct test number'; |
224 | ok !$test->description, '... and skipped tests have no description'; |
f7c69158 |
225 | is $test->directive, 'SKIP', '... and the correct directive'; |
b965d173 |
226 | is $test->explanation, 'we have no description', |
227 | '... but we should have an explanation'; |
228 | ok $test->has_skip, '... and it is a SKIPped test'; |
229 | ok !$test->has_todo, '... but not a TODO test'; |
230 | is $test->as_string, 'ok 5 # SKIP we have no description', |
231 | '... and its string representation should be correct'; |
232 | is $test->raw, 'ok 5 # skip we have no description', |
233 | '... and raw() should return the original line'; |
234 | |
235 | # a failing test, which also happens to have a directive |
236 | # ok 6 - you shall not pass! # TODO should have failed |
237 | |
238 | my $bonus = shift @results; |
239 | isa_ok $bonus, $TEST; |
240 | can_ok $bonus, 'todo_passed'; |
241 | is $bonus->type, 'test', 'TODO tests should parse correctly'; |
242 | ok $bonus->is_test, '... and it should identify itself as a test'; |
243 | is $bonus->ok, 'ok', '... and it should have the correct ok()'; |
244 | ok $bonus->is_ok, '... and TODO tests should not always pass'; |
245 | ok $bonus->is_actual_ok, |
246 | '... and the correct boolean version of is_actual_ok ()'; |
247 | is $bonus->number, 6, '... and have the correct failed number'; |
248 | is $bonus->description, '- you shall not pass!', |
249 | '... and the correct description'; |
250 | is $bonus->directive, 'TODO', '... and should have the correct directive'; |
251 | is $bonus->explanation, 'should have failed', |
252 | '... and the correct directive explanation'; |
253 | ok !$bonus->has_skip, '... and it is not a SKIPped failed'; |
254 | ok $bonus->has_todo, '... but it is a TODO succeeded'; |
255 | is $bonus->as_string, 'ok 6 - you shall not pass! # TODO should have failed', |
256 | '... and its string representation should be correct'; |
257 | is $bonus->raw, 'ok 6 - you shall not pass! # TODO should have failed', |
258 | '... and raw() should return the original line'; |
259 | ok $bonus->todo_passed, |
260 | '... todo_bonus() should pass for TODO tests which unexpectedly succeed'; |
261 | |
262 | # not ok 7 - Gandalf wins. Game over. # TODO 'bout time! |
263 | |
264 | my $passed = shift @results; |
265 | isa_ok $passed, $TEST; |
266 | can_ok $passed, 'todo_passed'; |
267 | is $passed->type, 'test', 'TODO tests should parse correctly'; |
268 | ok $passed->is_test, '... and it should identify itself as a test'; |
269 | is $passed->ok, 'not ok', '... and it should have the correct ok()'; |
270 | ok $passed->is_ok, '... and TODO tests should always pass'; |
271 | ok !$passed->is_actual_ok, |
272 | '... and the correct boolean version of is_actual_ok ()'; |
273 | is $passed->number, 7, '... and have the correct passed number'; |
274 | is $passed->description, '- Gandalf wins. Game over.', |
275 | '... and the correct description'; |
276 | is $passed->directive, 'TODO', '... and should have the correct directive'; |
277 | is $passed->explanation, "'bout time!", |
278 | '... and the correct directive explanation'; |
279 | ok !$passed->has_skip, '... and it is not a SKIPped passed'; |
280 | ok $passed->has_todo, '... but it is a TODO succeeded'; |
281 | is $passed->as_string, |
282 | "not ok 7 - Gandalf wins. Game over. # TODO 'bout time!", |
283 | '... and its string representation should be correct'; |
284 | is $passed->raw, "not ok 7 - Gandalf wins. Game over. # TODO 'bout time!", |
285 | '... and raw() should return the original line'; |
286 | ok !$passed->todo_passed, |
287 | '... todo_passed() should not pass for TODO tests which failed'; |
288 | |
289 | # test parse results |
290 | |
291 | can_ok $parser, 'passed'; |
292 | is $parser->passed, 6, |
293 | '... and we should have the correct number of passed tests'; |
294 | is_deeply [ $parser->passed ], [ 1, 2, 3, 5, 6, 7 ], |
295 | '... and get a list of the passed tests'; |
296 | |
297 | can_ok $parser, 'failed'; |
298 | is $parser->failed, 1, '... and the correct number of failed tests'; |
299 | is_deeply [ $parser->failed ], [4], '... and get a list of the failed tests'; |
300 | |
301 | can_ok $parser, 'actual_passed'; |
302 | is $parser->actual_passed, 4, |
303 | '... and we should have the correct number of actually passed tests'; |
304 | is_deeply [ $parser->actual_passed ], [ 1, 3, 5, 6 ], |
305 | '... and get a list of the actually passed tests'; |
306 | |
307 | can_ok $parser, 'actual_failed'; |
308 | is $parser->actual_failed, 3, |
309 | '... and the correct number of actually failed tests'; |
310 | is_deeply [ $parser->actual_failed ], [ 2, 4, 7 ], |
311 | '... or get a list of the actually failed tests'; |
312 | |
313 | can_ok $parser, 'todo'; |
314 | is $parser->todo, 3, |
315 | '... and we should have the correct number of TODO tests'; |
316 | is_deeply [ $parser->todo ], [ 2, 6, 7 ], |
317 | '... and get a list of the TODO tests'; |
318 | |
319 | can_ok $parser, 'skipped'; |
320 | is $parser->skipped, 1, |
321 | '... and we should have the correct number of skipped tests'; |
322 | is_deeply [ $parser->skipped ], [5], |
323 | '... and get a list of the skipped tests'; |
324 | |
325 | # check the plan |
326 | |
327 | can_ok $parser, 'plan'; |
328 | is $parser->plan, '1..7', '... and we should have the correct plan'; |
329 | is $parser->tests_planned, 7, '... and the correct number of tests'; |
330 | |
331 | # "Unexpectedly succeeded" |
332 | can_ok $parser, 'todo_passed'; |
333 | is scalar $parser->todo_passed, 1, |
334 | '... and it should report the number of tests which unexpectedly succeeded'; |
335 | is_deeply [ $parser->todo_passed ], [6], |
336 | '... or *which* tests unexpectedly succeeded'; |
337 | |
338 | # |
339 | # Bug report from Torsten Schoenfeld |
340 | # Makes sure parser can handle blank lines |
341 | # |
342 | |
343 | $tap = <<'END_TAP'; |
344 | 1..2 |
345 | ok 1 - input file opened |
346 | |
347 | |
348 | ok 2 - read the rest of the file |
349 | END_TAP |
350 | |
351 | my $aref = [ split /\n/ => $tap ]; |
352 | |
353 | can_ok $PARSER, 'new'; |
f7c69158 |
354 | $parser = $PARSER->new( { stream => $factory->make_iterator($aref) } ); |
b965d173 |
355 | isa_ok $parser, $PARSER, '... and calling it should succeed'; |
356 | |
357 | # results() is sane? |
358 | |
359 | ok @results = _get_results($parser), 'The parser should return results'; |
360 | is scalar @results, 5, '... and there should be one for each line'; |
361 | |
362 | # check the test plan |
363 | |
364 | $result = shift @results; |
365 | isa_ok $result, $PLAN; |
366 | can_ok $result, 'type'; |
367 | is $result->type, 'plan', '... and it should report the correct type'; |
368 | ok $result->is_plan, '... and it should identify itself as a plan'; |
369 | is $result->plan, '1..2', '... and identify the plan'; |
370 | is $result->as_string, '1..2', |
371 | '... and have the correct string representation'; |
372 | is $result->raw, '1..2', '... and raw() should return the original line'; |
373 | |
374 | # a normal, passing test |
375 | |
376 | $test = shift @results; |
377 | isa_ok $test, $TEST; |
378 | is $test->type, 'test', '... and it should report the correct type'; |
379 | ok $test->is_test, '... and it should identify itself as a test'; |
380 | is $test->ok, 'ok', '... and it should have the correct ok()'; |
381 | ok $test->is_ok, '... and the correct boolean version of is_ok()'; |
382 | ok $test->is_actual_ok, |
383 | '... and the correct boolean version of is_actual_ok()'; |
384 | is $test->number, 1, '... and have the correct test number'; |
385 | is $test->description, '- input file opened', |
386 | '... and the correct description'; |
387 | ok !$test->directive, '... and not have a directive'; |
388 | ok !$test->explanation, '... or a directive explanation'; |
389 | ok !$test->has_skip, '... and it is not a SKIPped test'; |
390 | ok !$test->has_todo, '... nor a TODO test'; |
391 | is $test->as_string, 'ok 1 - input file opened', |
392 | '... and its string representation should be correct'; |
393 | is $test->raw, 'ok 1 - input file opened', |
394 | '... and raw() should return the original line'; |
395 | |
396 | # junk lines should be preserved |
397 | |
398 | $unknown = shift @results; |
399 | isa_ok $unknown, $UNKNOWN; |
400 | is $unknown->type, 'unknown', '... and it should report the correct type'; |
401 | ok $unknown->is_unknown, '... and it should identify itself as unknown'; |
402 | is $unknown->as_string, '', |
403 | '... and its string representation should be returned verbatim'; |
404 | is $unknown->raw, '', '... and raw() should return the original line'; |
405 | |
406 | # ... and the second empty line |
407 | |
408 | $unknown = shift @results; |
409 | isa_ok $unknown, $UNKNOWN; |
410 | is $unknown->type, 'unknown', '... and it should report the correct type'; |
411 | ok $unknown->is_unknown, '... and it should identify itself as unknown'; |
412 | is $unknown->as_string, '', |
413 | '... and its string representation should be returned verbatim'; |
414 | is $unknown->raw, '', '... and raw() should return the original line'; |
415 | |
416 | # a passing test |
417 | |
418 | $test = shift @results; |
419 | isa_ok $test, $TEST; |
420 | is $test->type, 'test', '... and it should report the correct type'; |
421 | ok $test->is_test, '... and it should identify itself as a test'; |
422 | is $test->ok, 'ok', '... and it should have the correct ok()'; |
423 | ok $test->is_ok, '... and the correct boolean version of is_ok()'; |
424 | ok $test->is_actual_ok, |
425 | '... and the correct boolean version of is_actual_ok()'; |
426 | is $test->number, 2, '... and have the correct test number'; |
427 | is $test->description, '- read the rest of the file', |
428 | '... and the correct description'; |
429 | ok !$test->directive, '... and not have a directive'; |
430 | ok !$test->explanation, '... or a directive explanation'; |
431 | ok !$test->has_skip, '... and it is not a SKIPped test'; |
432 | ok !$test->has_todo, '... nor a TODO test'; |
433 | is $test->as_string, 'ok 2 - read the rest of the file', |
434 | '... and its string representation should be correct'; |
435 | is $test->raw, 'ok 2 - read the rest of the file', |
436 | '... and raw() should return the original line'; |
437 | |
438 | is scalar $parser->passed, 2, |
439 | 'Empty junk lines should not affect the correct number of tests passed'; |
440 | |
b965d173 |
441 | { |
442 | |
443 | # set a spool to write to |
444 | tie local *SPOOL, 'IO::c55Capture'; |
445 | |
446 | my $tap = <<'END_TAP'; |
447 | TAP version 13 |
448 | 1..7 |
449 | ok 1 - input file opened |
450 | ... this is junk |
451 | not ok first line of the input valid # todo some data |
452 | # this is a comment |
453 | ok 3 - read the rest of the file |
454 | not ok 4 - this is a real failure |
455 | --- YAML! |
456 | ... |
457 | ok 5 # skip we have no description |
458 | ok 6 - you shall not pass! # TODO should have failed |
459 | not ok 7 - Gandalf wins. Game over. # TODO 'bout time! |
460 | END_TAP |
461 | |
462 | { |
463 | my $parser = $PARSER->new( |
464 | { tap => $tap, |
465 | spool => \*SPOOL, |
466 | } |
467 | ); |
468 | |
469 | _get_results($parser); |
470 | |
471 | my @spooled = tied(*SPOOL)->dump(); |
472 | |
473 | is @spooled, 24, 'coverage testing for spool attribute of parser'; |
474 | is join( '', @spooled ), $tap, "spooled tap matches"; |
475 | } |
476 | |
477 | { |
478 | my $parser = $PARSER->new( |
479 | { tap => $tap, |
480 | spool => \*SPOOL, |
481 | } |
482 | ); |
483 | |
484 | $parser->callback( 'ALL', sub { } ); |
485 | |
486 | _get_results($parser); |
487 | |
488 | my @spooled = tied(*SPOOL)->dump(); |
489 | |
490 | is @spooled, 24, 'coverage testing for spool attribute of parser'; |
491 | is join( '', @spooled ), $tap, "spooled tap matches"; |
492 | } |
493 | } |
494 | |
495 | { |
496 | |
497 | # _initialize coverage |
498 | |
499 | my $x = bless [], 'kjsfhkjsdhf'; |
500 | |
501 | my @die; |
502 | |
503 | eval { |
504 | local $SIG{__DIE__} = sub { push @die, @_ }; |
505 | |
506 | $PARSER->new(); |
507 | }; |
508 | |
509 | is @die, 1, 'coverage testing for _initialize'; |
510 | |
511 | like pop @die, qr/PANIC:\s+could not determine stream at/, |
512 | '...and it failed as expected'; |
513 | |
514 | @die = (); |
515 | |
516 | eval { |
517 | local $SIG{__DIE__} = sub { push @die, @_ }; |
518 | |
519 | $PARSER->new( |
520 | { stream => 'stream', |
521 | tap => 'tap', |
522 | source => 'source', # only one of these is allowed |
523 | } |
524 | ); |
525 | }; |
526 | |
527 | is @die, 1, 'coverage testing for _initialize'; |
528 | |
529 | like pop @die, |
530 | qr/You may only choose one of 'exec', 'stream', 'tap' or 'source'/, |
531 | '...and it failed as expected'; |
532 | } |
533 | |
534 | { |
535 | |
536 | # coverage of todo_failed |
537 | |
538 | my $tap = <<'END_TAP'; |
539 | TAP version 13 |
540 | 1..7 |
541 | ok 1 - input file opened |
542 | ... this is junk |
543 | not ok first line of the input valid # todo some data |
544 | # this is a comment |
545 | ok 3 - read the rest of the file |
546 | not ok 4 - this is a real failure |
547 | --- YAML! |
548 | ... |
549 | ok 5 # skip we have no description |
550 | ok 6 - you shall not pass! # TODO should have failed |
551 | not ok 7 - Gandalf wins. Game over. # TODO 'bout time! |
552 | END_TAP |
553 | |
554 | my $parser = $PARSER->new( { tap => $tap } ); |
555 | |
556 | _get_results($parser); |
557 | |
558 | my @warn; |
559 | |
560 | eval { |
561 | local $SIG{__WARN__} = sub { push @warn, @_ }; |
562 | |
563 | $parser->todo_failed; |
564 | }; |
565 | |
566 | is @warn, 1, 'coverage testing of todo_failed'; |
567 | |
568 | like pop @warn, |
569 | qr/"todo_failed" is deprecated. Please use "todo_passed". See the docs[.]/, |
570 | '..and failed as expected' |
571 | } |
572 | |
573 | { |
574 | |
575 | # coverage testing for T::P::_initialize |
576 | |
577 | # coverage of the source argument paths |
578 | |
579 | # ref argument to source |
580 | |
581 | my $parser = TAP::Parser->new( { source => [ split /$/, $tap ] } ); |
582 | |
583 | isa_ok $parser, 'TAP::Parser'; |
584 | |
585 | isa_ok $parser->_stream, 'TAP::Parser::Iterator::Array'; |
586 | |
587 | # uncategorisable argument to source |
588 | my @die; |
589 | |
590 | eval { |
591 | local $SIG{__DIE__} = sub { push @die, @_ }; |
592 | |
593 | $parser = TAP::Parser->new( { source => 'nosuchfile' } ); |
594 | }; |
595 | |
596 | is @die, 1, 'uncategorisable source'; |
597 | |
598 | like pop @die, qr/Cannot determine source for nosuchfile/, |
599 | '... and we died as expected'; |
600 | } |
601 | |
602 | { |
603 | |
604 | # coverage test of perl source with switches |
605 | |
606 | my $parser = TAP::Parser->new( |
2a7f4b9b |
607 | { source => File::Spec->catfile( |
608 | ( $ENV{PERL_CORE} ? 'lib' : 't' ), |
609 | 'sample-tests', 'simple' |
610 | ), |
b965d173 |
611 | } |
612 | ); |
613 | |
614 | isa_ok $parser, 'TAP::Parser'; |
615 | |
616 | isa_ok $parser->_stream, 'TAP::Parser::Iterator::Process'; |
617 | |
618 | # Workaround for Mac OS X problem wrt closing the iterator without |
619 | # reading from it. |
620 | $parser->next; |
621 | } |
622 | |
623 | { |
624 | |
625 | # coverage testing for TAP::Parser::has_problems |
626 | |
627 | # we're going to need to test lots of fragments of tap |
628 | # to cover all the different boolean tests |
629 | |
630 | # currently covered are no problems and failed, so let's next test |
631 | # todo_passed |
632 | |
633 | my $tap = <<'END_TAP'; |
634 | TAP version 13 |
635 | 1..2 |
636 | ok 1 - input file opened |
637 | ok 2 - Gandalf wins. Game over. # TODO 'bout time! |
638 | END_TAP |
639 | |
640 | my $parser = TAP::Parser->new( { tap => $tap } ); |
641 | |
642 | _get_results($parser); |
643 | |
f7c69158 |
644 | ok !$parser->failed, 'parser didnt fail'; |
645 | ok $parser->todo_passed, '... and todo_passed is true'; |
b965d173 |
646 | |
f7c69158 |
647 | ok !$parser->has_problems, '... and has_problems is false'; |
b965d173 |
648 | |
649 | # now parse_errors |
650 | |
651 | $tap = <<'END_TAP'; |
652 | TAP version 13 |
653 | 1..2 |
654 | SMACK |
655 | END_TAP |
656 | |
657 | $parser = TAP::Parser->new( { tap => $tap } ); |
658 | |
659 | _get_results($parser); |
660 | |
f7c69158 |
661 | ok !$parser->failed, 'parser didnt fail'; |
662 | ok !$parser->todo_passed, '... and todo_passed is false'; |
663 | ok $parser->parse_errors, '... and parse_errors is true'; |
b965d173 |
664 | |
f7c69158 |
665 | ok $parser->has_problems, '... and has_problems'; |
b965d173 |
666 | |
667 | # Now wait and exit are hard to do in an OS platform-independent way, so |
668 | # we won't even bother |
669 | |
670 | $tap = <<'END_TAP'; |
671 | TAP version 13 |
672 | 1..2 |
673 | ok 1 - input file opened |
674 | ok 2 - Gandalf wins |
675 | END_TAP |
676 | |
677 | $parser = TAP::Parser->new( { tap => $tap } ); |
678 | |
679 | _get_results($parser); |
680 | |
681 | $parser->wait(1); |
682 | |
f7c69158 |
683 | ok !$parser->failed, 'parser didnt fail'; |
684 | ok !$parser->todo_passed, '... and todo_passed is false'; |
685 | ok !$parser->parse_errors, '... and parse_errors is false'; |
b965d173 |
686 | |
f7c69158 |
687 | ok $parser->wait, '... and wait is set'; |
b965d173 |
688 | |
f7c69158 |
689 | ok $parser->has_problems, '... and has_problems'; |
b965d173 |
690 | |
691 | # and use the same for exit |
692 | |
693 | $parser->wait(0); |
694 | $parser->exit(1); |
695 | |
f7c69158 |
696 | ok !$parser->failed, 'parser didnt fail'; |
697 | ok !$parser->todo_passed, '... and todo_passed is false'; |
698 | ok !$parser->parse_errors, '... and parse_errors is false'; |
699 | ok !$parser->wait, '... and wait is not set'; |
b965d173 |
700 | |
f7c69158 |
701 | ok $parser->exit, '... and exit is set'; |
b965d173 |
702 | |
f7c69158 |
703 | ok $parser->has_problems, '... and has_problems'; |
b965d173 |
704 | } |
705 | |
706 | { |
707 | |
708 | # coverage testing of the version states |
709 | |
710 | my $tap = <<'END_TAP'; |
711 | TAP version 12 |
712 | 1..2 |
713 | ok 1 - input file opened |
714 | ok 2 - Gandalf wins |
715 | END_TAP |
716 | |
717 | my $parser = TAP::Parser->new( { tap => $tap } ); |
718 | |
719 | _get_results($parser); |
720 | |
721 | my @errors = $parser->parse_errors; |
722 | |
723 | is @errors, 1, 'test too low version number'; |
724 | |
725 | like pop @errors, |
726 | qr/Explicit TAP version must be at least 13. Got version 12/, |
727 | '... and trapped expected version error'; |
728 | |
729 | # now too high a version |
730 | $tap = <<'END_TAP'; |
731 | TAP version 14 |
732 | 1..2 |
733 | ok 1 - input file opened |
734 | ok 2 - Gandalf wins |
735 | END_TAP |
736 | |
737 | $parser = TAP::Parser->new( { tap => $tap } ); |
738 | |
739 | _get_results($parser); |
740 | |
741 | @errors = $parser->parse_errors; |
742 | |
743 | is @errors, 1, 'test too high version number'; |
744 | |
745 | like pop @errors, |
746 | qr/TAP specified version 14 but we don't know about versions later than 13/, |
747 | '... and trapped expected version error'; |
748 | } |
749 | |
750 | { |
751 | |
752 | # coverage testing of TAP version in the wrong place |
753 | |
754 | my $tap = <<'END_TAP'; |
755 | 1..2 |
756 | ok 1 - input file opened |
757 | TAP version 12 |
758 | ok 2 - Gandalf wins |
759 | END_TAP |
760 | |
761 | my $parser = TAP::Parser->new( { tap => $tap } ); |
762 | |
763 | _get_results($parser); |
764 | |
765 | my @errors = $parser->parse_errors; |
766 | |
767 | is @errors, 1, 'test TAP version number in wrong place'; |
768 | |
769 | like pop @errors, |
770 | qr/If TAP version is present it must be the first line of output/, |
771 | '... and trapped expected version error'; |
772 | |
773 | } |
774 | |
775 | { |
776 | |
777 | # we're going to bash the internals a bit (but using the API as |
778 | # much as possible) to force grammar->tokenise() to fail |
779 | |
780 | # firstly we'll create a stream that dies when its next_raw method is called |
781 | |
782 | package TAP::Parser::Iterator::Dies; |
783 | |
784 | use strict; |
785 | use vars qw(@ISA); |
786 | |
787 | @ISA = qw(TAP::Parser::Iterator); |
788 | |
b965d173 |
789 | sub next_raw { |
790 | die 'this is the dying iterator'; |
791 | } |
792 | |
793 | # required as part of the TPI interface |
794 | sub exit { } |
795 | sub wait { } |
796 | |
797 | package main; |
798 | |
799 | # now build a standard parser |
800 | |
801 | my $tap = <<'END_TAP'; |
802 | 1..2 |
803 | ok 1 - input file opened |
804 | ok 2 - Gandalf wins |
805 | END_TAP |
806 | |
807 | { |
808 | my $parser = TAP::Parser->new( { tap => $tap } ); |
809 | |
810 | # build a dying stream |
811 | my $stream = TAP::Parser::Iterator::Dies->new; |
812 | |
813 | # now replace the stream - we're forced to us an T::P intenal |
814 | # method for this |
815 | $parser->_stream($stream); |
816 | |
817 | # build a new grammar |
f7c69158 |
818 | my $grammar = TAP::Parser::Grammar->new( |
819 | { stream => $stream, |
820 | parser => $parser |
821 | } |
822 | ); |
b965d173 |
823 | |
824 | # replace our grammar with this new one |
825 | $parser->_grammar($grammar); |
826 | |
827 | # now call next on the parser, and the grammar should die |
828 | my $result = $parser->next; # will die in iterator |
829 | |
830 | is $result, undef, 'iterator dies'; |
831 | |
832 | my @errors = $parser->parse_errors; |
833 | is @errors, 2, '...and caught expected errrors'; |
834 | |
835 | like shift @errors, qr/this is the dying iterator/, |
836 | '...and it was what we expected'; |
837 | } |
838 | |
839 | # Do it all again with callbacks to exercise the other code path in |
840 | # the unrolled iterator |
841 | { |
842 | my $parser = TAP::Parser->new( { tap => $tap } ); |
843 | |
844 | $parser->callback( 'ALL', sub { } ); |
845 | |
846 | # build a dying stream |
847 | my $stream = TAP::Parser::Iterator::Dies->new; |
848 | |
849 | # now replace the stream - we're forced to us an T::P intenal |
850 | # method for this |
851 | $parser->_stream($stream); |
852 | |
853 | # build a new grammar |
f7c69158 |
854 | my $grammar = TAP::Parser::Grammar->new( |
855 | { stream => $stream, |
856 | parser => $parser |
857 | } |
858 | ); |
b965d173 |
859 | |
860 | # replace our grammar with this new one |
861 | $parser->_grammar($grammar); |
862 | |
863 | # now call next on the parser, and the grammar should die |
864 | my $result = $parser->next; # will die in iterator |
865 | |
866 | is $result, undef, 'iterator dies'; |
867 | |
868 | my @errors = $parser->parse_errors; |
869 | is @errors, 2, '...and caught expected errrors'; |
870 | |
871 | like shift @errors, qr/this is the dying iterator/, |
872 | '...and it was what we expected'; |
873 | } |
874 | } |
875 | |
876 | { |
877 | |
878 | # coverage testing of TAP::Parser::_next_state |
879 | |
880 | package TAP::Parser::WithBrokenState; |
881 | use vars qw(@ISA); |
882 | |
883 | @ISA = qw( TAP::Parser ); |
884 | |
885 | sub _make_state_table { |
886 | return { INIT => { plan => { goto => 'FOO' } } }; |
887 | } |
888 | |
889 | package main; |
890 | |
891 | my $tap = <<'END_TAP'; |
892 | 1..2 |
893 | ok 1 - input file opened |
894 | ok 2 - Gandalf wins |
895 | END_TAP |
896 | |
897 | my $parser = TAP::Parser::WithBrokenState->new( { tap => $tap } ); |
898 | |
899 | my @die; |
900 | |
901 | eval { |
902 | local $SIG{__DIE__} = sub { push @die, @_ }; |
903 | |
904 | $parser->next; |
905 | $parser->next; |
906 | }; |
907 | |
908 | is @die, 1, 'detect broken state machine'; |
909 | |
910 | like pop @die, qr/Illegal state: FOO/, |
911 | '...and the message is as we expect'; |
912 | } |
913 | |
914 | { |
915 | |
916 | # coverage testing of TAP::Parser::_iter |
917 | |
918 | package TAP::Parser::WithBrokenIter; |
919 | use vars qw(@ISA); |
920 | |
921 | @ISA = qw( TAP::Parser ); |
922 | |
923 | sub _iter {return} |
924 | |
925 | package main; |
926 | |
927 | my $tap = <<'END_TAP'; |
928 | 1..2 |
929 | ok 1 - input file opened |
930 | ok 2 - Gandalf wins |
931 | END_TAP |
932 | |
933 | my $parser = TAP::Parser::WithBrokenIter->new( { tap => $tap } ); |
934 | |
935 | my @die; |
936 | |
937 | eval { |
938 | local $SIG{__WARN__} = sub { }; |
939 | local $SIG{__DIE__} = sub { push @die, @_ }; |
940 | |
941 | $parser->next; |
942 | }; |
943 | |
944 | is @die, 1, 'detect broken iter'; |
945 | |
946 | like pop @die, qr/Can't use/, '...and the message is as we expect'; |
947 | } |
948 | |
949 | { |
950 | |
951 | # coverage testing of TAP::Parser::_finish |
952 | |
953 | my $tap = <<'END_TAP'; |
954 | 1..2 |
955 | ok 1 - input file opened |
956 | ok 2 - Gandalf wins |
957 | END_TAP |
958 | |
959 | my $parser = TAP::Parser->new( { tap => $tap } ); |
960 | |
961 | $parser->tests_run(999); |
962 | |
963 | my @die; |
964 | |
965 | eval { |
966 | local $SIG{__DIE__} = sub { push @die, @_ }; |
967 | |
968 | _get_results $parser; |
969 | }; |
970 | |
971 | is @die, 1, 'detect broken test counts'; |
972 | |
973 | like pop @die, |
974 | qr/Panic: planned test count [(]1001[)] did not equal sum of passed [(]0[)] and failed [(]2[)] tests!/, |
975 | '...and the message is as we expect'; |
976 | } |
2a7f4b9b |
977 | |
978 | { |
979 | |
980 | # Sanity check on state table |
981 | |
982 | my $parser = TAP::Parser->new( { tap => "1..1\nok 1\n" } ); |
983 | my $state_table = $parser->_make_state_table; |
984 | my @states = sort keys %$state_table; |
985 | my @expect = sort qw( |
986 | bailout comment plan pragma test unknown version yaml |
987 | ); |
988 | |
989 | my %reachable = ( INIT => 1 ); |
990 | |
991 | for my $name (@states) { |
992 | my $state = $state_table->{$name}; |
993 | my @can_handle = sort keys %$state; |
994 | is_deeply \@can_handle, \@expect, "token types handled in $name"; |
995 | for my $type (@can_handle) { |
996 | $reachable{$_}++ |
997 | for grep {defined} |
998 | map { $state->{$type}->{$_} } qw(goto continue); |
999 | } |
1000 | } |
1001 | |
1002 | is_deeply [ sort keys %reachable ], [@states], "all states reachable"; |
1003 | } |
f7c69158 |
1004 | |
1005 | { |
1006 | |
1007 | # exit, wait, ignore_exit interactions |
1008 | |
1009 | my @truth = ( |
1010 | [ 0, 0, 0, 0 ], |
1011 | [ 0, 0, 1, 0 ], |
1012 | [ 1, 0, 0, 1 ], |
1013 | [ 1, 0, 1, 0 ], |
1014 | [ 1, 1, 0, 1 ], |
1015 | [ 1, 1, 1, 0 ], |
1016 | [ 0, 1, 0, 1 ], |
1017 | [ 0, 1, 1, 0 ], |
1018 | ); |
1019 | |
1020 | for my $t (@truth) { |
1021 | my ( $wait, $exit, $ignore_exit, $has_problems ) = @$t; |
1022 | my $test_parser = sub { |
1023 | my $parser = shift; |
1024 | $parser->wait($wait); |
1025 | $parser->exit($exit); |
1026 | ok $has_problems ? $parser->has_problems : !$parser->has_problems, |
1027 | "exit=$exit, wait=$wait, ignore=$ignore_exit"; |
1028 | }; |
1029 | |
1030 | my $parser = TAP::Parser->new( { tap => "1..1\nok 1\n" } ); |
1031 | $parser->ignore_exit($ignore_exit); |
1032 | $test_parser->($parser); |
1033 | |
1034 | $test_parser->( |
1035 | TAP::Parser->new( |
1036 | { tap => "1..1\nok 1\n", ignore_exit => $ignore_exit } |
1037 | ) |
1038 | ); |
1039 | } |
1040 | } |