xref: /openbsd-src/gnu/usr.bin/perl/cpan/Test-Harness/lib/TAP/Parser.pm (revision d13be5d47e4149db2549a9828e244d59dbc43f15)
1package TAP::Parser;
2
3use strict;
4use vars qw($VERSION @ISA);
5
6use TAP::Base                    ();
7use TAP::Parser::Grammar         ();
8use TAP::Parser::Result          ();
9use TAP::Parser::ResultFactory   ();
10use TAP::Parser::Source          ();
11use TAP::Parser::Source::Perl    ();
12use TAP::Parser::Iterator        ();
13use TAP::Parser::IteratorFactory ();
14
15use Carp qw( confess );
16
17=head1 NAME
18
19TAP::Parser - Parse L<TAP|Test::Harness::TAP> output
20
21=head1 VERSION
22
23Version 3.17
24
25=cut
26
27$VERSION = '3.17';
28
29my $DEFAULT_TAP_VERSION = 12;
30my $MAX_TAP_VERSION     = 13;
31
32$ENV{TAP_VERSION} = $MAX_TAP_VERSION;
33
34END {
35
36    # For VMS.
37    delete $ENV{TAP_VERSION};
38}
39
40BEGIN {    # making accessors
41    @ISA = qw(TAP::Base);
42
43    __PACKAGE__->mk_methods(
44        qw(
45          _stream
46          _spool
47          exec
48          exit
49          is_good_plan
50          plan
51          tests_planned
52          tests_run
53          wait
54          version
55          in_todo
56          start_time
57          end_time
58          skip_all
59          source_class
60          perl_source_class
61          grammar_class
62          iterator_factory_class
63          result_factory_class
64          )
65    );
66}    # done making accessors
67
68=head1 SYNOPSIS
69
70    use TAP::Parser;
71
72    my $parser = TAP::Parser->new( { source => $source } );
73
74    while ( my $result = $parser->next ) {
75        print $result->as_string;
76    }
77
78=head1 DESCRIPTION
79
80C<TAP::Parser> is designed to produce a proper parse of TAP output. For
81an example of how to run tests through this module, see the simple
82harnesses C<examples/>.
83
84There's a wiki dedicated to the Test Anything Protocol:
85
86L<http://testanything.org>
87
88It includes the TAP::Parser Cookbook:
89
90L<http://testanything.org/wiki/index.php/TAP::Parser_Cookbook>
91
92=head1 METHODS
93
94=head2 Class Methods
95
96=head3 C<new>
97
98 my $parser = TAP::Parser->new(\%args);
99
100Returns a new C<TAP::Parser> object.
101
102The arguments should be a hashref with I<one> of the following keys:
103
104=over 4
105
106=item * C<source>
107
108This is the preferred method of passing arguments to the constructor.  To
109determine how to handle the source, the following steps are taken.
110
111If the source contains a newline, it's assumed to be a string of raw TAP
112output.
113
114If the source is a reference, it's assumed to be something to pass to
115the L<TAP::Parser::Iterator::Stream> constructor. This is used
116internally and you should not use it.
117
118Otherwise, the parser does a C<-e> check to see if the source exists.  If so,
119it attempts to execute the source and read the output as a stream.  This is by
120far the preferred method of using the parser.
121
122 foreach my $file ( @test_files ) {
123     my $parser = TAP::Parser->new( { source => $file } );
124     # do stuff with the parser
125 }
126
127=item * C<tap>
128
129The value should be the complete TAP output.
130
131=item * C<exec>
132
133If passed an array reference, will attempt to create the iterator by
134passing a L<TAP::Parser::Source> object to
135L<TAP::Parser::Iterator::Source>, using the array reference strings as
136the command arguments to L<IPC::Open3::open3|IPC::Open3>:
137
138 exec => [ '/usr/bin/ruby', 't/my_test.rb' ]
139
140Note that C<source> and C<exec> are mutually exclusive.
141
142=back
143
144The following keys are optional.
145
146=over 4
147
148=item * C<callback>
149
150If present, each callback corresponding to a given result type will be called
151with the result as the argument if the C<run> method is used:
152
153 my %callbacks = (
154     test    => \&test_callback,
155     plan    => \&plan_callback,
156     comment => \&comment_callback,
157     bailout => \&bailout_callback,
158     unknown => \&unknown_callback,
159 );
160
161 my $aggregator = TAP::Parser::Aggregator->new;
162 foreach my $file ( @test_files ) {
163     my $parser = TAP::Parser->new(
164         {
165             source    => $file,
166             callbacks => \%callbacks,
167         }
168     );
169     $parser->run;
170     $aggregator->add( $file, $parser );
171 }
172
173=item * C<switches>
174
175If using a Perl file as a source, optional switches may be passed which will
176be used when invoking the perl executable.
177
178 my $parser = TAP::Parser->new( {
179     source   => $test_file,
180     switches => '-Ilib',
181 } );
182
183=item * C<test_args>
184
185Used in conjunction with the C<source> option to supply a reference to
186an C<@ARGV> style array of arguments to pass to the test program.
187
188=item * C<spool>
189
190If passed a filehandle will write a copy of all parsed TAP to that handle.
191
192=item * C<merge>
193
194If false, STDERR is not captured (though it is 'relayed' to keep it
195somewhat synchronized with STDOUT.)
196
197If true, STDERR and STDOUT are the same filehandle.  This may cause
198breakage if STDERR contains anything resembling TAP format, but does
199allow exact synchronization.
200
201Subtleties of this behavior may be platform-dependent and may change in
202the future.
203
204=item * C<source_class>
205
206This option was introduced to let you easily customize which I<source> class
207the parser should use.  It defaults to L<TAP::Parser::Source>.
208
209See also L</make_source>.
210
211=item * C<perl_source_class>
212
213This option was introduced to let you easily customize which I<perl source>
214class the parser should use.  It defaults to L<TAP::Parser::Source::Perl>.
215
216See also L</make_perl_source>.
217
218=item * C<grammar_class>
219
220This option was introduced to let you easily customize which I<grammar> class
221the parser should use.  It defaults to L<TAP::Parser::Grammar>.
222
223See also L</make_grammar>.
224
225=item * C<iterator_factory_class>
226
227This option was introduced to let you easily customize which I<iterator>
228factory class the parser should use.  It defaults to
229L<TAP::Parser::IteratorFactory>.
230
231See also L</make_iterator>.
232
233=item * C<result_factory_class>
234
235This option was introduced to let you easily customize which I<result>
236factory class the parser should use.  It defaults to
237L<TAP::Parser::ResultFactory>.
238
239See also L</make_result>.
240
241=back
242
243=cut
244
245# new() implementation supplied by TAP::Base
246
247# This should make overriding behaviour of the Parser in subclasses easier:
248sub _default_source_class           {'TAP::Parser::Source'}
249sub _default_perl_source_class      {'TAP::Parser::Source::Perl'}
250sub _default_grammar_class          {'TAP::Parser::Grammar'}
251sub _default_iterator_factory_class {'TAP::Parser::IteratorFactory'}
252sub _default_result_factory_class   {'TAP::Parser::ResultFactory'}
253
254##############################################################################
255
256=head2 Instance Methods
257
258=head3 C<next>
259
260  my $parser = TAP::Parser->new( { source => $file } );
261  while ( my $result = $parser->next ) {
262      print $result->as_string, "\n";
263  }
264
265This method returns the results of the parsing, one result at a time.  Note
266that it is destructive.  You can't rewind and examine previous results.
267
268If callbacks are used, they will be issued before this call returns.
269
270Each result returned is a subclass of L<TAP::Parser::Result>.  See that
271module and related classes for more information on how to use them.
272
273=cut
274
275sub next {
276    my $self = shift;
277    return ( $self->{_iter} ||= $self->_iter )->();
278}
279
280##############################################################################
281
282=head3 C<run>
283
284  $parser->run;
285
286This method merely runs the parser and parses all of the TAP.
287
288=cut
289
290sub run {
291    my $self = shift;
292    while ( defined( my $result = $self->next ) ) {
293
294        # do nothing
295    }
296}
297
298##############################################################################
299
300=head3 C<make_source>
301
302Make a new L<TAP::Parser::Source> object and return it.  Passes through any
303arguments given.
304
305The C<source_class> can be customized, as described in L</new>.
306
307=head3 C<make_perl_source>
308
309Make a new L<TAP::Parser::Source::Perl> object and return it.  Passes through
310any arguments given.
311
312The C<perl_source_class> can be customized, as described in L</new>.
313
314=head3 C<make_grammar>
315
316Make a new L<TAP::Parser::Grammar> object and return it.  Passes through any
317arguments given.
318
319The C<grammar_class> can be customized, as described in L</new>.
320
321=head3 C<make_iterator>
322
323Make a new L<TAP::Parser::Iterator> object using the parser's
324L<TAP::Parser::IteratorFactory>, and return it.  Passes through any arguments
325given.
326
327The C<iterator_factory_class> can be customized, as described in L</new>.
328
329=head3 C<make_result>
330
331Make a new L<TAP::Parser::Result> object using the parser's
332L<TAP::Parser::ResultFactory>, and return it.  Passes through any arguments
333given.
334
335The C<result_factory_class> can be customized, as described in L</new>.
336
337=cut
338
339# This should make overriding behaviour of the Parser in subclasses easier:
340sub make_source      { shift->source_class->new(@_); }
341sub make_perl_source { shift->perl_source_class->new(@_); }
342sub make_grammar     { shift->grammar_class->new(@_); }
343sub make_iterator    { shift->iterator_factory_class->make_iterator(@_); }
344sub make_result      { shift->result_factory_class->make_result(@_); }
345
346sub _iterator_for_source {
347    my ( $self, $source ) = @_;
348
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
351    # constructor.
352    if ( UNIVERSAL::can( $source, 'can' ) && $source->can('get_stream') ) {
353        return $source->get_stream($self);
354    }
355    else {
356        return $self->iterator_factory_class->make_iterator($source);
357    }
358}
359
360{
361
362    # of the following, anything beginning with an underscore is strictly
363    # internal and should not be exposed.
364    my %initialize = (
365        version       => $DEFAULT_TAP_VERSION,
366        plan          => '',                    # the test plan (e.g., 1..3)
367        tap           => '',                    # the TAP
368        tests_run     => 0,                     # actual current test numbers
369        results       => [],                    # TAP parser results
370        skipped       => [],                    #
371        todo          => [],                    #
372        passed        => [],                    #
373        failed        => [],                    #
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
378    );
379
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(
383      test
384      version
385      plan
386      comment
387      bailout
388      unknown
389      yaml
390      ALL
391      ELSE
392      EOF
393    );
394
395    my @class_overrides = qw(
396      source_class
397      perl_source_class
398      grammar_class
399      iterator_factory_class
400      result_factory_class
401    );
402
403    sub _initialize {
404        my ( $self, $arg_for ) = @_;
405
406        # everything here is basically designed to convert any TAP source to a
407        # stream.
408
409        # Shallow copy
410        my %args = %{ $arg_for || {} };
411
412        $self->SUPER::_initialize( \%args, \@legal_callback );
413
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();
418            $self->$key($val);
419        }
420
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} || [] };
430
431        if ( 1 < grep {defined} $stream, $tap, $source, $exec ) {
432            $self->_croak(
433                "You may only choose one of 'exec', 'stream', 'tap' or 'source'"
434            );
435        }
436
437        if ( my @excess = sort keys %args ) {
438            $self->_croak("Unknown options: @excess");
439        }
440
441        if ($tap) {
442            $stream = $self->_iterator_for_source( [ split "\n" => $tap ] );
443        }
444        elsif ($exec) {
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);
449        }
450        elsif ($source) {
451            if ( $source =~ /\n/ ) {
452                $stream
453                  = $self->_iterator_for_source( [ split "\n" => $source ] );
454            }
455            elsif ( ref $source ) {
456                $stream = $self->_iterator_for_source($source);
457            }
458            elsif ( -e $source ) {
459                my $perl = $self->make_perl_source;
460
461                $perl->switches($switches)
462                  if $switches;
463
464                $perl->merge($merge);    # XXX args to new()?
465                $perl->source( [ $source, @test_args ] );
466                $stream = $perl->get_stream($self);
467            }
468            else {
469                $self->_croak("Cannot determine source for $source");
470            }
471        }
472
473        unless ($stream) {
474            $self->_croak('PANIC: could not determine stream');
475        }
476
477        while ( my ( $k, $v ) = each %initialize ) {
478            $self->{$k} = 'ARRAY' eq ref $v ? [] : $v;
479        }
480
481        $self->_stream($stream);
482        $self->_spool($spool);
483        $self->ignore_exit($ignore_exit);
484
485        return $self;
486    }
487}
488
489=head1 INDIVIDUAL RESULTS
490
491If you've read this far in the docs, you've seen this:
492
493    while ( my $result = $parser->next ) {
494        print $result->as_string;
495    }
496
497Each result returned is a L<TAP::Parser::Result> subclass, referred to as
498I<result types>.
499
500=head2 Result types
501
502Basically, you fetch individual results from the TAP.  The six types, with
503examples of each, are as follows:
504
505=over 4
506
507=item * Version
508
509 TAP version 12
510
511=item * Plan
512
513 1..42
514
515=item * Pragma
516
517 pragma +strict
518
519=item * Test
520
521 ok 3 - We should start with some foobar!
522
523=item * Comment
524
525 # Hope we don't use up the foobar.
526
527=item * Bailout
528
529 Bail out!  We ran out of foobar!
530
531=item * Unknown
532
533 ... yo, this ain't TAP! ...
534
535=back
536
537Each result fetched is a result object of a different type.  There are common
538methods to each result object and different types may have methods unique to
539their type.  Sometimes a type method may be overridden in a subclass, but its
540use is guaranteed to be identical.
541
542=head2 Common type methods
543
544=head3 C<type>
545
546Returns the type of result, such as C<comment> or C<test>.
547
548=head3 C<as_string>
549
550Prints a string representation of the token.  This might not be the exact
551output, however.  Tests will have test numbers added if not present, TODO and
552SKIP directives will be capitalized and, in general, things will be cleaned
553up.  If you need the original text for the token, see the C<raw> method.
554
555=head3  C<raw>
556
557Returns the original line of text which was parsed.
558
559=head3 C<is_plan>
560
561Indicates whether or not this is the test plan line.
562
563=head3 C<is_test>
564
565Indicates whether or not this is a test line.
566
567=head3 C<is_comment>
568
569Indicates whether or not this is a comment. Comments will generally only
570appear in the TAP stream if STDERR is merged to STDOUT. See the
571C<merge> option.
572
573=head3 C<is_bailout>
574
575Indicates whether or not this is bailout line.
576
577=head3 C<is_yaml>
578
579Indicates whether or not the current item is a YAML block.
580
581=head3 C<is_unknown>
582
583Indicates whether or not the current line could be parsed.
584
585=head3 C<is_ok>
586
587  if ( $result->is_ok ) { ... }
588
589Reports whether or not a given result has passed.  Anything which is B<not> a
590test result returns true.  This is merely provided as a convenient shortcut
591which allows you to do this:
592
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;
597 }
598
599=head2 C<plan> methods
600
601 if ( $result->is_plan ) { ... }
602
603If the above evaluates as true, the following methods will be available on the
604C<$result> object.
605
606=head3 C<plan>
607
608  if ( $result->is_plan ) {
609     print $result->plan;
610  }
611
612This is merely a synonym for C<as_string>.
613
614=head3 C<directive>
615
616 my $directive = $result->directive;
617
618If a SKIP directive is included with the plan, this method will return it.
619
620 1..0 # SKIP: why bother?
621
622=head3 C<explanation>
623
624 my $explanation = $result->explanation;
625
626If a SKIP directive was included with the plan, this method will return the
627explanation, if any.
628
629=head2 C<pragma> methods
630
631 if ( $result->is_pragma ) { ... }
632
633If the above evaluates as true, the following methods will be available on the
634C<$result> object.
635
636=head3 C<pragmas>
637
638Returns a list of pragmas each of which is a + or - followed by the
639pragma name.
640
641=head2 C<commment> methods
642
643 if ( $result->is_comment ) { ... }
644
645If the above evaluates as true, the following methods will be available on the
646C<$result> object.
647
648=head3 C<comment>
649
650  if ( $result->is_comment ) {
651      my $comment = $result->comment;
652      print "I have something to say:  $comment";
653  }
654
655=head2 C<bailout> methods
656
657 if ( $result->is_bailout ) { ... }
658
659If the above evaluates as true, the following methods will be available on the
660C<$result> object.
661
662=head3 C<explanation>
663
664  if ( $result->is_bailout ) {
665      my $explanation = $result->explanation;
666      print "We bailed out because ($explanation)";
667  }
668
669If, and only if, a token is a bailout token, you can get an "explanation" via
670this method.  The explanation is the text after the mystical "Bail out!" words
671which appear in the tap output.
672
673=head2 C<unknown> methods
674
675 if ( $result->is_unknown ) { ... }
676
677There are no unique methods for unknown results.
678
679=head2 C<test> methods
680
681 if ( $result->is_test ) { ... }
682
683If the above evaluates as true, the following methods will be available on the
684C<$result> object.
685
686=head3 C<ok>
687
688  my $ok = $result->ok;
689
690Returns the literal text of the C<ok> or C<not ok> status.
691
692=head3 C<number>
693
694  my $test_number = $result->number;
695
696Returns the number of the test, even if the original TAP output did not supply
697that number.
698
699=head3 C<description>
700
701  my $description = $result->description;
702
703Returns the description of the test, if any.  This is the portion after the
704test number but before the directive.
705
706=head3 C<directive>
707
708  my $directive = $result->directive;
709
710Returns either C<TODO> or C<SKIP> if either directive was present for a test
711line.
712
713=head3 C<explanation>
714
715  my $explanation = $result->explanation;
716
717If a test had either a C<TODO> or C<SKIP> directive, this method will return
718the accompanying explantion, if present.
719
720  not ok 17 - 'Pigs can fly' # TODO not enough acid
721
722For the above line, the explanation is I<not enough acid>.
723
724=head3 C<is_ok>
725
726  if ( $result->is_ok ) { ... }
727
728Returns a boolean value indicating whether or not the test passed.  Remember
729that for TODO tests, the test always passes.
730
731B<Note:>  this was formerly C<passed>.  The latter method is deprecated and
732will issue a warning.
733
734=head3 C<is_actual_ok>
735
736  if ( $result->is_actual_ok ) { ... }
737
738Returns a boolean value indicating whether or not the test passed, regardless
739of its TODO status.
740
741B<Note:>  this was formerly C<actual_passed>.  The latter method is deprecated
742and will issue a warning.
743
744=head3 C<is_unplanned>
745
746  if ( $test->is_unplanned ) { ... }
747
748If a test number is greater than the number of planned tests, this method will
749return true.  Unplanned tests will I<always> return false for C<is_ok>,
750regardless of whether or not the test C<has_todo> (see
751L<TAP::Parser::Result::Test> for more information about this).
752
753=head3 C<has_skip>
754
755  if ( $result->has_skip ) { ... }
756
757Returns a boolean value indicating whether or not this test had a SKIP
758directive.
759
760=head3 C<has_todo>
761
762  if ( $result->has_todo ) { ... }
763
764Returns a boolean value indicating whether or not this test had a TODO
765directive.
766
767Note that TODO tests I<always> pass.  If you need to know whether or not
768they really passed, check the C<is_actual_ok> method.
769
770=head3 C<in_todo>
771
772  if ( $parser->in_todo ) { ... }
773
774True while the most recent result was a TODO. Becomes true before the
775TODO result is returned and stays true until just before the next non-
776TODO test is returned.
777
778=head1 TOTAL RESULTS
779
780After parsing the TAP, there are many methods available to let you dig through
781the results and determine what is meaningful to you.
782
783=head2 Individual Results
784
785These results refer to individual tests which are run.
786
787=head3 C<passed>
788
789 my @passed = $parser->passed; # the test numbers which passed
790 my $passed = $parser->passed; # the number of tests which passed
791
792This method lets you know which (or how many) tests passed.  If a test failed
793but had a TODO directive, it will be counted as a passed test.
794
795=cut
796
797sub passed { @{ shift->{passed} } }
798
799=head3 C<failed>
800
801 my @failed = $parser->failed; # the test numbers which failed
802 my $failed = $parser->failed; # the number of tests which failed
803
804This method lets you know which (or how many) tests failed.  If a test passed
805but had a TODO directive, it will B<NOT> be counted as a failed test.
806
807=cut
808
809sub failed { @{ shift->{failed} } }
810
811=head3 C<actual_passed>
812
813 # the test numbers which actually passed
814 my @actual_passed = $parser->actual_passed;
815
816 # the number of tests which actually passed
817 my $actual_passed = $parser->actual_passed;
818
819This method lets you know which (or how many) tests actually passed,
820regardless of whether or not a TODO directive was found.
821
822=cut
823
824sub actual_passed { @{ shift->{actual_passed} } }
825*actual_ok = \&actual_passed;
826
827=head3 C<actual_ok>
828
829This method is a synonym for C<actual_passed>.
830
831=head3 C<actual_failed>
832
833 # the test numbers which actually failed
834 my @actual_failed = $parser->actual_failed;
835
836 # the number of tests which actually failed
837 my $actual_failed = $parser->actual_failed;
838
839This method lets you know which (or how many) tests actually failed,
840regardless of whether or not a TODO directive was found.
841
842=cut
843
844sub actual_failed { @{ shift->{actual_failed} } }
845
846##############################################################################
847
848=head3 C<todo>
849
850 my @todo = $parser->todo; # the test numbers with todo directives
851 my $todo = $parser->todo; # the number of tests with todo directives
852
853This method lets you know which (or how many) tests had TODO directives.
854
855=cut
856
857sub todo { @{ shift->{todo} } }
858
859=head3 C<todo_passed>
860
861 # the test numbers which unexpectedly succeeded
862 my @todo_passed = $parser->todo_passed;
863
864 # the number of tests which unexpectedly succeeded
865 my $todo_passed = $parser->todo_passed;
866
867This method lets you know which (or how many) tests actually passed but were
868declared as "TODO" tests.
869
870=cut
871
872sub todo_passed { @{ shift->{todo_passed} } }
873
874##############################################################################
875
876=head3 C<todo_failed>
877
878  # deprecated in favor of 'todo_passed'.  This method was horribly misnamed.
879
880This was a badly misnamed method.  It indicates which TODO tests unexpectedly
881succeeded.  Will now issue a warning and call C<todo_passed>.
882
883=cut
884
885sub todo_failed {
886    warn
887      '"todo_failed" is deprecated.  Please use "todo_passed".  See the docs.';
888    goto &todo_passed;
889}
890
891=head3 C<skipped>
892
893 my @skipped = $parser->skipped; # the test numbers with SKIP directives
894 my $skipped = $parser->skipped; # the number of tests with SKIP directives
895
896This method lets you know which (or how many) tests had SKIP directives.
897
898=cut
899
900sub skipped { @{ shift->{skipped} } }
901
902=head2 Pragmas
903
904=head3 C<pragma>
905
906Get or set a pragma. To get the state of a pragma:
907
908  if ( $p->pragma('strict') ) {
909      # be strict
910  }
911
912To set the state of a pragma:
913
914  $p->pragma('strict', 1); # enable strict mode
915
916=cut
917
918sub pragma {
919    my ( $self, $pragma ) = splice @_, 0, 2;
920
921    return $self->{pragma}->{$pragma} unless @_;
922
923    if ( my $state = shift ) {
924        $self->{pragma}->{$pragma} = 1;
925    }
926    else {
927        delete $self->{pragma}->{$pragma};
928    }
929
930    return;
931}
932
933=head3 C<pragmas>
934
935Get a list of all the currently enabled pragmas:
936
937  my @pragmas_enabled = $p->pragmas;
938
939=cut
940
941sub pragmas { sort keys %{ shift->{pragma} || {} } }
942
943=head2 Summary Results
944
945These results are "meta" information about the total results of an individual
946test program.
947
948=head3 C<plan>
949
950 my $plan = $parser->plan;
951
952Returns the test plan, if found.
953
954=head3 C<good_plan>
955
956Deprecated.  Use C<is_good_plan> instead.
957
958=cut
959
960sub good_plan {
961    warn 'good_plan() is deprecated.  Please use "is_good_plan()"';
962    goto &is_good_plan;
963}
964
965##############################################################################
966
967=head3 C<is_good_plan>
968
969  if ( $parser->is_good_plan ) { ... }
970
971Returns a boolean value indicating whether or not the number of tests planned
972matches the number of tests run.
973
974B<Note:>  this was formerly C<good_plan>.  The latter method is deprecated and
975will issue a warning.
976
977And since we're on that subject ...
978
979=head3 C<tests_planned>
980
981  print $parser->tests_planned;
982
983Returns the number of tests planned, according to the plan.  For example, a
984plan of '1..17' will mean that 17 tests were planned.
985
986=head3 C<tests_run>
987
988  print $parser->tests_run;
989
990Returns the number of tests which actually were run.  Hopefully this will
991match the number of C<< $parser->tests_planned >>.
992
993=head3 C<skip_all>
994
995Returns a true value (actually the reason for skipping) if all tests
996were skipped.
997
998=head3 C<start_time>
999
1000Returns the time when the Parser was created.
1001
1002=head3 C<end_time>
1003
1004Returns the time when the end of TAP input was seen.
1005
1006=head3 C<has_problems>
1007
1008  if ( $parser->has_problems ) {
1009      ...
1010  }
1011
1012This is a 'catch-all' method which returns true if any tests have currently
1013failed, any TODO tests unexpectedly succeeded, or any parse errors occurred.
1014
1015=cut
1016
1017sub has_problems {
1018    my $self = shift;
1019    return
1020         $self->failed
1021      || $self->parse_errors
1022      || ( !$self->ignore_exit && ( $self->wait || $self->exit ) );
1023}
1024
1025=head3 C<version>
1026
1027  $parser->version;
1028
1029Once the parser is done, this will return the version number for the
1030parsed TAP. Version numbers were introduced with TAP version 13 so if no
1031version number is found version 12 is assumed.
1032
1033=head3 C<exit>
1034
1035  $parser->exit;
1036
1037Once the parser is done, this will return the exit status.  If the parser ran
1038an executable, it returns the exit status of the executable.
1039
1040=head3 C<wait>
1041
1042  $parser->wait;
1043
1044Once the parser is done, this will return the wait status.  If the parser ran
1045an executable, it returns the wait status of the executable.  Otherwise, this
1046mererely returns the C<exit> status.
1047
1048=head2 C<ignore_exit>
1049
1050  $parser->ignore_exit(1);
1051
1052Tell the parser to ignore the exit status from the test when determining
1053whether the test passed. Normally tests with non-zero exit status are
1054considered to have failed even if all individual tests passed. In cases
1055where it is not possible to control the exit value of the test script
1056use this option to ignore it.
1057
1058=cut
1059
1060sub ignore_exit { shift->pragma( 'ignore_exit', @_ ) }
1061
1062=head3 C<parse_errors>
1063
1064 my @errors = $parser->parse_errors; # the parser errors
1065 my $errors = $parser->parse_errors; # the number of parser_errors
1066
1067Fortunately, all TAP output is perfect.  In the event that it is not, this
1068method will return parser errors.  Note that a junk line which the parser does
1069not recognize is C<not> an error.  This allows this parser to handle future
1070versions of TAP.  The following are all TAP errors reported by the parser:
1071
1072=over 4
1073
1074=item * Misplaced plan
1075
1076The plan (for example, '1..5'), must only come at the beginning or end of the
1077TAP output.
1078
1079=item * No plan
1080
1081Gotta have a plan!
1082
1083=item * More than one plan
1084
1085 1..3
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
1089 1..3
1090
1091Right.  Very funny.  Don't do that.
1092
1093=item * Test numbers out of sequence
1094
1095 1..3
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
1099
1100That last test line above should have the number '3' instead of '2'.
1101
1102Note that it's perfectly acceptable for some lines to have test numbers and
1103others to not have them.  However, when a test number is found, it must be in
1104sequence.  The following is also an error:
1105
1106 1..3
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
1110
1111But this is not:
1112
1113 1..3
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
1117
1118=back
1119
1120=cut
1121
1122sub parse_errors { @{ shift->{parse_errors} } }
1123
1124sub _add_error {
1125    my ( $self, $error ) = @_;
1126    push @{ $self->{parse_errors} } => $error;
1127    return $self;
1128}
1129
1130sub _make_state_table {
1131    my $self = shift;
1132    my %states;
1133    my %planned_todo = ();
1134
1135    # These transitions are defaults for all states
1136    my %state_globals = (
1137        comment => {},
1138        bailout => {},
1139        yaml    => {},
1140        version => {
1141            act => sub {
1142                $self->_add_error(
1143                    'If TAP version is present it must be the first line of output'
1144                );
1145            },
1146        },
1147        unknown => {
1148            act => sub {
1149                my $unk = shift;
1150                if ( $self->pragma('strict') ) {
1151                    $self->_add_error(
1152                        'Unknown TAP token: "' . $unk->raw . '"' );
1153                }
1154            },
1155        },
1156        pragma => {
1157            act => sub {
1158                my ($pragma) = @_;
1159                for my $pr ( $pragma->pragmas ) {
1160                    if ( $pr =~ /^ ([-+])(\w+) $/x ) {
1161                        $self->pragma( $2, $1 eq '+' );
1162                    }
1163                }
1164            },
1165        },
1166    );
1167
1168    # Provides default elements for transitions
1169    my %state_defaults = (
1170        plan => {
1171            act => sub {
1172                my ($plan) = @_;
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)' );
1178                }
1179
1180                $planned_todo{$_}++ for @{ $plan->todo_list };
1181            },
1182        },
1183        test => {
1184            act => sub {
1185                my ($test) = @_;
1186
1187                my ( $number, $tests_run )
1188                  = ( $test->number, ++$self->{tests_run} );
1189
1190                # Fake TODO state
1191                if ( defined $number && delete $planned_todo{$number} ) {
1192                    $test->set_directive('TODO');
1193                }
1194
1195                my $has_todo = $test->has_todo;
1196
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);
1201                    }
1202                }
1203
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)" );
1209                    }
1210                }
1211                else {
1212                    $test->_number( $number = $tests_run );
1213                }
1214
1215                push @{ $self->{todo} } => $number if $has_todo;
1216                push @{ $self->{todo_passed} } => $number
1217                  if $test->todo_passed;
1218                push @{ $self->{skipped} } => $number
1219                  if $test->has_skip;
1220
1221                push @{ $self->{ $test->is_ok ? 'passed' : 'failed' } } =>
1222                  $number;
1223                push @{
1224                    $self->{
1225                        $test->is_actual_ok
1226                        ? 'actual_passed'
1227                        : 'actual_failed'
1228                      }
1229                  } => $number;
1230            },
1231        },
1232        yaml => { act => sub { }, },
1233    );
1234
1235    # Each state contains a hash the keys of which match a token type. For
1236    # each token
1237    # type there may be:
1238    #   act      A coderef to run
1239    #   goto     The new state to move to. Stay in this state if
1240    #            missing
1241    #   continue Goto the new state and run the new state for the
1242    #            current token
1243    %states = (
1244        INIT => {
1245            version => {
1246                act => sub {
1247                    my ($version) = @_;
1248                    my $ver_num = $version->version;
1249                    if ( $ver_num <= $DEFAULT_TAP_VERSION ) {
1250                        my $ver_min = $DEFAULT_TAP_VERSION + 1;
1251                        $self->_add_error(
1252                                "Explicit TAP version must be at least "
1253                              . "$ver_min. Got version $ver_num" );
1254                        $ver_num = $DEFAULT_TAP_VERSION;
1255                    }
1256                    if ( $ver_num > $MAX_TAP_VERSION ) {
1257                        $self->_add_error(
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;
1262                    }
1263                    $self->version($ver_num);
1264                    $self->_grammar->set_version($ver_num);
1265                },
1266                goto => 'PLAN'
1267            },
1268            plan => { goto => 'PLANNED' },
1269            test => { goto => 'UNPLANNED' },
1270        },
1271        PLAN => {
1272            plan => { goto => 'PLANNED' },
1273            test => { goto => 'UNPLANNED' },
1274        },
1275        PLANNED => {
1276            test => { goto => 'PLANNED_AFTER_TEST' },
1277            plan => {
1278                act => sub {
1279                    my ($version) = @_;
1280                    $self->_add_error(
1281                        'More than one plan found in TAP output');
1282                },
1283            },
1284        },
1285        PLANNED_AFTER_TEST => {
1286            test => { goto => 'PLANNED_AFTER_TEST' },
1287            plan => { act  => sub { }, continue => 'PLANNED' },
1288            yaml => { goto => 'PLANNED' },
1289        },
1290        GOT_PLAN => {
1291            test => {
1292                act => sub {
1293                    my ($plan) = @_;
1294                    my $line = $self->plan;
1295                    $self->_add_error(
1296                            "Plan ($line) must be at the beginning "
1297                          . "or end of the TAP output" );
1298                    $self->is_good_plan(0);
1299                },
1300                continue => 'PLANNED'
1301            },
1302            plan => { continue => 'PLANNED' },
1303        },
1304        UNPLANNED => {
1305            test => { goto => 'UNPLANNED_AFTER_TEST' },
1306            plan => { goto => 'GOT_PLAN' },
1307        },
1308        UNPLANNED_AFTER_TEST => {
1309            test => { act  => sub { }, continue => 'UNPLANNED' },
1310            plan => { act  => sub { }, continue => 'UNPLANNED' },
1311            yaml => { goto => 'PLANNED' },
1312        },
1313    );
1314
1315    # Apply globals and defaults to state table
1316    for my $name ( keys %states ) {
1317
1318        # Merge with globals
1319        my $st = { %state_globals, %{ $states{$name} } };
1320
1321        # Add defaults
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};
1326                }
1327            }
1328        }
1329
1330        # Stuff back in table
1331        $states{$name} = $st;
1332    }
1333
1334    return \%states;
1335}
1336
1337=head3 C<get_select_handles>
1338
1339Get an a list of file handles which can be passed to C<select> to
1340determine the readiness of this parser.
1341
1342=cut
1343
1344sub get_select_handles { shift->_stream->get_select_handles }
1345
1346sub _grammar {
1347    my $self = shift;
1348    return $self->{_grammar} = shift if @_;
1349
1350    return $self->{_grammar} ||= $self->make_grammar(
1351        {   stream  => $self->_stream,
1352            parser  => $self,
1353            version => $self->version
1354        }
1355    );
1356}
1357
1358sub _iter {
1359    my $self        = shift;
1360    my $stream      = $self->_stream;
1361    my $grammar     = $self->_grammar;
1362    my $spool       = $self->_spool;
1363    my $state       = 'INIT';
1364    my $state_table = $self->_make_state_table;
1365
1366    $self->start_time( $self->get_time );
1367
1368    # Make next_state closure
1369    my $next_state = sub {
1370        my $token = shift;
1371        my $type  = $token->type;
1372        TRANS: {
1373            my $state_spec = $state_table->{$state}
1374              or die "Illegal state: $state";
1375
1376            if ( my $next = $state_spec->{$type} ) {
1377                if ( my $act = $next->{act} ) {
1378                    $act->($token);
1379                }
1380                if ( my $cont = $next->{continue} ) {
1381                    $state = $cont;
1382                    redo TRANS;
1383                }
1384                elsif ( my $goto = $next->{goto} ) {
1385                    $state = $goto;
1386                }
1387            }
1388            else {
1389                confess("Unhandled token type: $type\n");
1390            }
1391        }
1392        return $token;
1393    };
1394
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 );
1399        $self->_finish;
1400        return;
1401    };
1402
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 ) {
1407        return sub {
1408            my $result = eval { $grammar->tokenize };
1409            $self->_add_error($@) if $@;
1410
1411            if ( defined $result ) {
1412                $result = $next_state->($result);
1413
1414                if ( my $code = $self->_callback_for( $result->type ) ) {
1415                    $_->($result) for @{$code};
1416                }
1417                else {
1418                    $self->_make_callback( 'ELSE', $result );
1419                }
1420
1421                $self->_make_callback( 'ALL', $result );
1422
1423                # Echo TAP to spool file
1424                print {$spool} $result->raw, "\n" if $spool;
1425            }
1426            else {
1427                $result = $end_handler->();
1428                $self->_make_callback( 'EOF', $self )
1429                  unless defined $result;
1430            }
1431
1432            return $result;
1433        };
1434    }    # _has_callbacks
1435    else {
1436        return sub {
1437            my $result = eval { $grammar->tokenize };
1438            $self->_add_error($@) if $@;
1439
1440            if ( defined $result ) {
1441                $result = $next_state->($result);
1442
1443                # Echo TAP to spool file
1444                print {$spool} $result->raw, "\n" if $spool;
1445            }
1446            else {
1447                $result = $end_handler->();
1448            }
1449
1450            return $result;
1451        };
1452    }    # no callbacks
1453}
1454
1455sub _finish {
1456    my $self = shift;
1457
1458    $self->end_time( $self->get_time );
1459
1460    # Avoid leaks
1461    $self->_stream(undef);
1462    $self->_grammar(undef);
1463
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}
1470      if $] >= 5.006;
1471
1472    # sanity checks
1473    if ( !$self->plan ) {
1474        $self->_add_error('No plan found in TAP output');
1475    }
1476    else {
1477        $self->is_good_plan(1) unless defined $self->is_good_plan;
1478    }
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;
1483            $self->_add_error(
1484                "Bad plan.  You planned $planned tests but ran $ran.");
1485        }
1486    }
1487    if ( $self->tests_run != ( $self->passed + $self->failed ) ) {
1488
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!" );
1495    }
1496
1497    $self->is_good_plan(0) unless defined $self->is_good_plan;
1498    return $self;
1499}
1500
1501=head3 C<delete_spool>
1502
1503Delete and return the spool.
1504
1505  my $fh = $parser->delete_spool;
1506
1507=cut
1508
1509sub delete_spool {
1510    my $self = shift;
1511
1512    return delete $self->{_spool};
1513}
1514
1515##############################################################################
1516
1517=head1 CALLBACKS
1518
1519As mentioned earlier, a "callback" key may be added to the
1520C<TAP::Parser> constructor. If present, each callback corresponding to a
1521given result type will be called with the result as the argument if the
1522C<run> method is used. The callback is expected to be a subroutine
1523reference (or anonymous subroutine) which is invoked with the parser
1524result as its argument.
1525
1526 my %callbacks = (
1527     test    => \&test_callback,
1528     plan    => \&plan_callback,
1529     comment => \&comment_callback,
1530     bailout => \&bailout_callback,
1531     unknown => \&unknown_callback,
1532 );
1533
1534 my $aggregator = TAP::Parser::Aggregator->new;
1535 foreach my $file ( @test_files ) {
1536     my $parser = TAP::Parser->new(
1537         {
1538             source    => $file,
1539             callbacks => \%callbacks,
1540         }
1541     );
1542     $parser->run;
1543     $aggregator->add( $file, $parser );
1544 }
1545
1546Callbacks may also be added like this:
1547
1548 $parser->callback( test => \&test_callback );
1549 $parser->callback( plan => \&plan_callback );
1550
1551The following keys allowed for callbacks. These keys are case-sensitive.
1552
1553=over 4
1554
1555=item * C<test>
1556
1557Invoked if C<< $result->is_test >> returns true.
1558
1559=item * C<version>
1560
1561Invoked if C<< $result->is_version >> returns true.
1562
1563=item * C<plan>
1564
1565Invoked if C<< $result->is_plan >> returns true.
1566
1567=item * C<comment>
1568
1569Invoked if C<< $result->is_comment >> returns true.
1570
1571=item * C<bailout>
1572
1573Invoked if C<< $result->is_unknown >> returns true.
1574
1575=item * C<yaml>
1576
1577Invoked if C<< $result->is_yaml >> returns true.
1578
1579=item * C<unknown>
1580
1581Invoked if C<< $result->is_unknown >> returns true.
1582
1583=item * C<ELSE>
1584
1585If a result does not have a callback defined for it, this callback will
1586be invoked. Thus, if all of the previous result types are specified as
1587callbacks, this callback will I<never> be invoked.
1588
1589=item * C<ALL>
1590
1591This callback will always be invoked and this will happen for each
1592result after one of the above callbacks is invoked.  For example, if
1593L<Term::ANSIColor> is loaded, you could use the following to color your
1594test output:
1595
1596 my %callbacks = (
1597     test => sub {
1598         my $test = shift;
1599         if ( $test->is_ok && not $test->directive ) {
1600             # normal passing test
1601             print color 'green';
1602         }
1603         elsif ( !$test->is_ok ) {    # even if it's TODO
1604             print color 'white on_red';
1605         }
1606         elsif ( $test->has_skip ) {
1607             print color 'white on_blue';
1608
1609         }
1610         elsif ( $test->has_todo ) {
1611             print color 'white';
1612         }
1613     },
1614     ELSE => sub {
1615         # plan, comment, and so on (anything which isn't a test line)
1616         print color 'black on_white';
1617     },
1618     ALL => sub {
1619         # now print them
1620         print shift->as_string;
1621         print color 'reset';
1622         print "\n";
1623     },
1624 );
1625
1626=item * C<EOF>
1627
1628Invoked when there are no more lines to be parsed. Since there is no
1629accompanying L<TAP::Parser::Result> object the C<TAP::Parser> object is
1630passed instead.
1631
1632=back
1633
1634=head1 TAP GRAMMAR
1635
1636If you're looking for an EBNF grammar, see L<TAP::Parser::Grammar>.
1637
1638=head1 BACKWARDS COMPATABILITY
1639
1640The Perl-QA list attempted to ensure backwards compatability with
1641L<Test::Harness>.  However, there are some minor differences.
1642
1643=head2 Differences
1644
1645=over 4
1646
1647=item * TODO plans
1648
1649A little-known feature of L<Test::Harness> is that it supported TODO
1650lists in the plan:
1651
1652 1..2 todo 2
1653 ok 1 - We have liftoff
1654 not ok 2 - Anti-gravity device activated
1655
1656Under L<Test::Harness>, test number 2 would I<pass> because it was
1657listed as a TODO test on the plan line. However, we are not aware of
1658anyone actually using this feature and hard-coding test numbers is
1659discouraged because it's very easy to add a test and break the test
1660number sequence. This makes test suites very fragile. Instead, the
1661following should be used:
1662
1663 1..2
1664 ok 1 - We have liftoff
1665 not ok 2 - Anti-gravity device activated # TODO
1666
1667=item * 'Missing' tests
1668
1669It rarely happens, but sometimes a harness might encounter
1670'missing tests:
1671
1672 ok 1
1673 ok 2
1674 ok 15
1675 ok 16
1676 ok 17
1677
1678L<Test::Harness> would report tests 3-14 as having failed. For the
1679C<TAP::Parser>, these tests are not considered failed because they've
1680never run. They're reported as parse failures (tests out of sequence).
1681
1682=back
1683
1684=head1 SUBCLASSING
1685
1686If you find you need to provide custom functionality (as you would have using
1687L<Test::Harness::Straps>), you're in luck: C<TAP::Parser> and friends are
1688designed to be easily subclassed.
1689
1690Before you start, it's important to know a few things:
1691
1692=over 2
1693
1694=item 1
1695
1696All C<TAP::*> objects inherit from L<TAP::Object>.
1697
1698=item 2
1699
1700Most C<TAP::*> classes have a I<SUBCLASSING> section to guide you.
1701
1702=item 3
1703
1704Note that C<TAP::Parser> is designed to be the central 'maker' - ie: it is
1705responsible for creating new objects in the C<TAP::Parser::*> namespace.
1706
1707This makes it possible for you to have a single point of configuring what
1708subclasses should be used, which in turn means that in many cases you'll find
1709you only need to sub-class one of the parser's components.
1710
1711=item 4
1712
1713By subclassing, you may end up overriding undocumented methods.  That's not
1714a bad thing per se, but be forewarned that undocumented methods may change
1715without warning from one release to the next - we cannot guarantee backwards
1716compatability.  If any I<documented> method needs changing, it will be
1717deprecated first, and changed in a later release.
1718
1719=back
1720
1721=head2 Parser Components
1722
1723=head3 Sources
1724
1725A TAP parser consumes input from a I<source>.  There are currently two types
1726of sources: L<TAP::Parser::Source> for general non-perl commands, and
1727L<TAP::Parser::Source::Perl>.  You can subclass both of them.  You'll need to
1728customize your parser by setting the C<source_class> & C<perl_source_class>
1729parameters.  See L</new> for more details.
1730
1731If you need to customize the objects on creation, subclass L<TAP::Parser> and
1732override L</make_source> or L</make_perl_source>.
1733
1734=head3 Iterators
1735
1736A TAP parser uses I<iterators> to loop through the I<stream> provided by the
1737parser's I<source>.  There are quite a few types of Iterators available.
1738Choosing which class to use is the responsibility of the I<iterator factory>.
1739
1740To create your own iterators you'll have to subclass
1741L<TAP::Parser::IteratorFactory> and L<TAP::Parser::Iterator>.  Then you'll
1742need to customize the class used by your parser by setting the
1743C<iterator_factory_class> parameter.  See L</new> for more details.
1744
1745If you need to customize the objects on creation, subclass L<TAP::Parser> and
1746override L</make_iterator>.
1747
1748=head3 Results
1749
1750A TAP parser creates L<TAP::Parser::Result>s as it iterates through the
1751input I<stream>.  There are quite a few result types available; choosing
1752which class to use is the responsibility of the I<result factory>.
1753
1754To create your own result types you have two options:
1755
1756=over 2
1757
1758=item option 1
1759
1760Subclass L<TAP::Parser::Result> and register your new result type/class with
1761the default L<TAP::Parser::ResultFactory>.
1762
1763=item option 2
1764
1765Subclass L<TAP::Parser::ResultFactory> itself and implement your own
1766L<TAP::Parser::Result> creation logic.  Then you'll need to customize the
1767class used by your parser by setting the C<result_factory_class> parameter.
1768See L</new> for more details.
1769
1770=back
1771
1772If you need to customize the objects on creation, subclass L<TAP::Parser> and
1773override L</make_result>.
1774
1775=head3 Grammar
1776
1777L<TAP::Parser::Grammar> is the heart of the parser - it tokenizes the TAP
1778input I<stream> and produces results.  If you need to customize its behaviour
1779you should probably familiarize yourself with the source first.  Enough
1780lecturing.
1781
1782Subclass L<TAP::Parser::Grammar> and customize your parser by setting the
1783C<grammar_class> parameter.  See L</new> for more details.
1784
1785If you need to customize the objects on creation, subclass L<TAP::Parser> and
1786override L</make_grammar>
1787
1788=head1 ACKNOWLEDGEMENTS
1789
1790All of the following have helped. Bug reports, patches, (im)moral
1791support, or just words of encouragement have all been forthcoming.
1792
1793=over 4
1794
1795=item * Michael Schwern
1796
1797=item * Andy Lester
1798
1799=item * chromatic
1800
1801=item * GEOFFR
1802
1803=item * Shlomi Fish
1804
1805=item * Torsten Schoenfeld
1806
1807=item * Jerry Gay
1808
1809=item * Aristotle
1810
1811=item * Adam Kennedy
1812
1813=item * Yves Orton
1814
1815=item * Adrian Howard
1816
1817=item * Sean & Lil
1818
1819=item * Andreas J. Koenig
1820
1821=item * Florian Ragwitz
1822
1823=item * Corion
1824
1825=item * Mark Stosberg
1826
1827=item * Matt Kraai
1828
1829=item * David Wheeler
1830
1831=item * Alex Vandiver
1832
1833=back
1834
1835=head1 AUTHORS
1836
1837Curtis "Ovid" Poe <ovid@cpan.org>
1838
1839Andy Armstong <andy@hexten.net>
1840
1841Eric Wilhelm @ <ewilhelm at cpan dot org>
1842
1843Michael Peters <mpeters at plusthree dot com>
1844
1845Leif Eriksen <leif dot eriksen at bigpond dot com>
1846
1847Steve Purkis <spurkis@cpan.org>
1848
1849Nicholas Clark <nick@ccl4.org>
1850
1851=head1 BUGS
1852
1853Please report any bugs or feature requests to
1854C<bug-test-harness@rt.cpan.org>, or through the web interface at
1855L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Test-Harness>.
1856We will be notified, and then you'll automatically be notified of
1857progress on your bug as we make changes.
1858
1859Obviously, bugs which include patches are best. If you prefer, you can
1860patch against bleed by via anonymous checkout of the latest version:
1861
1862 svn checkout http://svn.hexten.net/tapx
1863
1864=head1 COPYRIGHT & LICENSE
1865
1866Copyright 2006-2008 Curtis "Ovid" Poe, all rights reserved.
1867
1868This program is free software; you can redistribute it and/or modify it
1869under the same terms as Perl itself.
1870
1871=cut
1872
18731;
1874