6 if ( $ENV{PERL_CORE} ) {
8 @INC = ( '../lib', 'lib' );
15 use Test::More tests => 282;
21 use TAP::Parser::IteratorFactory;
26 while ( defined( my $result = $parser->next ) ) {
27 push @results => $result;
32 my ( $PARSER, $PLAN, $PRAGMA, $TEST, $COMMENT, $BAILOUT, $UNKNOWN, $YAML, $VERSION ) = qw(
34 TAP::Parser::Result::Plan
35 TAP::Parser::Result::Pragma
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
44 my $factory = TAP::Parser::IteratorFactory->new;
46 my $tap = <<'END_TAP';
49 ok 1 - input file opened
51 not ok first line of the input valid # todo some data
53 ok 3 - read the rest of the file
54 not ok 4 - this is a real failure
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!
62 can_ok $PARSER, 'new';
63 my $parser = $PARSER->new( { tap => $tap } );
64 isa_ok $parser, $PARSER, '... and the object it returns';
66 ok $ENV{TAP_VERSION}, 'TAP_VERSION env variable should be set';
70 my @results = _get_results($parser);
71 is scalar @results, 12, '... and there should be one for each line';
73 my $version = shift @results;
74 isa_ok $version, $VERSION;
75 is $version->version, '13', '... and the version should be 13';
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';
91 # a normal, passing test
93 my $test = shift @results;
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';
113 # junk lines should be preserved
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';
124 # a failing test, which also happens to have a directive
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';
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';
161 # another normal, passing test
163 $test = shift @results;
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';
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';
206 my $yaml = shift @results;
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';
212 # ok 5 # skip we have no description
215 $test = shift @results;
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';
225 is $test->directive, 'SKIP', '... and the correct directive';
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';
235 # a failing test, which also happens to have a directive
236 # ok 6 - you shall not pass! # TODO should have failed
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';
262 # not ok 7 - Gandalf wins. Game over. # TODO 'bout time!
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';
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';
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';
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';
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';
313 can_ok $parser, 'todo';
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';
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';
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';
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';
339 # Bug report from Torsten Schoenfeld
340 # Makes sure parser can handle blank lines
345 ok 1 - input file opened
348 ok 2 - read the rest of the file
351 my $aref = [ split /\n/ => $tap ];
353 can_ok $PARSER, 'new';
354 $parser = $PARSER->new( { stream => $factory->make_iterator($aref) } );
355 isa_ok $parser, $PARSER, '... and calling it should succeed';
359 ok @results = _get_results($parser), 'The parser should return results';
360 is scalar @results, 5, '... and there should be one for each line';
362 # check the test plan
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';
374 # a normal, passing test
376 $test = shift @results;
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';
396 # junk lines should be preserved
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';
406 # ... and the second empty line
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';
418 $test = shift @results;
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';
438 is scalar $parser->passed, 2,
439 'Empty junk lines should not affect the correct number of tests passed';
443 # set a spool to write to
444 tie local *SPOOL, 'IO::c55Capture';
446 my $tap = <<'END_TAP';
449 ok 1 - input file opened
451 not ok first line of the input valid # todo some data
453 ok 3 - read the rest of the file
454 not ok 4 - this is a real failure
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!
463 my $parser = $PARSER->new(
469 _get_results($parser);
471 my @spooled = tied(*SPOOL)->dump();
473 is @spooled, 24, 'coverage testing for spool attribute of parser';
474 is join( '', @spooled ), $tap, "spooled tap matches";
478 my $parser = $PARSER->new(
484 $parser->callback( 'ALL', sub { } );
486 _get_results($parser);
488 my @spooled = tied(*SPOOL)->dump();
490 is @spooled, 24, 'coverage testing for spool attribute of parser';
491 is join( '', @spooled ), $tap, "spooled tap matches";
497 # _initialize coverage
499 my $x = bless [], 'kjsfhkjsdhf';
504 local $SIG{__DIE__} = sub { push @die, @_ };
509 is @die, 1, 'coverage testing for _initialize';
511 like pop @die, qr/PANIC:\s+could not determine stream at/,
512 '...and it failed as expected';
517 local $SIG{__DIE__} = sub { push @die, @_ };
520 { stream => 'stream',
522 source => 'source', # only one of these is allowed
527 is @die, 1, 'coverage testing for _initialize';
530 qr/You may only choose one of 'exec', 'stream', 'tap' or 'source'/,
531 '...and it failed as expected';
536 # coverage of todo_failed
538 my $tap = <<'END_TAP';
541 ok 1 - input file opened
543 not ok first line of the input valid # todo some data
545 ok 3 - read the rest of the file
546 not ok 4 - this is a real failure
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!
554 my $parser = $PARSER->new( { tap => $tap } );
556 _get_results($parser);
561 local $SIG{__WARN__} = sub { push @warn, @_ };
563 $parser->todo_failed;
566 is @warn, 1, 'coverage testing of todo_failed';
569 qr/"todo_failed" is deprecated. Please use "todo_passed". See the docs[.]/,
570 '..and failed as expected'
575 # coverage testing for T::P::_initialize
577 # coverage of the source argument paths
579 # ref argument to source
581 my $parser = TAP::Parser->new( { source => [ split /$/, $tap ] } );
583 isa_ok $parser, 'TAP::Parser';
585 isa_ok $parser->_stream, 'TAP::Parser::Iterator::Array';
587 # uncategorisable argument to source
591 local $SIG{__DIE__} = sub { push @die, @_ };
593 $parser = TAP::Parser->new( { source => 'nosuchfile' } );
596 is @die, 1, 'uncategorisable source';
598 like pop @die, qr/Cannot determine source for nosuchfile/,
599 '... and we died as expected';
604 # coverage test of perl source with switches
606 my $parser = TAP::Parser->new(
607 { source => File::Spec->catfile(
608 ( $ENV{PERL_CORE} ? 'lib' : 't' ),
609 'sample-tests', 'simple'
614 isa_ok $parser, 'TAP::Parser';
616 isa_ok $parser->_stream, 'TAP::Parser::Iterator::Process';
618 # Workaround for Mac OS X problem wrt closing the iterator without
625 # coverage testing for TAP::Parser::has_problems
627 # we're going to need to test lots of fragments of tap
628 # to cover all the different boolean tests
630 # currently covered are no problems and failed, so let's next test
633 my $tap = <<'END_TAP';
636 ok 1 - input file opened
637 ok 2 - Gandalf wins. Game over. # TODO 'bout time!
640 my $parser = TAP::Parser->new( { tap => $tap } );
642 _get_results($parser);
644 ok !$parser->failed, 'parser didnt fail';
645 ok $parser->todo_passed, '... and todo_passed is true';
647 ok !$parser->has_problems, '... and has_problems is false';
657 $parser = TAP::Parser->new( { tap => $tap } );
659 _get_results($parser);
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';
665 ok $parser->has_problems, '... and has_problems';
667 # Now wait and exit are hard to do in an OS platform-independent way, so
668 # we won't even bother
673 ok 1 - input file opened
677 $parser = TAP::Parser->new( { tap => $tap } );
679 _get_results($parser);
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';
687 ok $parser->wait, '... and wait is set';
689 ok $parser->has_problems, '... and has_problems';
691 # and use the same for exit
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';
701 ok $parser->exit, '... and exit is set';
703 ok $parser->has_problems, '... and has_problems';
708 # coverage testing of the version states
710 my $tap = <<'END_TAP';
713 ok 1 - input file opened
717 my $parser = TAP::Parser->new( { tap => $tap } );
719 _get_results($parser);
721 my @errors = $parser->parse_errors;
723 is @errors, 1, 'test too low version number';
726 qr/Explicit TAP version must be at least 13. Got version 12/,
727 '... and trapped expected version error';
729 # now too high a version
733 ok 1 - input file opened
737 $parser = TAP::Parser->new( { tap => $tap } );
739 _get_results($parser);
741 @errors = $parser->parse_errors;
743 is @errors, 1, 'test too high version number';
746 qr/TAP specified version 14 but we don't know about versions later than 13/,
747 '... and trapped expected version error';
752 # coverage testing of TAP version in the wrong place
754 my $tap = <<'END_TAP';
756 ok 1 - input file opened
761 my $parser = TAP::Parser->new( { tap => $tap } );
763 _get_results($parser);
765 my @errors = $parser->parse_errors;
767 is @errors, 1, 'test TAP version number in wrong place';
770 qr/If TAP version is present it must be the first line of output/,
771 '... and trapped expected version error';
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
780 # firstly we'll create a stream that dies when its next_raw method is called
782 package TAP::Parser::Iterator::Dies;
787 @ISA = qw(TAP::Parser::Iterator);
790 die 'this is the dying iterator';
793 # required as part of the TPI interface
799 # now build a standard parser
801 my $tap = <<'END_TAP';
803 ok 1 - input file opened
808 my $parser = TAP::Parser->new( { tap => $tap } );
810 # build a dying stream
811 my $stream = TAP::Parser::Iterator::Dies->new;
813 # now replace the stream - we're forced to us an T::P intenal
815 $parser->_stream($stream);
817 # build a new grammar
818 my $grammar = TAP::Parser::Grammar->new(
824 # replace our grammar with this new one
825 $parser->_grammar($grammar);
827 # now call next on the parser, and the grammar should die
828 my $result = $parser->next; # will die in iterator
830 is $result, undef, 'iterator dies';
832 my @errors = $parser->parse_errors;
833 is @errors, 2, '...and caught expected errrors';
835 like shift @errors, qr/this is the dying iterator/,
836 '...and it was what we expected';
839 # Do it all again with callbacks to exercise the other code path in
840 # the unrolled iterator
842 my $parser = TAP::Parser->new( { tap => $tap } );
844 $parser->callback( 'ALL', sub { } );
846 # build a dying stream
847 my $stream = TAP::Parser::Iterator::Dies->new;
849 # now replace the stream - we're forced to us an T::P intenal
851 $parser->_stream($stream);
853 # build a new grammar
854 my $grammar = TAP::Parser::Grammar->new(
860 # replace our grammar with this new one
861 $parser->_grammar($grammar);
863 # now call next on the parser, and the grammar should die
864 my $result = $parser->next; # will die in iterator
866 is $result, undef, 'iterator dies';
868 my @errors = $parser->parse_errors;
869 is @errors, 2, '...and caught expected errrors';
871 like shift @errors, qr/this is the dying iterator/,
872 '...and it was what we expected';
878 # coverage testing of TAP::Parser::_next_state
880 package TAP::Parser::WithBrokenState;
883 @ISA = qw( TAP::Parser );
885 sub _make_state_table {
886 return { INIT => { plan => { goto => 'FOO' } } };
891 my $tap = <<'END_TAP';
893 ok 1 - input file opened
897 my $parser = TAP::Parser::WithBrokenState->new( { tap => $tap } );
902 local $SIG{__DIE__} = sub { push @die, @_ };
908 is @die, 1, 'detect broken state machine';
910 like pop @die, qr/Illegal state: FOO/,
911 '...and the message is as we expect';
916 # coverage testing of TAP::Parser::_iter
918 package TAP::Parser::WithBrokenIter;
921 @ISA = qw( TAP::Parser );
927 my $tap = <<'END_TAP';
929 ok 1 - input file opened
933 my $parser = TAP::Parser::WithBrokenIter->new( { tap => $tap } );
938 local $SIG{__WARN__} = sub { };
939 local $SIG{__DIE__} = sub { push @die, @_ };
944 is @die, 1, 'detect broken iter';
946 like pop @die, qr/Can't use/, '...and the message is as we expect';
951 # coverage testing of TAP::Parser::_finish
953 my $tap = <<'END_TAP';
955 ok 1 - input file opened
959 my $parser = TAP::Parser->new( { tap => $tap } );
961 $parser->tests_run(999);
966 local $SIG{__DIE__} = sub { push @die, @_ };
968 _get_results $parser;
971 is @die, 1, 'detect broken test counts';
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';
980 # Sanity check on state table
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
989 my %reachable = ( INIT => 1 );
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) {
998 map { $state->{$type}->{$_} } qw(goto continue);
1002 is_deeply [ sort keys %reachable ], [@states], "all states reachable";
1007 # exit, wait, ignore_exit interactions
1020 for my $t (@truth) {
1021 my ( $wait, $exit, $ignore_exit, $has_problems ) = @$t;
1022 my $test_parser = sub {
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";
1030 my $parser = TAP::Parser->new( { tap => "1..1\nok 1\n" } );
1031 $parser->ignore_exit($ignore_exit);
1032 $test_parser->($parser);
1036 { tap => "1..1\nok 1\n", ignore_exit => $ignore_exit }