4 use vars qw($VERSION @ISA);
7 use TAP::Parser::Grammar ();
8 use TAP::Parser::Result ();
9 use TAP::Parser::ResultFactory ();
10 use TAP::Parser::Source ();
11 use TAP::Parser::Source::Perl ();
12 use TAP::Parser::Iterator ();
13 use TAP::Parser::IteratorFactory ();
15 use Carp qw( confess );
21 TAP::Parser - Parse L<TAP|Test::Harness::TAP> output
31 my $DEFAULT_TAP_VERSION = 12;
32 my $MAX_TAP_VERSION = 13;
34 $ENV{TAP_VERSION} = $MAX_TAP_VERSION;
39 delete $ENV{TAP_VERSION};
42 BEGIN { # making accessors
62 iterator_factory_class
70 return $self->{$method} unless @_;
71 $self->{$method} = shift;
74 } # done making accessors
80 my $parser = TAP::Parser->new( { source => $source } );
82 while ( my $result = $parser->next ) {
83 print $result->as_string;
88 C<TAP::Parser> is designed to produce a proper parse of TAP output. For
89 an example of how to run tests through this module, see the simple
90 harnesses C<examples/>.
92 There's a wiki dedicated to the Test Anything Protocol:
94 L<http://testanything.org>
96 It includes the TAP::Parser Cookbook:
98 L<http://testanything.org/wiki/index.php/TAP::Parser_Cookbook>
106 my $parser = TAP::Parser->new(\%args);
108 Returns a new C<TAP::Parser> object.
110 The arguments should be a hashref with I<one> of the following keys:
116 This is the preferred method of passing arguments to the constructor. To
117 determine how to handle the source, the following steps are taken.
119 If the source contains a newline, it's assumed to be a string of raw TAP
122 If the source is a reference, it's assumed to be something to pass to
123 the L<TAP::Parser::Iterator::Stream> constructor. This is used
124 internally and you should not use it.
126 Otherwise, the parser does a C<-e> check to see if the source exists. If so,
127 it attempts to execute the source and read the output as a stream. This is by
128 far the preferred method of using the parser.
130 foreach my $file ( @test_files ) {
131 my $parser = TAP::Parser->new( { source => $file } );
132 # do stuff with the parser
137 The value should be the complete TAP output.
141 If passed an array reference, will attempt to create the iterator by
142 passing a L<TAP::Parser::Source> object to
143 L<TAP::Parser::Iterator::Source>, using the array reference strings as
144 the command arguments to L<IPC::Open3::open3|IPC::Open3>:
146 exec => [ '/usr/bin/ruby', 't/my_test.rb' ]
148 Note that C<source> and C<exec> are mutually exclusive.
152 The following keys are optional.
158 If present, each callback corresponding to a given result type will be called
159 with the result as the argument if the C<run> method is used:
162 test => \&test_callback,
163 plan => \&plan_callback,
164 comment => \&comment_callback,
165 bailout => \&bailout_callback,
166 unknown => \&unknown_callback,
169 my $aggregator = TAP::Parser::Aggregator->new;
170 foreach my $file ( @test_files ) {
171 my $parser = TAP::Parser->new(
174 callbacks => \%callbacks,
178 $aggregator->add( $file, $parser );
183 If using a Perl file as a source, optional switches may be passed which will
184 be used when invoking the perl executable.
186 my $parser = TAP::Parser->new( {
187 source => $test_file,
193 Used in conjunction with the C<source> option to supply a reference to
194 an C<@ARGV> style array of arguments to pass to the test program.
198 If passed a filehandle will write a copy of all parsed TAP to that handle.
202 If false, STDERR is not captured (though it is 'relayed' to keep it
203 somewhat synchronized with STDOUT.)
205 If true, STDERR and STDOUT are the same filehandle. This may cause
206 breakage if STDERR contains anything resembling TAP format, but does
207 allow exact synchronization.
209 Subtleties of this behavior may be platform-dependent and may change in
212 =item * C<source_class>
214 This option was introduced to let you easily customize which I<source> class
215 the parser should use. It defaults to L<TAP::Parser::Source>.
217 See also L</make_source>.
219 =item * C<perl_source_class>
221 This option was introduced to let you easily customize which I<perl source>
222 class the parser should use. It defaults to L<TAP::Parser::Source::Perl>.
224 See also L</make_perl_source>.
226 =item * C<grammar_class>
228 This option was introduced to let you easily customize which I<grammar> class
229 the parser should use. It defaults to L<TAP::Parser::Grammar>.
231 See also L</make_grammar>.
233 =item * C<iterator_factory_class>
235 This option was introduced to let you easily customize which I<iterator>
236 factory class the parser should use. It defaults to
237 L<TAP::Parser::IteratorFactory>.
239 See also L</make_iterator>.
241 =item * C<result_factory_class>
243 This option was introduced to let you easily customize which I<result>
244 factory class the parser should use. It defaults to
245 L<TAP::Parser::ResultFactory>.
247 See also L</make_result>.
253 # new() implementation supplied by TAP::Base
255 # This should make overriding behaviour of the Parser in subclasses easier:
256 sub _default_source_class {'TAP::Parser::Source'}
257 sub _default_perl_source_class {'TAP::Parser::Source::Perl'}
258 sub _default_grammar_class {'TAP::Parser::Grammar'}
259 sub _default_iterator_factory_class {'TAP::Parser::IteratorFactory'}
260 sub _default_result_factory_class {'TAP::Parser::ResultFactory'}
262 ##############################################################################
264 =head2 Instance Methods
268 my $parser = TAP::Parser->new( { source => $file } );
269 while ( my $result = $parser->next ) {
270 print $result->as_string, "\n";
273 This method returns the results of the parsing, one result at a time. Note
274 that it is destructive. You can't rewind and examine previous results.
276 If callbacks are used, they will be issued before this call returns.
278 Each result returned is a subclass of L<TAP::Parser::Result>. See that
279 module and related classes for more information on how to use them.
285 return ( $self->{_iter} ||= $self->_iter )->();
288 ##############################################################################
294 This method merely runs the parser and parses all of the TAP.
300 while ( defined( my $result = $self->next ) ) {
306 ##############################################################################
308 =head3 C<make_source>
310 Make a new L<TAP::Parser::Source> object and return it. Passes through any
313 The C<source_class> can be customized, as described in L</new>.
315 =head3 C<make_perl_source>
317 Make a new L<TAP::Parser::Source::Perl> object and return it. Passes through
320 The C<perl_source_class> can be customized, as described in L</new>.
322 =head3 C<make_grammar>
324 Make a new L<TAP::Parser::Grammar> object and return it. Passes through any
327 The C<grammar_class> can be customized, as described in L</new>.
329 =head3 C<make_iterator>
331 Make a new L<TAP::Parser::Iterator> object using the parser's
332 L<TAP::Parser::IteratorFactory>, and return it. Passes through any arguments
335 The C<iterator_factory_class> can be customized, as described in L</new>.
337 =head3 C<make_result>
339 Make a new L<TAP::Parser::Result> object using the parser's
340 L<TAP::Parser::ResultFactory>, and return it. Passes through any arguments
343 The C<result_factory_class> can be customized, as described in L</new>.
347 # This should make overriding behaviour of the Parser in subclasses easier:
348 sub make_source { shift->source_class->new(@_); }
349 sub make_perl_source { shift->perl_source_class->new(@_); }
350 sub make_grammar { shift->grammar_class->new(@_); }
351 sub make_iterator { shift->iterator_factory_class->make_iterator(@_); }
352 sub make_result { shift->result_factory_class->make_result(@_); }
356 # of the following, anything beginning with an underscore is strictly
357 # internal and should not be exposed.
359 version => $DEFAULT_TAP_VERSION,
360 plan => '', # the test plan (e.g., 1..3)
362 tests_run => 0, # actual current test numbers
363 results => [], # TAP parser results
368 actual_failed => [], # how many tests really failed
369 actual_passed => [], # how many tests really passed
370 todo_passed => [], # tests which unexpectedly succeed
371 parse_errors => [], # perfect TAP should have none
374 # We seem to have this list hanging around all over the place. We could
375 #Â probably get it from somewhere else to avoid the repetition.
376 my @legal_callback = qw(
389 my @class_overrides = qw(
393 iterator_factory_class
398 my ( $self, $arg_for ) = @_;
400 # everything here is basically designed to convert any TAP source to a
404 my %args = %{ $arg_for || {} };
406 $self->SUPER::_initialize( \%args, \@legal_callback );
408 # get any class overrides out first:
409 for my $key (@class_overrides) {
410 my $default_method = "_default_$key";
411 my $val = delete $args{$key} || $self->$default_method();
415 my $stream = delete $args{stream};
416 my $tap = delete $args{tap};
417 my $source = delete $args{source};
418 my $exec = delete $args{exec};
419 my $merge = delete $args{merge};
420 my $spool = delete $args{spool};
421 my $switches = delete $args{switches};
422 my $ignore_exit = delete $args{ignore_exit};
423 my @test_args = @{ delete $args{test_args} || [] };
425 if ( 1 < grep {defined} $stream, $tap, $source, $exec ) {
427 "You may only choose one of 'exec', 'stream', 'tap' or 'source'"
431 if ( my @excess = sort keys %args ) {
432 $self->_croak("Unknown options: @excess");
436 $stream = $self->make_iterator( [ split "\n" => $tap ] );
439 my $source = $self->make_source( { parser => $self } );
440 $source->source( [ @$exec, @test_args ] );
441 $source->merge($merge); # XXX should just be arguments?
442 $stream = $source->get_stream;
445 if ( my $ref = ref $source ) {
446 $stream = $self->make_iterator($source);
448 elsif ( -e $source ) {
449 my $perl = $self->make_perl_source( { parser => $self } );
451 $perl->switches($switches)
454 $perl->merge($merge); # XXX args to new()?
455 $perl->source( [ $source, @test_args ] );
456 $stream = $perl->get_stream;
459 $self->_croak("Cannot determine source for $source");
464 $self->_croak('PANIC: could not determine stream');
467 while ( my ( $k, $v ) = each %initialize ) {
468 $self->{$k} = 'ARRAY' eq ref $v ? [] : $v;
471 $self->_stream($stream);
472 $self->_spool($spool);
473 $self->ignore_exit($ignore_exit);
479 =head1 INDIVIDUAL RESULTS
481 If you've read this far in the docs, you've seen this:
483 while ( my $result = $parser->next ) {
484 print $result->as_string;
487 Each result returned is a L<TAP::Parser::Result> subclass, referred to as
492 Basically, you fetch individual results from the TAP. The six types, with
493 examples of each, are as follows:
511 ok 3 - We should start with some foobar!
515 # Hope we don't use up the foobar.
519 Bail out! We ran out of foobar!
523 ... yo, this ain't TAP! ...
527 Each result fetched is a result object of a different type. There are common
528 methods to each result object and different types may have methods unique to
529 their type. Sometimes a type method may be overridden in a subclass, but its
530 use is guaranteed to be identical.
532 =head2 Common type methods
536 Returns the type of result, such as C<comment> or C<test>.
540 Prints a string representation of the token. This might not be the exact
541 output, however. Tests will have test numbers added if not present, TODO and
542 SKIP directives will be capitalized and, in general, things will be cleaned
543 up. If you need the original text for the token, see the C<raw> method.
547 Returns the original line of text which was parsed.
551 Indicates whether or not this is the test plan line.
555 Indicates whether or not this is a test line.
559 Indicates whether or not this is a comment. Comments will generally only
560 appear in the TAP stream if STDERR is merged to STDOUT. See the
565 Indicates whether or not this is bailout line.
569 Indicates whether or not the current item is a YAML block.
573 Indicates whether or not the current line could be parsed.
577 if ( $result->is_ok ) { ... }
579 Reports whether or not a given result has passed. Anything which is B<not> a
580 test result returns true. This is merely provided as a convenient shortcut
581 which allows you to do this:
583 my $parser = TAP::Parser->new( { source => $source } );
584 while ( my $result = $parser->next ) {
585 # only print failing results
586 print $result->as_string unless $result->is_ok;
589 =head2 C<plan> methods
591 if ( $result->is_plan ) { ... }
593 If the above evaluates as true, the following methods will be available on the
598 if ( $result->is_plan ) {
602 This is merely a synonym for C<as_string>.
606 my $directive = $result->directive;
608 If a SKIP directive is included with the plan, this method will return it.
610 1..0 # SKIP: why bother?
612 =head3 C<explanation>
614 my $explanation = $result->explanation;
616 If a SKIP directive was included with the plan, this method will return the
619 =head2 C<pragma> methods
621 if ( $result->is_pragma ) { ... }
623 If the above evaluates as true, the following methods will be available on the
628 Returns a list of pragmas each of which is a + or - followed by the
631 =head2 C<commment> methods
633 if ( $result->is_comment ) { ... }
635 If the above evaluates as true, the following methods will be available on the
640 if ( $result->is_comment ) {
641 my $comment = $result->comment;
642 print "I have something to say: $comment";
645 =head2 C<bailout> methods
647 if ( $result->is_bailout ) { ... }
649 If the above evaluates as true, the following methods will be available on the
652 =head3 C<explanation>
654 if ( $result->is_bailout ) {
655 my $explanation = $result->explanation;
656 print "We bailed out because ($explanation)";
659 If, and only if, a token is a bailout token, you can get an "explanation" via
660 this method. The explanation is the text after the mystical "Bail out!" words
661 which appear in the tap output.
663 =head2 C<unknown> methods
665 if ( $result->is_unknown ) { ... }
667 There are no unique methods for unknown results.
669 =head2 C<test> methods
671 if ( $result->is_test ) { ... }
673 If the above evaluates as true, the following methods will be available on the
678 my $ok = $result->ok;
680 Returns the literal text of the C<ok> or C<not ok> status.
684 my $test_number = $result->number;
686 Returns the number of the test, even if the original TAP output did not supply
689 =head3 C<description>
691 my $description = $result->description;
693 Returns the description of the test, if any. This is the portion after the
694 test number but before the directive.
698 my $directive = $result->directive;
700 Returns either C<TODO> or C<SKIP> if either directive was present for a test
703 =head3 C<explanation>
705 my $explanation = $result->explanation;
707 If a test had either a C<TODO> or C<SKIP> directive, this method will return
708 the accompanying explantion, if present.
710 not ok 17 - 'Pigs can fly' # TODO not enough acid
712 For the above line, the explanation is I<not enough acid>.
716 if ( $result->is_ok ) { ... }
718 Returns a boolean value indicating whether or not the test passed. Remember
719 that for TODO tests, the test always passes.
721 B<Note:> this was formerly C<passed>. The latter method is deprecated and
722 will issue a warning.
724 =head3 C<is_actual_ok>
726 if ( $result->is_actual_ok ) { ... }
728 Returns a boolean value indicating whether or not the test passed, regardless
731 B<Note:> this was formerly C<actual_passed>. The latter method is deprecated
732 and will issue a warning.
734 =head3 C<is_unplanned>
736 if ( $test->is_unplanned ) { ... }
738 If a test number is greater than the number of planned tests, this method will
739 return true. Unplanned tests will I<always> return false for C<is_ok>,
740 regardless of whether or not the test C<has_todo> (see
741 L<TAP::Parser::Result::Test> for more information about this).
745 if ( $result->has_skip ) { ... }
747 Returns a boolean value indicating whether or not this test had a SKIP
752 if ( $result->has_todo ) { ... }
754 Returns a boolean value indicating whether or not this test had a TODO
757 Note that TODO tests I<always> pass. If you need to know whether or not
758 they really passed, check the C<is_actual_ok> method.
762 if ( $parser->in_todo ) { ... }
764 True while the most recent result was a TODO. Becomes true before the
765 TODO result is returned and stays true until just before the next non-
766 TODO test is returned.
770 After parsing the TAP, there are many methods available to let you dig through
771 the results and determine what is meaningful to you.
773 =head2 Individual Results
775 These results refer to individual tests which are run.
779 my @passed = $parser->passed; # the test numbers which passed
780 my $passed = $parser->passed; # the number of tests which passed
782 This method lets you know which (or how many) tests passed. If a test failed
783 but had a TODO directive, it will be counted as a passed test.
787 sub passed { @{ shift->{passed} } }
791 my @failed = $parser->failed; # the test numbers which failed
792 my $failed = $parser->failed; # the number of tests which failed
794 This method lets you know which (or how many) tests failed. If a test passed
795 but had a TODO directive, it will B<NOT> be counted as a failed test.
799 sub failed { @{ shift->{failed} } }
801 =head3 C<actual_passed>
803 # the test numbers which actually passed
804 my @actual_passed = $parser->actual_passed;
806 # the number of tests which actually passed
807 my $actual_passed = $parser->actual_passed;
809 This method lets you know which (or how many) tests actually passed,
810 regardless of whether or not a TODO directive was found.
814 sub actual_passed { @{ shift->{actual_passed} } }
815 *actual_ok = \&actual_passed;
819 This method is a synonym for C<actual_passed>.
821 =head3 C<actual_failed>
823 # the test numbers which actually failed
824 my @actual_failed = $parser->actual_failed;
826 # the number of tests which actually failed
827 my $actual_failed = $parser->actual_failed;
829 This method lets you know which (or how many) tests actually failed,
830 regardless of whether or not a TODO directive was found.
834 sub actual_failed { @{ shift->{actual_failed} } }
836 ##############################################################################
840 my @todo = $parser->todo; # the test numbers with todo directives
841 my $todo = $parser->todo; # the number of tests with todo directives
843 This method lets you know which (or how many) tests had TODO directives.
847 sub todo { @{ shift->{todo} } }
849 =head3 C<todo_passed>
851 # the test numbers which unexpectedly succeeded
852 my @todo_passed = $parser->todo_passed;
854 # the number of tests which unexpectedly succeeded
855 my $todo_passed = $parser->todo_passed;
857 This method lets you know which (or how many) tests actually passed but were
858 declared as "TODO" tests.
862 sub todo_passed { @{ shift->{todo_passed} } }
864 ##############################################################################
866 =head3 C<todo_failed>
868 # deprecated in favor of 'todo_passed'. This method was horribly misnamed.
870 This was a badly misnamed method. It indicates which TODO tests unexpectedly
871 succeeded. Will now issue a warning and call C<todo_passed>.
877 '"todo_failed" is deprecated. Please use "todo_passed". See the docs.';
883 my @skipped = $parser->skipped; # the test numbers with SKIP directives
884 my $skipped = $parser->skipped; # the number of tests with SKIP directives
886 This method lets you know which (or how many) tests had SKIP directives.
890 sub skipped { @{ shift->{skipped} } }
896 Get or set a pragma. To get the state of a pragma:
898 if ( $p->pragma('strict') ) {
902 To set the state of a pragma:
904 $p->pragma('strict', 1); # enable strict mode
909 my ( $self, $pragma ) = splice @_, 0, 2;
911 return $self->{pragma}->{$pragma} unless @_;
913 if ( my $state = shift ) {
914 $self->{pragma}->{$pragma} = 1;
917 delete $self->{pragma}->{$pragma};
925 Get a list of all the currently enabled pragmas:
927 my @pragmas_enabled = $p->pragmas;
931 sub pragmas { sort keys %{ shift->{pragma} || {} } }
933 =head2 Summary Results
935 These results are "meta" information about the total results of an individual
940 my $plan = $parser->plan;
942 Returns the test plan, if found.
946 Deprecated. Use C<is_good_plan> instead.
951 warn 'good_plan() is deprecated. Please use "is_good_plan()"';
955 ##############################################################################
957 =head3 C<is_good_plan>
959 if ( $parser->is_good_plan ) { ... }
961 Returns a boolean value indicating whether or not the number of tests planned
962 matches the number of tests run.
964 B<Note:> this was formerly C<good_plan>. The latter method is deprecated and
965 will issue a warning.
967 And since we're on that subject ...
969 =head3 C<tests_planned>
971 print $parser->tests_planned;
973 Returns the number of tests planned, according to the plan. For example, a
974 plan of '1..17' will mean that 17 tests were planned.
978 print $parser->tests_run;
980 Returns the number of tests which actually were run. Hopefully this will
981 match the number of C<< $parser->tests_planned >>.
985 Returns a true value (actually the reason for skipping) if all tests
990 Returns the time when the Parser was created.
994 Returns the time when the end of TAP input was seen.
996 =head3 C<has_problems>
998 if ( $parser->has_problems ) {
1002 This is a 'catch-all' method which returns true if any tests have currently
1003 failed, any TODO tests unexpectedly succeeded, or any parse errors occurred.
1011 || $self->parse_errors
1012 || ( !$self->ignore_exit && ( $self->wait || $self->exit ) );
1019 Once the parser is done, this will return the version number for the
1020 parsed TAP. Version numbers were introduced with TAP version 13 so if no
1021 version number is found version 12 is assumed.
1027 Once the parser is done, this will return the exit status. If the parser ran
1028 an executable, it returns the exit status of the executable.
1034 Once the parser is done, this will return the wait status. If the parser ran
1035 an executable, it returns the wait status of the executable. Otherwise, this
1036 mererely returns the C<exit> status.
1038 =head2 C<ignore_exit>
1040 $parser->ignore_exit(1);
1042 Tell the parser to ignore the exit status from the test when determining
1043 whether the test passed. Normally tests with non-zero exit status are
1044 considered to have failed even if all individual tests passed. In cases
1045 where it is not possible to control the exit value of the test script
1046 use this option to ignore it.
1050 sub ignore_exit { shift->pragma( 'ignore_exit', @_ ) }
1052 =head3 C<parse_errors>
1054 my @errors = $parser->parse_errors; # the parser errors
1055 my $errors = $parser->parse_errors; # the number of parser_errors
1057 Fortunately, all TAP output is perfect. In the event that it is not, this
1058 method will return parser errors. Note that a junk line which the parser does
1059 not recognize is C<not> an error. This allows this parser to handle future
1060 versions of TAP. The following are all TAP errors reported by the parser:
1064 =item * Misplaced plan
1066 The plan (for example, '1..5'), must only come at the beginning or end of the
1073 =item * More than one plan
1076 ok 1 - input file opened
1077 not ok 2 - first line of the input valid # todo some data
1078 ok 3 read the rest of the file
1081 Right. Very funny. Don't do that.
1083 =item * Test numbers out of sequence
1086 ok 1 - input file opened
1087 not ok 2 - first line of the input valid # todo some data
1088 ok 2 read the rest of the file
1090 That last test line above should have the number '3' instead of '2'.
1092 Note that it's perfectly acceptable for some lines to have test numbers and
1093 others to not have them. However, when a test number is found, it must be in
1094 sequence. The following is also an error:
1097 ok 1 - input file opened
1098 not ok - first line of the input valid # todo some data
1099 ok 2 read the rest of the file
1104 ok - input file opened
1105 not ok - first line of the input valid # todo some data
1106 ok 3 read the rest of the file
1112 sub parse_errors { @{ shift->{parse_errors} } }
1115 my ( $self, $error ) = @_;
1116 push @{ $self->{parse_errors} } => $error;
1120 sub _make_state_table {
1123 my %planned_todo = ();
1125 #Â These transitions are defaults for all states
1126 my %state_globals = (
1133 'If TAP version is present it must be the first line of output'
1140 if ( $self->pragma('strict') ) {
1142 'Unknown TAP token: "' . $unk->raw . '"' );
1149 for my $pr ( $pragma->pragmas ) {
1150 if ( $pr =~ /^ ([-+])(\w+) $/x ) {
1151 $self->pragma( $2, $1 eq '+' );
1158 # Provides default elements for transitions
1159 my %state_defaults = (
1163 $self->tests_planned( $plan->tests_planned );
1164 $self->plan( $plan->plan );
1165 if ( $plan->has_skip ) {
1166 $self->skip_all( $plan->explanation
1167 || '(no reason given)' );
1170 $planned_todo{$_}++ for @{ $plan->todo_list };
1177 my ( $number, $tests_run )
1178 = ( $test->number, ++$self->{tests_run} );
1181 if ( defined $number && delete $planned_todo{$number} ) {
1182 $test->set_directive('TODO');
1185 my $has_todo = $test->has_todo;
1187 $self->in_todo($has_todo);
1188 if ( defined( my $tests_planned = $self->tests_planned ) ) {
1189 if ( $tests_run > $tests_planned ) {
1190 $test->is_unplanned(1);
1195 if ( $number != $tests_run ) {
1196 my $count = $tests_run;
1197 $self->_add_error( "Tests out of sequence. Found "
1198 . "($number) but expected ($count)" );
1202 $test->_number( $number = $tests_run );
1205 push @{ $self->{todo} } => $number if $has_todo;
1206 push @{ $self->{todo_passed} } => $number
1207 if $test->todo_passed;
1208 push @{ $self->{skipped} } => $number
1211 push @{ $self->{ $test->is_ok ? 'passed' : 'failed' } } =>
1222 yaml => { act => sub { }, },
1225 # Each state contains a hash the keys of which match a token type. For
1227 # type there may be:
1228 # act A coderef to run
1229 # goto The new state to move to. Stay in this state if
1231 # continue Goto the new state and run the new state for the
1238 my $ver_num = $version->version;
1239 if ( $ver_num <= $DEFAULT_TAP_VERSION ) {
1240 my $ver_min = $DEFAULT_TAP_VERSION + 1;
1242 "Explicit TAP version must be at least "
1243 . "$ver_min. Got version $ver_num" );
1244 $ver_num = $DEFAULT_TAP_VERSION;
1246 if ( $ver_num > $MAX_TAP_VERSION ) {
1248 "TAP specified version $ver_num but "
1249 . "we don't know about versions later "
1250 . "than $MAX_TAP_VERSION" );
1251 $ver_num = $MAX_TAP_VERSION;
1253 $self->version($ver_num);
1254 $self->_grammar->set_version($ver_num);
1258 plan => { goto => 'PLANNED' },
1259 test => { goto => 'UNPLANNED' },
1262 plan => { goto => 'PLANNED' },
1263 test => { goto => 'UNPLANNED' },
1266 test => { goto => 'PLANNED_AFTER_TEST' },
1271 'More than one plan found in TAP output');
1275 PLANNED_AFTER_TEST => {
1276 test => { goto => 'PLANNED_AFTER_TEST' },
1277 plan => { act => sub { }, continue => 'PLANNED' },
1278 yaml => { goto => 'PLANNED' },
1284 my $line = $self->plan;
1286 "Plan ($line) must be at the beginning "
1287 . "or end of the TAP output" );
1288 $self->is_good_plan(0);
1290 continue => 'PLANNED'
1292 plan => { continue => 'PLANNED' },
1295 test => { goto => 'UNPLANNED_AFTER_TEST' },
1296 plan => { goto => 'GOT_PLAN' },
1298 UNPLANNED_AFTER_TEST => {
1299 test => { act => sub { }, continue => 'UNPLANNED' },
1300 plan => { act => sub { }, continue => 'UNPLANNED' },
1301 yaml => { goto => 'PLANNED' },
1305 # Apply globals and defaults to state table
1306 for my $name ( keys %states ) {
1308 # Merge with globals
1309 my $st = { %state_globals, %{ $states{$name} } };
1312 for my $next ( sort keys %{$st} ) {
1313 if ( my $default = $state_defaults{$next} ) {
1314 for my $def ( sort keys %{$default} ) {
1315 $st->{$next}->{$def} ||= $default->{$def};
1320 # Stuff back in table
1321 $states{$name} = $st;
1327 =head3 C<get_select_handles>
1329 Get an a list of file handles which can be passed to C<select> to
1330 determine the readiness of this parser.
1334 sub get_select_handles { shift->_stream->get_select_handles }
1338 return $self->{_grammar} = shift if @_;
1340 return $self->{_grammar} ||= $self->make_grammar(
1341 { stream => $self->_stream,
1343 version => $self->version
1350 my $stream = $self->_stream;
1351 my $grammar = $self->_grammar;
1352 my $spool = $self->_spool;
1354 my $state_table = $self->_make_state_table;
1356 $self->start_time( $self->get_time );
1358 # Make next_state closure
1359 my $next_state = sub {
1361 my $type = $token->type;
1363 my $state_spec = $state_table->{$state}
1364 or die "Illegal state: $state";
1366 if ( my $next = $state_spec->{$type} ) {
1367 if ( my $act = $next->{act} ) {
1370 if ( my $cont = $next->{continue} ) {
1374 elsif ( my $goto = $next->{goto} ) {
1379 confess("Unhandled token type: $type\n");
1385 # Handle end of stream - which means either pop a block or finish
1386 my $end_handler = sub {
1387 $self->exit( $stream->exit );
1388 $self->wait( $stream->wait );
1393 # Finally make the closure that we return. For performance reasons
1394 # there are two versions of the returned function: one that handles
1395 # callbacks and one that does not.
1396 if ( $self->_has_callbacks ) {
1398 my $result = eval { $grammar->tokenize };
1399 $self->_add_error($@) if $@;
1401 if ( defined $result ) {
1402 $result = $next_state->($result);
1404 if ( my $code = $self->_callback_for( $result->type ) ) {
1405 $_->($result) for @{$code};
1408 $self->_make_callback( 'ELSE', $result );
1411 $self->_make_callback( 'ALL', $result );
1413 # Echo TAP to spool file
1414 print {$spool} $result->raw, "\n" if $spool;
1417 $result = $end_handler->();
1418 $self->_make_callback( 'EOF', $result )
1419 unless defined $result;
1427 my $result = eval { $grammar->tokenize };
1428 $self->_add_error($@) if $@;
1430 if ( defined $result ) {
1431 $result = $next_state->($result);
1433 # Echo TAP to spool file
1434 print {$spool} $result->raw, "\n" if $spool;
1437 $result = $end_handler->();
1448 $self->end_time( $self->get_time );
1451 if ( !$self->plan ) {
1452 $self->_add_error('No plan found in TAP output');
1455 $self->is_good_plan(1) unless defined $self->is_good_plan;
1457 if ( $self->tests_run != ( $self->tests_planned || 0 ) ) {
1458 $self->is_good_plan(0);
1459 if ( defined( my $planned = $self->tests_planned ) ) {
1460 my $ran = $self->tests_run;
1462 "Bad plan. You planned $planned tests but ran $ran.");
1465 if ( $self->tests_run != ( $self->passed + $self->failed ) ) {
1467 # this should never happen
1468 my $actual = $self->tests_run;
1469 my $passed = $self->passed;
1470 my $failed = $self->failed;
1471 $self->_croak( "Panic: planned test count ($actual) did not equal "
1472 . "sum of passed ($passed) and failed ($failed) tests!" );
1475 $self->is_good_plan(0) unless defined $self->is_good_plan;
1479 =head3 C<delete_spool>
1481 Delete and return the spool.
1483 my $fh = $parser->delete_spool;
1490 return delete $self->{_spool};
1493 ##############################################################################
1497 As mentioned earlier, a "callback" key may be added to the
1498 C<TAP::Parser> constructor. If present, each callback corresponding to a
1499 given result type will be called with the result as the argument if the
1500 C<run> method is used. The callback is expected to be a subroutine
1501 reference (or anonymous subroutine) which is invoked with the parser
1502 result as its argument.
1505 test => \&test_callback,
1506 plan => \&plan_callback,
1507 comment => \&comment_callback,
1508 bailout => \&bailout_callback,
1509 unknown => \&unknown_callback,
1512 my $aggregator = TAP::Parser::Aggregator->new;
1513 foreach my $file ( @test_files ) {
1514 my $parser = TAP::Parser->new(
1517 callbacks => \%callbacks,
1521 $aggregator->add( $file, $parser );
1524 Callbacks may also be added like this:
1526 $parser->callback( test => \&test_callback );
1527 $parser->callback( plan => \&plan_callback );
1529 The following keys allowed for callbacks. These keys are case-sensitive.
1535 Invoked if C<< $result->is_test >> returns true.
1539 Invoked if C<< $result->is_version >> returns true.
1543 Invoked if C<< $result->is_plan >> returns true.
1547 Invoked if C<< $result->is_comment >> returns true.
1551 Invoked if C<< $result->is_unknown >> returns true.
1555 Invoked if C<< $result->is_yaml >> returns true.
1559 Invoked if C<< $result->is_unknown >> returns true.
1563 If a result does not have a callback defined for it, this callback will
1564 be invoked. Thus, if all of the previous result types are specified as
1565 callbacks, this callback will I<never> be invoked.
1569 This callback will always be invoked and this will happen for each
1570 result after one of the above callbacks is invoked. For example, if
1571 L<Term::ANSIColor> is loaded, you could use the following to color your
1577 if ( $test->is_ok && not $test->directive ) {
1578 # normal passing test
1579 print color 'green';
1581 elsif ( !$test->is_ok ) { # even if it's TODO
1582 print color 'white on_red';
1584 elsif ( $test->has_skip ) {
1585 print color 'white on_blue';
1588 elsif ( $test->has_todo ) {
1589 print color 'white';
1593 # plan, comment, and so on (anything which isn't a test line)
1594 print color 'black on_white';
1598 print shift->as_string;
1599 print color 'reset';
1606 Invoked when there are no more lines to be parsed. Since there is no
1607 accompanying L<TAP::Parser::Result> object the C<TAP::Parser> object is
1614 If you're looking for an EBNF grammar, see L<TAP::Parser::Grammar>.
1616 =head1 BACKWARDS COMPATABILITY
1618 The Perl-QA list attempted to ensure backwards compatability with
1619 L<Test::Harness>. However, there are some minor differences.
1627 A little-known feature of L<Test::Harness> is that it supported TODO
1631 ok 1 - We have liftoff
1632 not ok 2 - Anti-gravity device activated
1634 Under L<Test::Harness>, test number 2 would I<pass> because it was
1635 listed as a TODO test on the plan line. However, we are not aware of
1636 anyone actually using this feature and hard-coding test numbers is
1637 discouraged because it's very easy to add a test and break the test
1638 number sequence. This makes test suites very fragile. Instead, the
1639 following should be used:
1642 ok 1 - We have liftoff
1643 not ok 2 - Anti-gravity device activated # TODO
1645 =item * 'Missing' tests
1647 It rarely happens, but sometimes a harness might encounter
1656 L<Test::Harness> would report tests 3-14 as having failed. For the
1657 C<TAP::Parser>, these tests are not considered failed because they've
1658 never run. They're reported as parse failures (tests out of sequence).
1664 If you find you need to provide custom functionality (as you would have using
1665 L<Test::Harness::Straps>), you're in luck: C<TAP::Parser> and friends are
1666 designed to be easily subclassed.
1668 Before you start, it's important to know a few things:
1674 All C<TAP::*> objects inherit from L<TAP::Object>.
1678 Most C<TAP::*> classes have a I<SUBCLASSING> section to guide you.
1682 Note that C<TAP::Parser> is designed to be the central 'maker' - ie: it is
1683 responsible for creating new objects in the C<TAP::Parser::*> namespace.
1685 This makes it possible for you to have a single point of configuring what
1686 subclasses should be used, which in turn means that in many cases you'll find
1687 you only need to sub-class one of the parser's components.
1691 By subclassing, you may end up overriding undocumented methods. That's not
1692 a bad thing per se, but be forewarned that undocumented methods may change
1693 without warning from one release to the next - we cannot guarantee backwards
1694 compatability. If any I<documented> method needs changing, it will be
1695 deprecated first, and changed in a later release.
1699 =head2 Parser Components
1703 A TAP parser consumes input from a I<source>. There are currently two types
1704 of sources: L<TAP::Parser::Source> for general non-perl commands, and
1705 L<TAP::Parser::Source::Perl>. You can subclass both of them. You'll need to
1706 customize your parser by setting the C<source_class> & C<perl_source_class>
1707 parameters. See L</new> for more details.
1709 If you need to customize the objects on creation, subclass L<TAP::Parser> and
1710 override L</make_source> or L</make_perl_source>.
1714 A TAP parser uses I<iterators> to loop through the I<stream> provided by the
1715 parser's I<source>. There are quite a few types of Iterators available.
1716 Choosing which class to use is the responsibility of the I<iterator factory>.
1718 To create your own iterators you'll have to subclass
1719 L<TAP::Parser::IteratorFactory> and L<TAP::Parser::Iterator>. Then you'll
1720 need to customize the class used by your parser by setting the
1721 C<iterator_factory_class> parameter. See L</new> for more details.
1723 If you need to customize the objects on creation, subclass L<TAP::Parser> and
1724 override L</make_iterator>.
1728 A TAP parser creates L<TAP::Parser::Result>s as it iterates through the
1729 input I<stream>. There are quite a few result types available; choosing
1730 which class to use is the responsibility of the I<result factory>.
1732 To create your own result types you have two options:
1738 Subclass L<TAP::Parser::Result> and register your new result type/class with
1739 the default L<TAP::Parser::ResultFactory>.
1743 Subclass L<TAP::Parser::ResultFactory> itself and implement your own
1744 L<TAP::Parser::Result> creation logic. Then you'll need to customize the
1745 class used by your parser by setting the C<result_factory_class> parameter.
1746 See L</new> for more details.
1750 If you need to customize the objects on creation, subclass L<TAP::Parser> and
1751 override L</make_result>.
1755 L<TAP::Parser::Grammar> is the heart of the parser - it tokenizes the TAP
1756 input I<stream> and produces results. If you need to customize its behaviour
1757 you should probably familiarize yourself with the source first. Enough
1760 Subclass L<TAP::Parser::Grammar> and customize your parser by setting the
1761 C<grammar_class> parameter. See L</new> for more details.
1763 If you need to customize the objects on creation, subclass L<TAP::Parser> and
1764 override L</make_grammar>
1766 =head1 ACKNOWLEDGEMENTS
1768 All of the following have helped. Bug reports, patches, (im)moral
1769 support, or just words of encouragement have all been forthcoming.
1773 =item * Michael Schwern
1783 =item * Torsten Schoenfeld
1789 =item * Adam Kennedy
1793 =item * Adrian Howard
1797 =item * Andreas J. Koenig
1799 =item * Florian Ragwitz
1803 =item * Mark Stosberg
1807 =item * David Wheeler
1813 Curtis "Ovid" Poe <ovid@cpan.org>
1815 Andy Armstong <andy@hexten.net>
1817 Eric Wilhelm @ <ewilhelm at cpan dot org>
1819 Michael Peters <mpeters at plusthree dot com>
1821 Leif Eriksen <leif dot eriksen at bigpond dot com>
1823 Steve Purkis <spurkis@cpan.org>
1827 Please report any bugs or feature requests to
1828 C<bug-tapx-parser@rt.cpan.org>, or through the web interface at
1829 L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=TAP-Parser>.
1830 We will be notified, and then you'll automatically be notified of
1831 progress on your bug as we make changes.
1833 Obviously, bugs which include patches are best. If you prefer, you can
1834 patch against bleed by via anonymous checkout of the latest version:
1836 svn checkout http://svn.hexten.net/tapx
1838 =head1 COPYRIGHT & LICENSE
1840 Copyright 2006-2008 Curtis "Ovid" Poe, all rights reserved.
1842 This program is free software; you can redistribute it and/or modify it
1843 under the same terms as Perl itself.