vcs.maemo.org Git - pkg-perl/blob - deb-src/libtest-harness-perl/libtest-harness-perl-3.12/lib/TAP/Harness.pm

   1 package TAP::Harness;
   2
   3 use strict;
   4 use Carp;
   5
   6 use File::Spec;
   7 use File::Path;
   8 use IO::Handle;
   9
  10 use TAP::Base;
  11 use TAP::Parser;
  12 use TAP::Parser::Aggregator;
  13 use TAP::Parser::Multiplexer;
  14 use TAP::Parser::Scheduler;
  15
  16 use vars qw($VERSION @ISA);
  17
  18 @ISA = qw(TAP::Base);
  19
  20 =head1 NAME
  21
  22 TAP::Harness - Run test scripts with statistics
  23
  24 =head1 VERSION
  25
  26 Version 3.12
  27
  28 =cut
  29
  30 $VERSION = '3.12';
  31
  32 $ENV{HARNESS_ACTIVE}  = 1;
  33 $ENV{HARNESS_VERSION} = $VERSION;
  34
  35 END {
  36
  37     # For VMS.
  38     delete $ENV{HARNESS_ACTIVE};
  39     delete $ENV{HARNESS_VERSION};
  40 }
  41
  42 =head1 DESCRIPTION
  43
  44 This is a simple test harness which allows tests to be run and results
  45 automatically aggregated and output to STDOUT.
  46
  47 =head1 SYNOPSIS
  48
  49  use TAP::Harness;
  50  my $harness = TAP::Harness->new( \%args );
  51  $harness->runtests(@tests);
  52
  53 =cut
  54
  55 my %VALIDATION_FOR;
  56 my @FORMATTER_ARGS;
  57
  58 sub _error {
  59     my $self = shift;
  60     return $self->{error} unless @_;
  61     $self->{error} = shift;
  62 }
  63
  64 BEGIN {
  65
  66     @FORMATTER_ARGS = qw(
  67       directives verbosity timer failures errors stdout color
  68     );
  69
  70     %VALIDATION_FOR = (
  71         lib => sub {
  72             my ( $self, $libs ) = @_;
  73             $libs = [$libs] unless 'ARRAY' eq ref $libs;
  74
  75             return [ map {"-I$_"} @$libs ];
  76         },
  77         switches        => sub { shift; shift },
  78         exec            => sub { shift; shift },
  79         merge           => sub { shift; shift },
  80         formatter_class => sub { shift; shift },
  81         formatter       => sub { shift; shift },
  82         jobs            => sub { shift; shift },
  83         fork            => sub { shift; shift },
  84         test_args       => sub { shift; shift },
  85         ignore_exit     => sub { shift; shift },
  86         rules           => sub { shift; shift },
  87     );
  88
  89     for my $method ( sort keys %VALIDATION_FOR ) {
  90         no strict 'refs';
  91         if ( $method eq 'lib' || $method eq 'switches' ) {
  92             *{$method} = sub {
  93                 my $self = shift;
  94                 unless (@_) {
  95                     $self->{$method} ||= [];
  96                     return wantarray
  97                       ? @{ $self->{$method} }
  98                       : $self->{$method};
  99                 }
 100                 $self->_croak("Too many arguments to method '$method'")
 101                   if @_ > 1;
 102                 my $args = shift;
 103                 $args = [$args] unless ref $args;
 104                 $self->{$method} = $args;
 105                 return $self;
 106             };
 107         }
 108         else {
 109             *{$method} = sub {
 110                 my $self = shift;
 111                 return $self->{$method} unless @_;
 112                 $self->{$method} = shift;
 113             };
 114         }
 115     }
 116
 117     for my $method (@FORMATTER_ARGS) {
 118         no strict 'refs';
 119         *{$method} = sub {
 120             my $self = shift;
 121             return $self->formatter->$method(@_);
 122         };
 123     }
 124 }
 125
 126 ##############################################################################
 127
 128 =head1 METHODS
 129
 130 =head2 Class Methods
 131
 132 =head3 C<new>
 133
 134  my %args = (
 135     verbosity => 1,
 136     lib     => [ 'lib', 'blib/lib' ],
 137  )
 138  my $harness = TAP::Harness->new( \%args );
 139
 140 The constructor returns a new C<TAP::Harness> object.  It accepts an optional
 141 hashref whose allowed keys are:
 142
 143 =over 4
 144
 145 =item * C<verbosity>
 146
 147 Set the verbosity level:
 148
 149      1   verbose        Print individual test results to STDOUT.
 150      0   normal
 151     -1   quiet          Suppress some test output (mostly failures
 152                         while tests are running).
 153     -2   really quiet   Suppress everything but the tests summary.
 154
 155 =item * C<timer>
 156
 157 Append run time for each test to output. Uses L<Time::HiRes> if available.
 158
 159 =item * C<failures>
 160
 161 Only show test failures (this is a no-op if C<verbose> is selected).
 162
 163 =item * C<lib>
 164
 165 Accepts a scalar value or array ref of scalar values indicating which paths to
 166 allowed libraries should be included if Perl tests are executed.  Naturally,
 167 this only makes sense in the context of tests written in Perl.
 168
 169 =item * C<switches>
 170
 171 Accepts a scalar value or array ref of scalar values indicating which switches
 172 should be included if Perl tests are executed.  Naturally, this only makes
 173 sense in the context of tests written in Perl.
 174
 175 =item * C<test_args>
 176
 177 A reference to an C<@INC> style array of arguments to be passed to each
 178 test program.
 179
 180 =item * C<color>
 181
 182 Attempt to produce color output.
 183
 184 =item * C<exec>
 185
 186 Typically, Perl tests are run through this.  However, anything which spits out
 187 TAP is fine.  You can use this argument to specify the name of the program
 188 (and optional switches) to run your tests with:
 189
 190   exec => ['/usr/bin/ruby', '-w']
 191
 192 You can also pass a subroutine reference in order to determine and return the
 193 proper program to run based on a given test script. The subroutine reference
 194 should expect the TAP::Harness object itself as the first argument, and the
 195 file name as the second argument. It should return an array reference
 196 containing the command to be run and including the test file name. It can also
 197 simply return C<undef>, in which case TAP::Harness will fall back on executing
 198 the test script in Perl:
 199
 200   exec => sub {
 201       my ( $harness, $test_file ) = @_;
 202       # Let Perl tests run.
 203       return undef if $test_file =~ /[.]t$/;
 204       return [ qw( /usr/bin/ruby -w ), $test_file ] if $test_file =~ /[.]rb$/;
 205   }
 206
 207 =item * C<merge>
 208
 209 If C<merge> is true the harness will create parsers that merge STDOUT
 210 and STDERR together for any processes they start.
 211
 212 =item * C<formatter_class>
 213
 214 The name of the class to use to format output. The default is
 215 L<TAP::Formatter::Console>.
 216
 217 =item * C<formatter>
 218
 219 If set C<formatter> must be an object that is capable of formatting the
 220 TAP output. See L<TAP::Formatter::Console> for an example.
 221
 222 =item * C<errors>
 223
 224 If parse errors are found in the TAP output, a note of this will be made
 225 in the summary report.  To see all of the parse errors, set this argument to
 226 true:
 227
 228   errors => 1
 229
 230 =item * C<directives>
 231
 232 If set to a true value, only test results with directives will be displayed.
 233 This overrides other settings such as C<verbose> or C<failures>.
 234
 235 =item * C<ignore_exit>
 236
 237 If set to a true value instruct C<TAP::Parser> to ignore exit and wait
 238 status from test scripts.
 239
 240 =item * C<rules>
 241
 242 A reference to a hash of rules that control which tests may be
 243 executed in parallel. This is an experimental feature and the
 244 interface may change.
 245
 246     $harness->rules(
 247         {   par => [
 248                 { seq => '../ext/DB_File/t/*' },
 249                 { seq => '../ext/IO_Compress_Zlib/t/*' },
 250                 { seq => '../lib/CPANPLUS/*' },
 251                 { seq => '../lib/ExtUtils/t/*' },
 252                 '*'
 253             ]
 254         }
 255     );
 256
 257 =item * C<stdout>
 258
 259 A filehandle for catching standard output.
 260
 261 =back
 262
 263 Any keys for which the value is C<undef> will be ignored.
 264
 265 =cut
 266
 267 # new supplied by TAP::Base
 268
 269 {
 270     my @legal_callback = qw(
 271       parser_args
 272       made_parser
 273       before_runtests
 274       after_runtests
 275       after_test
 276     );
 277
 278     sub _initialize {
 279         my ( $self, $arg_for ) = @_;
 280         $arg_for ||= {};
 281
 282         $self->SUPER::_initialize( $arg_for, \@legal_callback );
 283         my %arg_for = %$arg_for;    # force a shallow copy
 284
 285         for my $name ( sort keys %VALIDATION_FOR ) {
 286             my $property = delete $arg_for{$name};
 287             if ( defined $property ) {
 288                 my $validate = $VALIDATION_FOR{$name};
 289
 290                 my $value = $self->$validate($property);
 291                 if ( $self->_error ) {
 292                     $self->_croak;
 293                 }
 294                 $self->$name($value);
 295             }
 296         }
 297
 298         $self->jobs(1) unless defined $self->jobs;
 299
 300         unless ( $self->formatter ) {
 301
 302             $self->formatter_class( my $class = $self->formatter_class
 303                   || 'TAP::Formatter::Console' );
 304
 305             croak "Bad module name $class"
 306               unless $class =~ /^ \w+ (?: :: \w+ ) *$/x;
 307
 308             eval "require $class";
 309             $self->_croak("Can't load $class") if $@;
 310
 311             # This is a little bodge to preserve legacy behaviour. It's
 312             # pretty horrible that we know which args are destined for
 313             # the formatter.
 314             my %formatter_args = ( jobs => $self->jobs );
 315             for my $name (@FORMATTER_ARGS) {
 316                 if ( defined( my $property = delete $arg_for{$name} ) ) {
 317                     $formatter_args{$name} = $property;
 318                 }
 319             }
 320
 321             $self->formatter( $class->new( \%formatter_args ) );
 322         }
 323
 324         if ( my @props = sort keys %arg_for ) {
 325             $self->_croak("Unknown arguments to TAP::Harness::new (@props)");
 326         }
 327
 328         return $self;
 329     }
 330 }
 331
 332 ##############################################################################
 333
 334 =head2 Instance Methods
 335
 336 =head3 C<runtests>
 337
 338     $harness->runtests(@tests);
 339
 340 Accepts and array of C<@tests> to be run.  This should generally be the names
 341 of test files, but this is not required.  Each element in C<@tests> will be
 342 passed to C<TAP::Parser::new()> as a C<source>.  See L<TAP::Parser> for more
 343 information.
 344
 345 It is possible to provide aliases that will be displayed in place of the
 346 test name by supplying the test as a reference to an array containing
 347 C<< [ $test, $alias ] >>:
 348
 349     $harness->runtests( [ 't/foo.t', 'Foo Once' ],
 350                         [ 't/foo.t', 'Foo Twice' ] );
 351
 352 Normally it is an error to attempt to run the same test twice. Aliases
 353 allow you to overcome this limitation by giving each run of the test a
 354 unique name.
 355
 356 Tests will be run in the order found.
 357
 358 If the environment variable C<PERL_TEST_HARNESS_DUMP_TAP> is defined it
 359 should name a directory into which a copy of the raw TAP for each test
 360 will be written. TAP is written to files named for each test.
 361 Subdirectories will be created as needed.
 362
 363 Returns a L<TAP::Parser::Aggregator> containing the test results.
 364
 365 =cut
 366
 367 sub runtests {
 368     my ( $self, @tests ) = @_;
 369
 370     my $aggregate = TAP::Parser::Aggregator->new;
 371
 372     $self->_make_callback( 'before_runtests', $aggregate );
 373     $aggregate->start;
 374     $self->aggregate_tests( $aggregate, @tests );
 375     $aggregate->stop;
 376     $self->summary($aggregate);
 377     $self->_make_callback( 'after_runtests', $aggregate );
 378
 379     return $aggregate;
 380 }
 381
 382 =head3 C<summary>
 383
 384 Output the summary for a TAP::Parser::Aggregator.
 385
 386 =cut
 387
 388 sub summary {
 389     my ( $self, $aggregate ) = @_;
 390     $self->formatter->summary($aggregate);
 391 }
 392
 393 sub _after_test {
 394     my ( $self, $aggregate, $job, $parser ) = @_;
 395
 396     $self->_make_callback( 'after_test', $job->as_array_ref, $parser );
 397     $aggregate->add( $job->description, $parser );
 398 }
 399
 400 sub _aggregate_forked {
 401     my ( $self, $aggregate, $scheduler ) = @_;
 402
 403     eval { require Parallel::Iterator };
 404
 405     croak "Parallel::Iterator required for --fork option ($@)"
 406       if $@;
 407
 408     my $iter = Parallel::Iterator::iterate(
 409         { workers => $self->jobs || 0 },
 410         sub {
 411             my $job = shift;
 412
 413             return if $job->is_spinner;
 414
 415             my ( $parser, $session ) = $self->make_parser($job);
 416
 417             while ( defined( my $result = $parser->next ) ) {
 418                 exit 1 if $result->is_bailout;
 419             }
 420
 421             $self->finish_parser( $parser, $session );
 422
 423             # Can't serialise coderefs...
 424             delete $parser->{_iter};
 425             delete $parser->{_stream};
 426             delete $parser->{_grammar};
 427             return $parser;
 428         },
 429         sub { $scheduler->get_job }
 430     );
 431
 432     while ( my ( $job, $parser ) = $iter->() ) {
 433         next if $job->is_spinner;
 434         $self->_after_test( $aggregate, $job, $parser );
 435         $job->finish;
 436     }
 437
 438     return;
 439 }
 440
 441 sub _aggregate_parallel {
 442     my ( $self, $aggregate, $scheduler ) = @_;
 443
 444     my $jobs = $self->jobs;
 445     my $mux  = TAP::Parser::Multiplexer->new;
 446
 447     RESULT: {
 448
 449         # Keep multiplexer topped up
 450         FILL:
 451         while ( $mux->parsers < $jobs ) {
 452             my $job = $scheduler->get_job;
 453
 454             # If we hit a spinner stop filling and start running.
 455             last FILL if !defined $job || $job->is_spinner;
 456
 457             my ( $parser, $session ) = $self->make_parser($job);
 458             $mux->add( $parser, [ $session, $job ] );
 459         }
 460
 461         if ( my ( $parser, $stash, $result ) = $mux->next ) {
 462             my ( $session, $job ) = @$stash;
 463             if ( defined $result ) {
 464                 $session->result($result);
 465                 exit 1 if $result->is_bailout;
 466             }
 467             else {
 468
 469                 # End of parser. Automatically removed from the mux.
 470                 $self->finish_parser( $parser, $session );
 471                 $self->_after_test( $aggregate, $job, $parser );
 472                 $job->finish;
 473             }
 474             redo RESULT;
 475         }
 476     }
 477
 478     return;
 479 }
 480
 481 sub _aggregate_single {
 482     my ( $self, $aggregate, $scheduler ) = @_;
 483
 484     JOB:
 485     while ( my $job = $scheduler->get_job ) {
 486         next JOB if $job->is_spinner;
 487
 488         my ( $parser, $session ) = $self->make_parser($job);
 489
 490         while ( defined( my $result = $parser->next ) ) {
 491             $session->result($result);
 492             if ( $result->is_bailout ) {
 493
 494                 # Keep reading until input is exhausted in the hope
 495                 # of allowing any pending diagnostics to show up.
 496                 1 while $parser->next;
 497                 exit 1;
 498             }
 499         }
 500
 501         $self->finish_parser( $parser, $session );
 502         $self->_after_test( $aggregate, $job, $parser );
 503         $job->finish;
 504     }
 505
 506     return;
 507 }
 508
 509 =head3 C<aggregate_tests>
 510
 511   $harness->aggregate_tests( $aggregate, @tests );
 512
 513 Run the named tests and display a summary of result. Tests will be run
 514 in the order found.
 515
 516 Test results will be added to the supplied L<TAP::Parser::Aggregator>.
 517 C<aggregate_tests> may be called multiple times to run several sets of
 518 tests. Multiple C<Test::Harness> instances may be used to pass results
 519 to a single aggregator so that different parts of a complex test suite
 520 may be run using different C<TAP::Harness> settings. This is useful, for
 521 example, in the case where some tests should run in parallel but others
 522 are unsuitable for parallel execution.
 523
 524     my $formatter = TAP::Formatter::Console->new;
 525     my $ser_harness = TAP::Harness->new( { formatter => $formatter } );
 526     my $par_harness = TAP::Harness->new( { formatter => $formatter,
 527                                            jobs => 9 } );
 528     my $aggregator = TAP::Parser::Aggregator->new;
 529
 530     $aggregator->start();
 531     $ser_harness->aggregate_tests( $aggregator, @ser_tests );
 532     $par_harness->aggregate_tests( $aggregator, @par_tests );
 533     $aggregator->stop();
 534     $formatter->summary( $aggregator );
 535
 536 Note that for simpler testing requirements it will often be possible to
 537 replace the above code with a single call to C<runtests>.
 538
 539 Each elements of the @tests array is either
 540
 541 =over
 542
 543 =item * the file name of a test script to run
 544
 545 =item * a reference to a [ file name, display name ] array
 546
 547 =back
 548
 549 When you supply a separate display name it becomes possible to run a
 550 test more than once; the display name is effectively the alias by which
 551 the test is known inside the harness. The harness doesn't care if it
 552 runs the same script more than once when each invocation uses a
 553 different name.
 554
 555 =cut
 556
 557 sub aggregate_tests {
 558     my ( $self, $aggregate, @tests ) = @_;
 559
 560     my $jobs      = $self->jobs;
 561     my $scheduler = $self->make_scheduler(@tests);
 562
 563     # #12458
 564     local $ENV{HARNESS_IS_VERBOSE} = 1
 565       if $self->formatter->verbosity > 0;
 566
 567     # Formatter gets only names.
 568     $self->formatter->prepare( map { $_->description } $scheduler->get_all );
 569
 570     if ( $self->jobs > 1 ) {
 571         if ( $self->fork ) {
 572             $self->_aggregate_forked( $aggregate, $scheduler );
 573         }
 574         else {
 575             $self->_aggregate_parallel( $aggregate, $scheduler );
 576         }
 577     }
 578     else {
 579         $self->_aggregate_single( $aggregate, $scheduler );
 580     }
 581
 582     return;
 583 }
 584
 585 sub _add_descriptions {
 586     my $self = shift;
 587
 588     # First transformation: turn scalars into single element arrays
 589     my @tests = map { 'ARRAY' eq ref $_ ? $_ : [$_] } @_;
 590
 591     # Work out how many different extensions we have
 592     my %ext;
 593     for my $test (@tests) {
 594         $ext{$1}++ if $test->[0] =~ /\.(\w+)$/;
 595     }
 596
 597     for my $test (@tests) {
 598         if ( @$test == 1 ) {
 599             $test->[1] = $test->[0];
 600             $test->[1] =~ s/\.\w+$//
 601               if keys %ext <= 1;
 602         }
 603     }
 604     return @tests;
 605 }
 606
 607 =head3 C<make_scheduler>
 608
 609 Called by the harness when it needs to create a
 610 L<TAP::Parser::Scheduler>. Override in a subclass to provide an
 611 alternative scheduler. C<make_scheduler> is passed the list of tests
 612 that was passed to C<aggregate_tests>.
 613
 614 =cut
 615
 616 sub make_scheduler {
 617     my ( $self, @tests ) = @_;
 618     return TAP::Parser::Scheduler->new(
 619         tests => [ $self->_add_descriptions(@tests) ],
 620         rules => $self->rules
 621     );
 622 }
 623
 624 =head3 C<jobs>
 625
 626 Returns the number of concurrent test runs the harness is handling. For the default
 627 harness this value is always 1. A parallel harness such as L<TAP::Harness::Parallel>
 628 will override this to return the number of jobs it is handling.
 629
 630 =head3 C<fork>
 631
 632 If true the harness will attempt to fork and run the parser for each
 633 test in a separate process. Currently this option requires
 634 L<Parallel::Iterator> to be installed.
 635
 636 =cut
 637
 638 ##############################################################################
 639
 640 =head1 SUBCLASSING
 641
 642 C<TAP::Harness> is designed to be (mostly) easy to subclass.  If you don't
 643 like how a particular feature functions, just override the desired methods.
 644
 645 =head2 Methods
 646
 647 TODO: This is out of date
 648
 649 The following methods are ones you may wish to override if you want to
 650 subclass C<TAP::Harness>.
 651
 652 =head3 C<summary>
 653
 654   $harness->summary( \%args );
 655
 656 C<summary> prints the summary report after all tests are run.  The argument is
 657 a hashref with the following keys:
 658
 659 =over 4
 660
 661 =item * C<start>
 662
 663 This is created with C<< Benchmark->new >> and it the time the tests started.
 664 You can print a useful summary time, if desired, with:
 665
 666   $self->output(timestr( timediff( Benchmark->new, $start_time ), 'nop' ));
 667
 668 =item * C<tests>
 669
 670 This is an array reference of all test names.  To get the L<TAP::Parser>
 671 object for individual tests:
 672
 673  my $aggregate = $args->{aggregate};
 674  my $tests     = $args->{tests};
 675
 676  for my $name ( @$tests ) {
 677      my ($parser) = $aggregate->parsers($test);
 678      ... do something with $parser
 679  }
 680
 681 This is a bit clunky and will be cleaned up in a later release.
 682
 683 =back
 684
 685 =cut
 686
 687 sub _get_parser_args {
 688     my ( $self, $job ) = @_;
 689     my $test_prog = $job->filename;
 690     my %args      = ();
 691     my @switches;
 692     @switches = $self->lib if $self->lib;
 693     push @switches => $self->switches if $self->switches;
 694     $args{switches}    = \@switches;
 695     $args{spool}       = $self->_open_spool($test_prog);
 696     $args{merge}       = $self->merge;
 697     $args{ignore_exit} = $self->ignore_exit;
 698
 699     if ( my $exec = $self->exec ) {
 700         $args{exec}
 701           = ref $exec eq 'CODE'
 702           ? $exec->( $self, $test_prog )
 703           : [ @$exec, $test_prog ];
 704         $args{source} = $test_prog unless $args{exec};
 705     }
 706     else {
 707         $args{source} = $test_prog;
 708     }
 709
 710     if ( defined( my $test_args = $self->test_args ) ) {
 711         $args{test_args} = $test_args;
 712     }
 713
 714     return \%args;
 715 }
 716
 717 =head3 C<make_parser>
 718
 719 Make a new parser and display formatter session. Typically used and/or
 720 overridden in subclasses.
 721
 722     my ( $parser, $session ) = $harness->make_parser;
 723
 724
 725 =cut
 726
 727 sub make_parser {
 728     my ( $self, $job ) = @_;
 729
 730     my $args = $self->_get_parser_args($job);
 731     $self->_make_callback( 'parser_args', $args, $job->as_array_ref );
 732     my $parser = TAP::Parser->new($args);
 733
 734     $self->_make_callback( 'made_parser', $parser, $job->as_array_ref );
 735     my $session = $self->formatter->open_test( $job->description, $parser );
 736
 737     return ( $parser, $session );
 738 }
 739
 740 =head3 C<finish_parser>
 741
 742 Terminate use of a parser. Typically used and/or overridden in
 743 subclasses. The parser isn't destroyed as a result of this.
 744
 745 =cut
 746
 747 sub finish_parser {
 748     my ( $self, $parser, $session ) = @_;
 749
 750     $session->close_test;
 751     $self->_close_spool($parser);
 752
 753     return $parser;
 754 }
 755
 756 sub _open_spool {
 757     my $self = shift;
 758     my $test = shift;
 759
 760     if ( my $spool_dir = $ENV{PERL_TEST_HARNESS_DUMP_TAP} ) {
 761
 762         my $spool = File::Spec->catfile( $spool_dir, $test );
 763
 764         # Make the directory
 765         my ( $vol, $dir, undef ) = File::Spec->splitpath($spool);
 766         my $path = File::Spec->catpath( $vol, $dir, '' );
 767         eval { mkpath($path) };
 768         $self->_croak($@) if $@;
 769
 770         my $spool_handle = IO::Handle->new;
 771         open( $spool_handle, ">$spool" )
 772           or $self->_croak(" Can't write $spool ( $! ) ");
 773
 774         return $spool_handle;
 775     }
 776
 777     return;
 778 }
 779
 780 sub _close_spool {
 781     my $self = shift;
 782     my ($parser) = @_;
 783
 784     if ( my $spool_handle = $parser->delete_spool ) {
 785         close($spool_handle)
 786           or $self->_croak(" Error closing TAP spool file( $! ) \n ");
 787     }
 788
 789     return;
 790 }
 791
 792 sub _croak {
 793     my ( $self, $message ) = @_;
 794     unless ($message) {
 795         $message = $self->_error;
 796     }
 797     $self->SUPER::_croak($message);
 798
 799     return;
 800 }
 801
 802 =head1 REPLACING
 803
 804 If you like the C<prove> utility and L<TAP::Parser> but you want your
 805 own harness, all you need to do is write one and provide C<new> and
 806 C<runtests> methods. Then you can use the C<prove> utility like so:
 807
 808  prove --harness My::Test::Harness
 809
 810 Note that while C<prove> accepts a list of tests (or things to be
 811 tested), C<new> has a fairly rich set of arguments. You'll probably want
 812 to read over this code carefully to see how all of them are being used.
 813
 814 =head1 SEE ALSO
 815
 816 L<Test::Harness>
 817
 818 =cut
 819
 820 1;
 821
 822 # vim:ts=4:sw=4:et:sta