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