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