ext/Test/Harness/lib/TAP/Parser.pm

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