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 );
19 TAP::Parser - Parse L<TAP|Test::Harness::TAP> output
29 my $DEFAULT_TAP_VERSION = 12;
30 my $MAX_TAP_VERSION = 13;
32 $ENV{TAP_VERSION} = $MAX_TAP_VERSION;
37 delete $ENV{TAP_VERSION};
40 BEGIN { # making accessors
43 __PACKAGE__->mk_methods(
62 iterator_factory_class
66 } # done making accessors
72 my $parser = TAP::Parser->new( { source => $source } );
74 while ( my $result = $parser->next ) {
75 print $result->as_string;
80 C<TAP::Parser> is designed to produce a proper parse of TAP output. For
81 an example of how to run tests through this module, see the simple
82 harnesses C<examples/>.
84 There's a wiki dedicated to the Test Anything Protocol:
86 L<http://testanything.org>
88 It includes the TAP::Parser Cookbook:
90 L<http://testanything.org/wiki/index.php/TAP::Parser_Cookbook>
98 my $parser = TAP::Parser->new(\%args);
100 Returns a new C<TAP::Parser> object.
102 The arguments should be a hashref with I<one> of the following keys:
108 This is the preferred method of passing arguments to the constructor. To
109 determine how to handle the source, the following steps are taken.
111 If the source contains a newline, it's assumed to be a string of raw TAP
114 If the source is a reference, it's assumed to be something to pass to
115 the L<TAP::Parser::Iterator::Stream> constructor. This is used
116 internally and you should not use it.
118 Otherwise, the parser does a C<-e> check to see if the source exists. If so,
119 it attempts to execute the source and read the output as a stream. This is by
120 far the preferred method of using the parser.
122 foreach my $file ( @test_files ) {
123 my $parser = TAP::Parser->new( { source => $file } );
124 # do stuff with the parser
129 The value should be the complete TAP output.
133 If passed an array reference, will attempt to create the iterator by
134 passing a L<TAP::Parser::Source> object to
135 L<TAP::Parser::Iterator::Source>, using the array reference strings as
136 the command arguments to L<IPC::Open3::open3|IPC::Open3>:
138 exec => [ '/usr/bin/ruby', 't/my_test.rb' ]
140 Note that C<source> and C<exec> are mutually exclusive.
144 The following keys are optional.
150 If present, each callback corresponding to a given result type will be called
151 with the result as the argument if the C<run> method is used:
154 test => \&test_callback,
155 plan => \&plan_callback,
156 comment => \&comment_callback,
157 bailout => \&bailout_callback,
158 unknown => \&unknown_callback,
161 my $aggregator = TAP::Parser::Aggregator->new;
162 foreach my $file ( @test_files ) {
163 my $parser = TAP::Parser->new(
166 callbacks => \%callbacks,
170 $aggregator->add( $file, $parser );
175 If using a Perl file as a source, optional switches may be passed which will
176 be used when invoking the perl executable.
178 my $parser = TAP::Parser->new( {
179 source => $test_file,
185 Used in conjunction with the C<source> option to supply a reference to
186 an C<@ARGV> style array of arguments to pass to the test program.
190 If passed a filehandle will write a copy of all parsed TAP to that handle.
194 If false, STDERR is not captured (though it is 'relayed' to keep it
195 somewhat synchronized with STDOUT.)
197 If true, STDERR and STDOUT are the same filehandle. This may cause
198 breakage if STDERR contains anything resembling TAP format, but does
199 allow exact synchronization.
201 Subtleties of this behavior may be platform-dependent and may change in
204 =item * C<source_class>
206 This option was introduced to let you easily customize which I<source> class
207 the parser should use. It defaults to L<TAP::Parser::Source>.
209 See also L</make_source>.
211 =item * C<perl_source_class>
213 This option was introduced to let you easily customize which I<perl source>
214 class the parser should use. It defaults to L<TAP::Parser::Source::Perl>.
216 See also L</make_perl_source>.
218 =item * C<grammar_class>
220 This option was introduced to let you easily customize which I<grammar> class
221 the parser should use. It defaults to L<TAP::Parser::Grammar>.
223 See also L</make_grammar>.
225 =item * C<iterator_factory_class>
227 This option was introduced to let you easily customize which I<iterator>
228 factory class the parser should use. It defaults to
229 L<TAP::Parser::IteratorFactory>.
231 See also L</make_iterator>.
233 =item * C<result_factory_class>
235 This option was introduced to let you easily customize which I<result>
236 factory class the parser should use. It defaults to
237 L<TAP::Parser::ResultFactory>.
239 See also L</make_result>.
245 # new() implementation supplied by TAP::Base
247 # This should make overriding behaviour of the Parser in subclasses easier:
248 sub _default_source_class {'TAP::Parser::Source'}
249 sub _default_perl_source_class {'TAP::Parser::Source::Perl'}
250 sub _default_grammar_class {'TAP::Parser::Grammar'}
251 sub _default_iterator_factory_class {'TAP::Parser::IteratorFactory'}
252 sub _default_result_factory_class {'TAP::Parser::ResultFactory'}
254 ##############################################################################
256 =head2 Instance Methods
260 my $parser = TAP::Parser->new( { source => $file } );
261 while ( my $result = $parser->next ) {
262 print $result->as_string, "\n";
265 This method returns the results of the parsing, one result at a time. Note
266 that it is destructive. You can't rewind and examine previous results.
268 If callbacks are used, they will be issued before this call returns.
270 Each result returned is a subclass of L<TAP::Parser::Result>. See that
271 module and related classes for more information on how to use them.
277 return ( $self->{_iter} ||= $self->_iter )->();
280 ##############################################################################
286 This method merely runs the parser and parses all of the TAP.
292 while ( defined( my $result = $self->next ) ) {
298 ##############################################################################
300 =head3 C<make_source>
302 Make a new L<TAP::Parser::Source> object and return it. Passes through any
305 The C<source_class> can be customized, as described in L</new>.
307 =head3 C<make_perl_source>
309 Make a new L<TAP::Parser::Source::Perl> object and return it. Passes through
312 The C<perl_source_class> can be customized, as described in L</new>.
314 =head3 C<make_grammar>
316 Make a new L<TAP::Parser::Grammar> object and return it. Passes through any
319 The C<grammar_class> can be customized, as described in L</new>.
321 =head3 C<make_iterator>
323 Make a new L<TAP::Parser::Iterator> object using the parser's
324 L<TAP::Parser::IteratorFactory>, and return it. Passes through any arguments
327 The C<iterator_factory_class> can be customized, as described in L</new>.
329 =head3 C<make_result>
331 Make a new L<TAP::Parser::Result> object using the parser's
332 L<TAP::Parser::ResultFactory>, and return it. Passes through any arguments
335 The C<result_factory_class> can be customized, as described in L</new>.
339 # This should make overriding behaviour of the Parser in subclasses easier:
340 sub make_source { shift->source_class->new(@_); }
341 sub make_perl_source { shift->perl_source_class->new(@_); }
342 sub make_grammar { shift->grammar_class->new(@_); }
343 sub make_iterator { shift->iterator_factory_class->make_iterator(@_); }
344 sub make_result { shift->result_factory_class->make_result(@_); }
346 sub _iterator_for_source {
347 my ( $self, $source ) = @_;
349 # If the source has a get_stream method then use it. This makes it
350 # possible to pass a pre-existing source object to the parser's
352 if ( UNIVERSAL::can( $source, 'can' ) && $source->can('get_stream') ) {
353 return $source->get_stream($self);
356 return $self->iterator_factory_class->make_iterator($source);
362 # of the following, anything beginning with an underscore is strictly
363 # internal and should not be exposed.
365 version => $DEFAULT_TAP_VERSION,
366 plan => '', # the test plan (e.g., 1..3)
368 tests_run => 0, # actual current test numbers
369 results => [], # TAP parser results
374 actual_failed => [], # how many tests really failed
375 actual_passed => [], # how many tests really passed
376 todo_passed => [], # tests which unexpectedly succeed
377 parse_errors => [], # perfect TAP should have none
380 # We seem to have this list hanging around all over the place. We could
381 # probably get it from somewhere else to avoid the repetition.
382 my @legal_callback = qw(
395 my @class_overrides = qw(
399 iterator_factory_class
404 my ( $self, $arg_for ) = @_;
406 # everything here is basically designed to convert any TAP source to a
410 my %args = %{ $arg_for || {} };
412 $self->SUPER::_initialize( \%args, \@legal_callback );
414 # get any class overrides out first:
415 for my $key (@class_overrides) {
416 my $default_method = "_default_$key";
417 my $val = delete $args{$key} || $self->$default_method();
421 my $stream = delete $args{stream};
422 my $tap = delete $args{tap};
423 my $source = delete $args{source};
424 my $exec = delete $args{exec};
425 my $merge = delete $args{merge};
426 my $spool = delete $args{spool};
427 my $switches = delete $args{switches};
428 my $ignore_exit = delete $args{ignore_exit};
429 my @test_args = @{ delete $args{test_args} || [] };
431 if ( 1 < grep {defined} $stream, $tap, $source, $exec ) {
433 "You may only choose one of 'exec', 'stream', 'tap' or 'source'"
437 if ( my @excess = sort keys %args ) {
438 $self->_croak("Unknown options: @excess");
442 $stream = $self->_iterator_for_source( [ split "\n" => $tap ] );
445 my $source = $self->make_source;
446 $source->source( [ @$exec, @test_args ] );
447 $source->merge($merge); # XXX should just be arguments?
448 $stream = $source->get_stream($self);
451 if ( $source =~ /\n/ ) {
453 = $self->_iterator_for_source( [ split "\n" => $source ] );
455 elsif ( ref $source ) {
456 $stream = $self->_iterator_for_source($source);
458 elsif ( -e $source ) {
459 my $perl = $self->make_perl_source;
461 $perl->switches($switches)
464 $perl->merge($merge); # XXX args to new()?
465 $perl->source( [ $source, @test_args ] );
466 $stream = $perl->get_stream($self);
469 $self->_croak("Cannot determine source for $source");
474 $self->_croak('PANIC: could not determine stream');
477 while ( my ( $k, $v ) = each %initialize ) {
478 $self->{$k} = 'ARRAY' eq ref $v ? [] : $v;
481 $self->_stream($stream);
482 $self->_spool($spool);
483 $self->ignore_exit($ignore_exit);
489 =head1 INDIVIDUAL RESULTS
491 If you've read this far in the docs, you've seen this:
493 while ( my $result = $parser->next ) {
494 print $result->as_string;
497 Each result returned is a L<TAP::Parser::Result> subclass, referred to as
502 Basically, you fetch individual results from the TAP. The six types, with
503 examples of each, are as follows:
521 ok 3 - We should start with some foobar!
525 # Hope we don't use up the foobar.
529 Bail out! We ran out of foobar!
533 ... yo, this ain't TAP! ...
537 Each result fetched is a result object of a different type. There are common
538 methods to each result object and different types may have methods unique to
539 their type. Sometimes a type method may be overridden in a subclass, but its
540 use is guaranteed to be identical.
542 =head2 Common type methods
546 Returns the type of result, such as C<comment> or C<test>.
550 Prints a string representation of the token. This might not be the exact
551 output, however. Tests will have test numbers added if not present, TODO and
552 SKIP directives will be capitalized and, in general, things will be cleaned
553 up. If you need the original text for the token, see the C<raw> method.
557 Returns the original line of text which was parsed.
561 Indicates whether or not this is the test plan line.
565 Indicates whether or not this is a test line.
569 Indicates whether or not this is a comment. Comments will generally only
570 appear in the TAP stream if STDERR is merged to STDOUT. See the
575 Indicates whether or not this is bailout line.
579 Indicates whether or not the current item is a YAML block.
583 Indicates whether or not the current line could be parsed.
587 if ( $result->is_ok ) { ... }
589 Reports whether or not a given result has passed. Anything which is B<not> a
590 test result returns true. This is merely provided as a convenient shortcut
591 which allows you to do this:
593 my $parser = TAP::Parser->new( { source => $source } );
594 while ( my $result = $parser->next ) {
595 # only print failing results
596 print $result->as_string unless $result->is_ok;
599 =head2 C<plan> methods
601 if ( $result->is_plan ) { ... }
603 If the above evaluates as true, the following methods will be available on the
608 if ( $result->is_plan ) {
612 This is merely a synonym for C<as_string>.
616 my $directive = $result->directive;
618 If a SKIP directive is included with the plan, this method will return it.
620 1..0 # SKIP: why bother?
622 =head3 C<explanation>
624 my $explanation = $result->explanation;
626 If a SKIP directive was included with the plan, this method will return the
629 =head2 C<pragma> methods
631 if ( $result->is_pragma ) { ... }
633 If the above evaluates as true, the following methods will be available on the
638 Returns a list of pragmas each of which is a + or - followed by the
641 =head2 C<commment> methods
643 if ( $result->is_comment ) { ... }
645 If the above evaluates as true, the following methods will be available on the
650 if ( $result->is_comment ) {
651 my $comment = $result->comment;
652 print "I have something to say: $comment";
655 =head2 C<bailout> methods
657 if ( $result->is_bailout ) { ... }
659 If the above evaluates as true, the following methods will be available on the
662 =head3 C<explanation>
664 if ( $result->is_bailout ) {
665 my $explanation = $result->explanation;
666 print "We bailed out because ($explanation)";
669 If, and only if, a token is a bailout token, you can get an "explanation" via
670 this method. The explanation is the text after the mystical "Bail out!" words
671 which appear in the tap output.
673 =head2 C<unknown> methods
675 if ( $result->is_unknown ) { ... }
677 There are no unique methods for unknown results.
679 =head2 C<test> methods
681 if ( $result->is_test ) { ... }
683 If the above evaluates as true, the following methods will be available on the
688 my $ok = $result->ok;
690 Returns the literal text of the C<ok> or C<not ok> status.
694 my $test_number = $result->number;
696 Returns the number of the test, even if the original TAP output did not supply
699 =head3 C<description>
701 my $description = $result->description;
703 Returns the description of the test, if any. This is the portion after the
704 test number but before the directive.
708 my $directive = $result->directive;
710 Returns either C<TODO> or C<SKIP> if either directive was present for a test
713 =head3 C<explanation>
715 my $explanation = $result->explanation;
717 If a test had either a C<TODO> or C<SKIP> directive, this method will return
718 the accompanying explantion, if present.
720 not ok 17 - 'Pigs can fly' # TODO not enough acid
722 For the above line, the explanation is I<not enough acid>.
726 if ( $result->is_ok ) { ... }
728 Returns a boolean value indicating whether or not the test passed. Remember
729 that for TODO tests, the test always passes.
731 B<Note:> this was formerly C<passed>. The latter method is deprecated and
732 will issue a warning.
734 =head3 C<is_actual_ok>
736 if ( $result->is_actual_ok ) { ... }
738 Returns a boolean value indicating whether or not the test passed, regardless
741 B<Note:> this was formerly C<actual_passed>. The latter method is deprecated
742 and will issue a warning.
744 =head3 C<is_unplanned>
746 if ( $test->is_unplanned ) { ... }
748 If a test number is greater than the number of planned tests, this method will
749 return true. Unplanned tests will I<always> return false for C<is_ok>,
750 regardless of whether or not the test C<has_todo> (see
751 L<TAP::Parser::Result::Test> for more information about this).
755 if ( $result->has_skip ) { ... }
757 Returns a boolean value indicating whether or not this test had a SKIP
762 if ( $result->has_todo ) { ... }
764 Returns a boolean value indicating whether or not this test had a TODO
767 Note that TODO tests I<always> pass. If you need to know whether or not
768 they really passed, check the C<is_actual_ok> method.
772 if ( $parser->in_todo ) { ... }
774 True while the most recent result was a TODO. Becomes true before the
775 TODO result is returned and stays true until just before the next non-
776 TODO test is returned.
780 After parsing the TAP, there are many methods available to let you dig through
781 the results and determine what is meaningful to you.
783 =head2 Individual Results
785 These results refer to individual tests which are run.
789 my @passed = $parser->passed; # the test numbers which passed
790 my $passed = $parser->passed; # the number of tests which passed
792 This method lets you know which (or how many) tests passed. If a test failed
793 but had a TODO directive, it will be counted as a passed test.
797 sub passed { @{ shift->{passed} } }
801 my @failed = $parser->failed; # the test numbers which failed
802 my $failed = $parser->failed; # the number of tests which failed
804 This method lets you know which (or how many) tests failed. If a test passed
805 but had a TODO directive, it will B<NOT> be counted as a failed test.
809 sub failed { @{ shift->{failed} } }
811 =head3 C<actual_passed>
813 # the test numbers which actually passed
814 my @actual_passed = $parser->actual_passed;
816 # the number of tests which actually passed
817 my $actual_passed = $parser->actual_passed;
819 This method lets you know which (or how many) tests actually passed,
820 regardless of whether or not a TODO directive was found.
824 sub actual_passed { @{ shift->{actual_passed} } }
825 *actual_ok = \&actual_passed;
829 This method is a synonym for C<actual_passed>.
831 =head3 C<actual_failed>
833 # the test numbers which actually failed
834 my @actual_failed = $parser->actual_failed;
836 # the number of tests which actually failed
837 my $actual_failed = $parser->actual_failed;
839 This method lets you know which (or how many) tests actually failed,
840 regardless of whether or not a TODO directive was found.
844 sub actual_failed { @{ shift->{actual_failed} } }
846 ##############################################################################
850 my @todo = $parser->todo; # the test numbers with todo directives
851 my $todo = $parser->todo; # the number of tests with todo directives
853 This method lets you know which (or how many) tests had TODO directives.
857 sub todo { @{ shift->{todo} } }
859 =head3 C<todo_passed>
861 # the test numbers which unexpectedly succeeded
862 my @todo_passed = $parser->todo_passed;
864 # the number of tests which unexpectedly succeeded
865 my $todo_passed = $parser->todo_passed;
867 This method lets you know which (or how many) tests actually passed but were
868 declared as "TODO" tests.
872 sub todo_passed { @{ shift->{todo_passed} } }
874 ##############################################################################
876 =head3 C<todo_failed>
878 # deprecated in favor of 'todo_passed'. This method was horribly misnamed.
880 This was a badly misnamed method. It indicates which TODO tests unexpectedly
881 succeeded. Will now issue a warning and call C<todo_passed>.
887 '"todo_failed" is deprecated. Please use "todo_passed". See the docs.';
893 my @skipped = $parser->skipped; # the test numbers with SKIP directives
894 my $skipped = $parser->skipped; # the number of tests with SKIP directives
896 This method lets you know which (or how many) tests had SKIP directives.
900 sub skipped { @{ shift->{skipped} } }
906 Get or set a pragma. To get the state of a pragma:
908 if ( $p->pragma('strict') ) {
912 To set the state of a pragma:
914 $p->pragma('strict', 1); # enable strict mode
919 my ( $self, $pragma ) = splice @_, 0, 2;
921 return $self->{pragma}->{$pragma} unless @_;
923 if ( my $state = shift ) {
924 $self->{pragma}->{$pragma} = 1;
927 delete $self->{pragma}->{$pragma};
935 Get a list of all the currently enabled pragmas:
937 my @pragmas_enabled = $p->pragmas;
941 sub pragmas { sort keys %{ shift->{pragma} || {} } }
943 =head2 Summary Results
945 These results are "meta" information about the total results of an individual
950 my $plan = $parser->plan;
952 Returns the test plan, if found.
956 Deprecated. Use C<is_good_plan> instead.
961 warn 'good_plan() is deprecated. Please use "is_good_plan()"';
965 ##############################################################################
967 =head3 C<is_good_plan>
969 if ( $parser->is_good_plan ) { ... }
971 Returns a boolean value indicating whether or not the number of tests planned
972 matches the number of tests run.
974 B<Note:> this was formerly C<good_plan>. The latter method is deprecated and
975 will issue a warning.
977 And since we're on that subject ...
979 =head3 C<tests_planned>
981 print $parser->tests_planned;
983 Returns the number of tests planned, according to the plan. For example, a
984 plan of '1..17' will mean that 17 tests were planned.
988 print $parser->tests_run;
990 Returns the number of tests which actually were run. Hopefully this will
991 match the number of C<< $parser->tests_planned >>.
995 Returns a true value (actually the reason for skipping) if all tests
1000 Returns the time when the Parser was created.
1004 Returns the time when the end of TAP input was seen.
1006 =head3 C<has_problems>
1008 if ( $parser->has_problems ) {
1012 This is a 'catch-all' method which returns true if any tests have currently
1013 failed, any TODO tests unexpectedly succeeded, or any parse errors occurred.
1021 || $self->parse_errors
1022 || ( !$self->ignore_exit && ( $self->wait || $self->exit ) );
1029 Once the parser is done, this will return the version number for the
1030 parsed TAP. Version numbers were introduced with TAP version 13 so if no
1031 version number is found version 12 is assumed.
1037 Once the parser is done, this will return the exit status. If the parser ran
1038 an executable, it returns the exit status of the executable.
1044 Once the parser is done, this will return the wait status. If the parser ran
1045 an executable, it returns the wait status of the executable. Otherwise, this
1046 mererely returns the C<exit> status.
1048 =head2 C<ignore_exit>
1050 $parser->ignore_exit(1);
1052 Tell the parser to ignore the exit status from the test when determining
1053 whether the test passed. Normally tests with non-zero exit status are
1054 considered to have failed even if all individual tests passed. In cases
1055 where it is not possible to control the exit value of the test script
1056 use this option to ignore it.
1060 sub ignore_exit { shift->pragma( 'ignore_exit', @_ ) }
1062 =head3 C<parse_errors>
1064 my @errors = $parser->parse_errors; # the parser errors
1065 my $errors = $parser->parse_errors; # the number of parser_errors
1067 Fortunately, all TAP output is perfect. In the event that it is not, this
1068 method will return parser errors. Note that a junk line which the parser does
1069 not recognize is C<not> an error. This allows this parser to handle future
1070 versions of TAP. The following are all TAP errors reported by the parser:
1074 =item * Misplaced plan
1076 The plan (for example, '1..5'), must only come at the beginning or end of the
1083 =item * More than one plan
1086 ok 1 - input file opened
1087 not ok 2 - first line of the input valid # todo some data
1088 ok 3 read the rest of the file
1091 Right. Very funny. Don't do that.
1093 =item * Test numbers out of sequence
1096 ok 1 - input file opened
1097 not ok 2 - first line of the input valid # todo some data
1098 ok 2 read the rest of the file
1100 That last test line above should have the number '3' instead of '2'.
1102 Note that it's perfectly acceptable for some lines to have test numbers and
1103 others to not have them. However, when a test number is found, it must be in
1104 sequence. The following is also an error:
1107 ok 1 - input file opened
1108 not ok - first line of the input valid # todo some data
1109 ok 2 read the rest of the file
1114 ok - input file opened
1115 not ok - first line of the input valid # todo some data
1116 ok 3 read the rest of the file
1122 sub parse_errors { @{ shift->{parse_errors} } }
1125 my ( $self, $error ) = @_;
1126 push @{ $self->{parse_errors} } => $error;
1130 sub _make_state_table {
1133 my %planned_todo = ();
1135 # These transitions are defaults for all states
1136 my %state_globals = (
1143 'If TAP version is present it must be the first line of output'
1150 if ( $self->pragma('strict') ) {
1152 'Unknown TAP token: "' . $unk->raw . '"' );
1159 for my $pr ( $pragma->pragmas ) {
1160 if ( $pr =~ /^ ([-+])(\w+) $/x ) {
1161 $self->pragma( $2, $1 eq '+' );
1168 # Provides default elements for transitions
1169 my %state_defaults = (
1173 $self->tests_planned( $plan->tests_planned );
1174 $self->plan( $plan->plan );
1175 if ( $plan->has_skip ) {
1176 $self->skip_all( $plan->explanation
1177 || '(no reason given)' );
1180 $planned_todo{$_}++ for @{ $plan->todo_list };
1187 my ( $number, $tests_run )
1188 = ( $test->number, ++$self->{tests_run} );
1191 if ( defined $number && delete $planned_todo{$number} ) {
1192 $test->set_directive('TODO');
1195 my $has_todo = $test->has_todo;
1197 $self->in_todo($has_todo);
1198 if ( defined( my $tests_planned = $self->tests_planned ) ) {
1199 if ( $tests_run > $tests_planned ) {
1200 $test->is_unplanned(1);
1204 if ( defined $number ) {
1205 if ( $number != $tests_run ) {
1206 my $count = $tests_run;
1207 $self->_add_error( "Tests out of sequence. Found "
1208 . "($number) but expected ($count)" );
1212 $test->_number( $number = $tests_run );
1215 push @{ $self->{todo} } => $number if $has_todo;
1216 push @{ $self->{todo_passed} } => $number
1217 if $test->todo_passed;
1218 push @{ $self->{skipped} } => $number
1221 push @{ $self->{ $test->is_ok ? 'passed' : 'failed' } } =>
1232 yaml => { act => sub { }, },
1235 # Each state contains a hash the keys of which match a token type. For
1237 # type there may be:
1238 # act A coderef to run
1239 # goto The new state to move to. Stay in this state if
1241 # continue Goto the new state and run the new state for the
1248 my $ver_num = $version->version;
1249 if ( $ver_num <= $DEFAULT_TAP_VERSION ) {
1250 my $ver_min = $DEFAULT_TAP_VERSION + 1;
1252 "Explicit TAP version must be at least "
1253 . "$ver_min. Got version $ver_num" );
1254 $ver_num = $DEFAULT_TAP_VERSION;
1256 if ( $ver_num > $MAX_TAP_VERSION ) {
1258 "TAP specified version $ver_num but "
1259 . "we don't know about versions later "
1260 . "than $MAX_TAP_VERSION" );
1261 $ver_num = $MAX_TAP_VERSION;
1263 $self->version($ver_num);
1264 $self->_grammar->set_version($ver_num);
1268 plan => { goto => 'PLANNED' },
1269 test => { goto => 'UNPLANNED' },
1272 plan => { goto => 'PLANNED' },
1273 test => { goto => 'UNPLANNED' },
1276 test => { goto => 'PLANNED_AFTER_TEST' },
1281 'More than one plan found in TAP output');
1285 PLANNED_AFTER_TEST => {
1286 test => { goto => 'PLANNED_AFTER_TEST' },
1287 plan => { act => sub { }, continue => 'PLANNED' },
1288 yaml => { goto => 'PLANNED' },
1294 my $line = $self->plan;
1296 "Plan ($line) must be at the beginning "
1297 . "or end of the TAP output" );
1298 $self->is_good_plan(0);
1300 continue => 'PLANNED'
1302 plan => { continue => 'PLANNED' },
1305 test => { goto => 'UNPLANNED_AFTER_TEST' },
1306 plan => { goto => 'GOT_PLAN' },
1308 UNPLANNED_AFTER_TEST => {
1309 test => { act => sub { }, continue => 'UNPLANNED' },
1310 plan => { act => sub { }, continue => 'UNPLANNED' },
1311 yaml => { goto => 'PLANNED' },
1315 # Apply globals and defaults to state table
1316 for my $name ( keys %states ) {
1318 # Merge with globals
1319 my $st = { %state_globals, %{ $states{$name} } };
1322 for my $next ( sort keys %{$st} ) {
1323 if ( my $default = $state_defaults{$next} ) {
1324 for my $def ( sort keys %{$default} ) {
1325 $st->{$next}->{$def} ||= $default->{$def};
1330 # Stuff back in table
1331 $states{$name} = $st;
1337 =head3 C<get_select_handles>
1339 Get an a list of file handles which can be passed to C<select> to
1340 determine the readiness of this parser.
1344 sub get_select_handles { shift->_stream->get_select_handles }
1348 return $self->{_grammar} = shift if @_;
1350 return $self->{_grammar} ||= $self->make_grammar(
1351 { stream => $self->_stream,
1353 version => $self->version
1360 my $stream = $self->_stream;
1361 my $grammar = $self->_grammar;
1362 my $spool = $self->_spool;
1364 my $state_table = $self->_make_state_table;
1366 $self->start_time( $self->get_time );
1368 # Make next_state closure
1369 my $next_state = sub {
1371 my $type = $token->type;
1373 my $state_spec = $state_table->{$state}
1374 or die "Illegal state: $state";
1376 if ( my $next = $state_spec->{$type} ) {
1377 if ( my $act = $next->{act} ) {
1380 if ( my $cont = $next->{continue} ) {
1384 elsif ( my $goto = $next->{goto} ) {
1389 confess("Unhandled token type: $type\n");
1395 # Handle end of stream - which means either pop a block or finish
1396 my $end_handler = sub {
1397 $self->exit( $stream->exit );
1398 $self->wait( $stream->wait );
1403 # Finally make the closure that we return. For performance reasons
1404 # there are two versions of the returned function: one that handles
1405 # callbacks and one that does not.
1406 if ( $self->_has_callbacks ) {
1408 my $result = eval { $grammar->tokenize };
1409 $self->_add_error($@) if $@;
1411 if ( defined $result ) {
1412 $result = $next_state->($result);
1414 if ( my $code = $self->_callback_for( $result->type ) ) {
1415 $_->($result) for @{$code};
1418 $self->_make_callback( 'ELSE', $result );
1421 $self->_make_callback( 'ALL', $result );
1423 # Echo TAP to spool file
1424 print {$spool} $result->raw, "\n" if $spool;
1427 $result = $end_handler->();
1428 $self->_make_callback( 'EOF', $self )
1429 unless defined $result;
1437 my $result = eval { $grammar->tokenize };
1438 $self->_add_error($@) if $@;
1440 if ( defined $result ) {
1441 $result = $next_state->($result);
1443 # Echo TAP to spool file
1444 print {$spool} $result->raw, "\n" if $spool;
1447 $result = $end_handler->();
1458 $self->end_time( $self->get_time );
1461 $self->_stream(undef);
1462 $self->_grammar(undef);
1464 # If we just delete the iter we won't get a fault if it's recreated.
1465 # Instead we set it to a sub that returns an infinite
1466 # stream of undef. This segfaults on 5.5.4, presumably because
1467 # we're still executing the closure that gets replaced and it hasn't
1468 # been protected with a refcount.
1469 $self->{_iter} = sub {return}
1473 if ( !$self->plan ) {
1474 $self->_add_error('No plan found in TAP output');
1477 $self->is_good_plan(1) unless defined $self->is_good_plan;
1479 if ( $self->tests_run != ( $self->tests_planned || 0 ) ) {
1480 $self->is_good_plan(0);
1481 if ( defined( my $planned = $self->tests_planned ) ) {
1482 my $ran = $self->tests_run;
1484 "Bad plan. You planned $planned tests but ran $ran.");
1487 if ( $self->tests_run != ( $self->passed + $self->failed ) ) {
1489 # this should never happen
1490 my $actual = $self->tests_run;
1491 my $passed = $self->passed;
1492 my $failed = $self->failed;
1493 $self->_croak( "Panic: planned test count ($actual) did not equal "
1494 . "sum of passed ($passed) and failed ($failed) tests!" );
1497 $self->is_good_plan(0) unless defined $self->is_good_plan;
1501 =head3 C<delete_spool>
1503 Delete and return the spool.
1505 my $fh = $parser->delete_spool;
1512 return delete $self->{_spool};
1515 ##############################################################################
1519 As mentioned earlier, a "callback" key may be added to the
1520 C<TAP::Parser> constructor. If present, each callback corresponding to a
1521 given result type will be called with the result as the argument if the
1522 C<run> method is used. The callback is expected to be a subroutine
1523 reference (or anonymous subroutine) which is invoked with the parser
1524 result as its argument.
1527 test => \&test_callback,
1528 plan => \&plan_callback,
1529 comment => \&comment_callback,
1530 bailout => \&bailout_callback,
1531 unknown => \&unknown_callback,
1534 my $aggregator = TAP::Parser::Aggregator->new;
1535 foreach my $file ( @test_files ) {
1536 my $parser = TAP::Parser->new(
1539 callbacks => \%callbacks,
1543 $aggregator->add( $file, $parser );
1546 Callbacks may also be added like this:
1548 $parser->callback( test => \&test_callback );
1549 $parser->callback( plan => \&plan_callback );
1551 The following keys allowed for callbacks. These keys are case-sensitive.
1557 Invoked if C<< $result->is_test >> returns true.
1561 Invoked if C<< $result->is_version >> returns true.
1565 Invoked if C<< $result->is_plan >> returns true.
1569 Invoked if C<< $result->is_comment >> returns true.
1573 Invoked if C<< $result->is_unknown >> returns true.
1577 Invoked if C<< $result->is_yaml >> returns true.
1581 Invoked if C<< $result->is_unknown >> returns true.
1585 If a result does not have a callback defined for it, this callback will
1586 be invoked. Thus, if all of the previous result types are specified as
1587 callbacks, this callback will I<never> be invoked.
1591 This callback will always be invoked and this will happen for each
1592 result after one of the above callbacks is invoked. For example, if
1593 L<Term::ANSIColor> is loaded, you could use the following to color your
1599 if ( $test->is_ok && not $test->directive ) {
1600 # normal passing test
1601 print color 'green';
1603 elsif ( !$test->is_ok ) { # even if it's TODO
1604 print color 'white on_red';
1606 elsif ( $test->has_skip ) {
1607 print color 'white on_blue';
1610 elsif ( $test->has_todo ) {
1611 print color 'white';
1615 # plan, comment, and so on (anything which isn't a test line)
1616 print color 'black on_white';
1620 print shift->as_string;
1621 print color 'reset';
1628 Invoked when there are no more lines to be parsed. Since there is no
1629 accompanying L<TAP::Parser::Result> object the C<TAP::Parser> object is
1636 If you're looking for an EBNF grammar, see L<TAP::Parser::Grammar>.
1638 =head1 BACKWARDS COMPATABILITY
1640 The Perl-QA list attempted to ensure backwards compatability with
1641 L<Test::Harness>. However, there are some minor differences.
1649 A little-known feature of L<Test::Harness> is that it supported TODO
1653 ok 1 - We have liftoff
1654 not ok 2 - Anti-gravity device activated
1656 Under L<Test::Harness>, test number 2 would I<pass> because it was
1657 listed as a TODO test on the plan line. However, we are not aware of
1658 anyone actually using this feature and hard-coding test numbers is
1659 discouraged because it's very easy to add a test and break the test
1660 number sequence. This makes test suites very fragile. Instead, the
1661 following should be used:
1664 ok 1 - We have liftoff
1665 not ok 2 - Anti-gravity device activated # TODO
1667 =item * 'Missing' tests
1669 It rarely happens, but sometimes a harness might encounter
1678 L<Test::Harness> would report tests 3-14 as having failed. For the
1679 C<TAP::Parser>, these tests are not considered failed because they've
1680 never run. They're reported as parse failures (tests out of sequence).
1686 If you find you need to provide custom functionality (as you would have using
1687 L<Test::Harness::Straps>), you're in luck: C<TAP::Parser> and friends are
1688 designed to be easily subclassed.
1690 Before you start, it's important to know a few things:
1696 All C<TAP::*> objects inherit from L<TAP::Object>.
1700 Most C<TAP::*> classes have a I<SUBCLASSING> section to guide you.
1704 Note that C<TAP::Parser> is designed to be the central 'maker' - ie: it is
1705 responsible for creating new objects in the C<TAP::Parser::*> namespace.
1707 This makes it possible for you to have a single point of configuring what
1708 subclasses should be used, which in turn means that in many cases you'll find
1709 you only need to sub-class one of the parser's components.
1713 By subclassing, you may end up overriding undocumented methods. That's not
1714 a bad thing per se, but be forewarned that undocumented methods may change
1715 without warning from one release to the next - we cannot guarantee backwards
1716 compatability. If any I<documented> method needs changing, it will be
1717 deprecated first, and changed in a later release.
1721 =head2 Parser Components
1725 A TAP parser consumes input from a I<source>. There are currently two types
1726 of sources: L<TAP::Parser::Source> for general non-perl commands, and
1727 L<TAP::Parser::Source::Perl>. You can subclass both of them. You'll need to
1728 customize your parser by setting the C<source_class> & C<perl_source_class>
1729 parameters. See L</new> for more details.
1731 If you need to customize the objects on creation, subclass L<TAP::Parser> and
1732 override L</make_source> or L</make_perl_source>.
1736 A TAP parser uses I<iterators> to loop through the I<stream> provided by the
1737 parser's I<source>. There are quite a few types of Iterators available.
1738 Choosing which class to use is the responsibility of the I<iterator factory>.
1740 To create your own iterators you'll have to subclass
1741 L<TAP::Parser::IteratorFactory> and L<TAP::Parser::Iterator>. Then you'll
1742 need to customize the class used by your parser by setting the
1743 C<iterator_factory_class> parameter. See L</new> for more details.
1745 If you need to customize the objects on creation, subclass L<TAP::Parser> and
1746 override L</make_iterator>.
1750 A TAP parser creates L<TAP::Parser::Result>s as it iterates through the
1751 input I<stream>. There are quite a few result types available; choosing
1752 which class to use is the responsibility of the I<result factory>.
1754 To create your own result types you have two options:
1760 Subclass L<TAP::Parser::Result> and register your new result type/class with
1761 the default L<TAP::Parser::ResultFactory>.
1765 Subclass L<TAP::Parser::ResultFactory> itself and implement your own
1766 L<TAP::Parser::Result> creation logic. Then you'll need to customize the
1767 class used by your parser by setting the C<result_factory_class> parameter.
1768 See L</new> for more details.
1772 If you need to customize the objects on creation, subclass L<TAP::Parser> and
1773 override L</make_result>.
1777 L<TAP::Parser::Grammar> is the heart of the parser - it tokenizes the TAP
1778 input I<stream> and produces results. If you need to customize its behaviour
1779 you should probably familiarize yourself with the source first. Enough
1782 Subclass L<TAP::Parser::Grammar> and customize your parser by setting the
1783 C<grammar_class> parameter. See L</new> for more details.
1785 If you need to customize the objects on creation, subclass L<TAP::Parser> and
1786 override L</make_grammar>
1788 =head1 ACKNOWLEDGEMENTS
1790 All of the following have helped. Bug reports, patches, (im)moral
1791 support, or just words of encouragement have all been forthcoming.
1795 =item * Michael Schwern
1805 =item * Torsten Schoenfeld
1811 =item * Adam Kennedy
1815 =item * Adrian Howard
1819 =item * Andreas J. Koenig
1821 =item * Florian Ragwitz
1825 =item * Mark Stosberg
1829 =item * David Wheeler
1831 =item * Alex Vandiver
1837 Curtis "Ovid" Poe <ovid@cpan.org>
1839 Andy Armstong <andy@hexten.net>
1841 Eric Wilhelm @ <ewilhelm at cpan dot org>
1843 Michael Peters <mpeters at plusthree dot com>
1845 Leif Eriksen <leif dot eriksen at bigpond dot com>
1847 Steve Purkis <spurkis@cpan.org>
1849 Nicholas Clark <nick@ccl4.org>
1853 Please report any bugs or feature requests to
1854 C<bug-test-harness@rt.cpan.org>, or through the web interface at
1855 L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Test-Harness>.
1856 We will be notified, and then you'll automatically be notified of
1857 progress on your bug as we make changes.
1859 Obviously, bugs which include patches are best. If you prefer, you can
1860 patch against bleed by via anonymous checkout of the latest version:
1862 svn checkout http://svn.hexten.net/tapx
1864 =head1 COPYRIGHT & LICENSE
1866 Copyright 2006-2008 Curtis "Ovid" Poe, all rights reserved.
1868 This program is free software; you can redistribute it and/or modify it
1869 under the same terms as Perl itself.