7 use constant IS_WIN32 => ( $^O =~ /^(MS)?Win32$/ );
8 use constant IS_VMS => ( $^O eq 'VMS' );
11 use TAP::Parser::Aggregator ();
12 use TAP::Parser::Source::Perl ();
14 use TAP::Parser::Utils qw( split_shell );
19 # TODO: Emulate at least some of these
22 @ISA @EXPORT @EXPORT_OK
23 $Verbose $Switches $Debug
24 $verbose $switches $debug
37 eval q{use Time::HiRes 'time'};
38 $has_time_hires = !$@;
43 Test::Harness - Run Perl standard test scripts with statistics
53 # Backwards compatibility for exportable variable names.
55 *switches = *Switches;
58 $ENV{HARNESS_ACTIVE} = 1;
59 $ENV{HARNESS_VERSION} = $VERSION;
64 delete $ENV{HARNESS_ACTIVE};
65 delete $ENV{HARNESS_VERSION};
69 @EXPORT = qw(&runtests);
70 @EXPORT_OK = qw(&execute_tests $verbose $switches);
72 $Verbose = $ENV{HARNESS_VERBOSE} || 0;
73 $Debug = $ENV{HARNESS_DEBUG} || 0;
75 $Columns = $ENV{HARNESS_COLUMNS} || $ENV{COLUMNS} || 80;
76 $Columns--; # Some shells have trouble with a full line of text.
77 $Timer = $ENV{HARNESS_TIMER} || 0;
78 $Color = $ENV{HARNESS_COLOR} || 0;
79 $IgnoreExit = $ENV{HARNESS_IGNORE_EXIT} || 0;
85 runtests(@test_files);
89 Although, for historical reasons, the L<Test::Harness> distribution
90 takes its name from this module it now exists only to provide
91 L<TAP::Harness> with an interface that is somewhat backwards compatible
92 with L<Test::Harness> 2.xx. If you're writing new code consider using
93 L<TAP::Harness> directly instead.
95 Emulation is provided for C<runtests> and C<execute_tests> but the
96 pluggable 'Straps' interface that previous versions of L<Test::Harness>
97 supported is not reproduced here. Straps is now available as a stand
98 alone module: L<Test::Harness::Straps>.
100 See L<TAP::Parser>, L<TAP::Harness> for the main documentation for this
105 The following functions are available.
107 =head2 runtests( @test_files )
109 This runs all the given I<@test_files> and divines whether they passed
110 or failed based on their output to STDOUT (details above). It prints
111 out each individual test which failed along with a summary report and
112 a how long it all took.
114 It returns true if everything was ok. Otherwise it will C<die()> with
115 one of the messages in the DIAGNOSTICS section.
121 return TAP::Parser::Source::Perl->get_taint(
122 TAP::Parser::Source::Perl->shebang($test) );
126 my ( $harness, $aggregate, @tests ) = @_;
128 # Don't propagate to our children
129 local $ENV{HARNESS_OPTIONS};
133 # Jiggery pokery doesn't appear to work on VMS - so disable it
134 # pending investigation.
135 _aggregate_tests( $harness, $aggregate, @tests );
138 my $path_sep = $Config{path_sep};
139 my $path_pat = qr{$path_sep};
140 my @extra_inc = _filtered_inc();
142 # Supply -I switches in taint mode
145 my ( $args, $test ) = @_;
146 if ( _has_taint( $test->[0] ) ) {
147 push @{ $args->{switches} }, map {"-I$_"} _filtered_inc();
152 my $previous = $ENV{PERL5LIB};
153 local $ENV{PERL5LIB};
156 push @extra_inc, split( $path_pat, $previous );
160 $ENV{PERL5LIB} = join( $path_sep, @extra_inc );
163 _aggregate_tests( $harness, $aggregate, @tests );
167 sub _aggregate_tests {
168 my ( $harness, $aggregate, @tests ) = @_;
170 $harness->aggregate_tests( $aggregate, @tests );
181 my $harness = _new_harness();
182 my $aggregate = TAP::Parser::Aggregator->new();
184 _aggregate( $harness, $aggregate, @tests );
186 $harness->formatter->summary($aggregate);
188 my $total = $aggregate->total;
189 my $passed = $aggregate->passed;
190 my $failed = $aggregate->failed;
192 my @parsers = $aggregate->parsers;
195 for my $parser (@parsers) {
196 $num_bad++ if $parser->has_problems;
200 "Failed %d/%d test programs. %d/%d subtests failed.\n",
201 $num_bad, scalar @parsers, $failed, $total
205 return $total && $total == $passed;
209 my @list = sort { $a <=> $b } @_;
211 my $count = scalar @list;
214 while ( $pos < $count ) {
216 $end++ while $end < $count && $list[$end] <= $list[ $end - 1 ] + 1;
217 push @ranges, ( $end == $pos + 1 )
219 : join( '-', $list[$pos], $list[ $end - 1 ] );
223 return join( ' ', @ranges );
227 my $sub_args = shift || {};
229 my ( @lib, @switches );
230 for my $opt ( split_shell( $Switches, $ENV{HARNESS_PERL_SWITCHES} ) ) {
231 if ( $opt =~ /^ -I (.*) $ /x ) {
235 push @switches, $opt;
239 # Do things the old way on VMS...
240 push @lib, _filtered_inc() if IS_VMS;
242 # If $Verbose isn't numeric default to 1. This helps core.
243 my $verbosity = ( $Verbose ? ( $Verbose !~ /\d/ ) ? 1 : $Verbose : 0 );
247 directives => $Directives,
249 switches => \@switches,
251 verbosity => $verbosity,
252 ignore_exit => $IgnoreExit,
255 $args->{stdout} = $sub_args->{out}
256 if exists $sub_args->{out};
258 if ( defined( my $env_opt = $ENV{HARNESS_OPTIONS} ) ) {
259 for my $opt ( split /:/, $env_opt ) {
260 if ( $opt =~ /^j(\d*)$/ ) {
261 $args->{jobs} = $1 || 9;
263 elsif ( $opt eq 'f' ) {
266 elsif ( $opt eq 'c' ) {
270 die "Unknown HARNESS_OPTIONS item: $opt\n";
275 return TAP::Harness->new($args);
278 # Get the parts of @INC which are changed from the stock list AND
279 # preserve reordering of stock directories.
281 my @inc = grep { !ref } @INC; #28567
285 # VMS has a 255-byte limit on the length of %ENV entries, so
286 # toss the ones that involve perl_root, the install location
287 @inc = grep !/perl_root/i, @inc;
292 # Lose any trailing backslashes in the Win32 paths
293 s/[\\\/+]$// foreach @inc;
296 my @default_inc = _default_inc();
301 next if $seen{$dir}++;
303 if ( $dir eq ( $default_inc[0] || '' ) ) {
310 shift @default_inc while @default_inc and $seen{ $default_inc[0] };
318 # Cache this to avoid repeatedly shelling out to Perl.
323 my $perl = $ENV{HARNESS_PERL} || $^X;
324 chomp( @inc = `$perl -le "print join qq[\\n], \@INC"` );
329 sub _check_sequence {
332 while ( my $next = shift @list ) {
333 return if defined $prev && $next <= $prev;
343 my $harness = _new_harness( \%args );
344 my $aggregate = TAP::Parser::Aggregator->new();
360 # Install a callback so we get to see any plans the
368 if ( $plan->directive eq 'SKIP' ) {
376 _aggregate( $harness, $aggregate, @{ $args{tests} } );
378 $tot{bench} = $aggregate->elapsed;
379 my @tests = $aggregate->descriptions;
381 # TODO: Work out the circumstances under which the files
382 # and tests totals can differ.
383 $tot{files} = $tot{tests} = scalar @tests;
385 my %failedtests = ();
386 my %todo_passed = ();
388 for my $test (@tests) {
389 my ($parser) = $aggregate->parsers($test);
391 my @failed = $parser->failed;
393 my $wstat = $parser->wait;
394 my $estat = $parser->exit;
395 my $planned = $parser->tests_planned;
396 my @errors = $parser->parse_errors;
397 my $passed = $parser->passed;
398 my $actual_passed = $parser->actual_passed;
400 my $ok_seq = _check_sequence( $parser->actual_passed );
402 # Duplicate exit, wait status semantics of old version
403 $estat ||= '' unless $wstat;
406 $tot{max} += ( $planned || 0 );
407 $tot{bonus} += $parser->todo_passed;
408 $tot{ok} += $passed > $actual_passed ? $passed : $actual_passed;
409 $tot{sub_skipped} += $parser->skipped;
410 $tot{todo} += $parser->todo;
412 if ( @failed || $estat || @errors ) {
415 my $huh_planned = $planned ? undef : '??';
416 my $huh_errors = $ok_seq ? undef : '??';
418 $failedtests{$test} = {
419 'canon' => $huh_planned
424 'failed' => $huh_planned
427 'max' => $huh_planned || $planned,
436 my @todo = $parser->todo_passed;
438 $todo_passed{$test} = {
439 'canon' => _canon(@todo),
441 'failed' => scalar @todo,
442 'max' => scalar $parser->todo,
449 return ( \%tot, \%failedtests, \%todo_passed );
452 =head2 execute_tests( tests => \@test_files, out => \*FH )
454 Runs all the given C<@test_files> (just like C<runtests()>) but
455 doesn't generate the final report. During testing, progress
456 information will be written to the currently selected output
457 filehandle (usually C<STDOUT>), or to the filehandle given by the
458 C<out> parameter. The I<out> is optional.
460 Returns a list of two values, C<$total> and C<$failed>, describing the
461 results. C<$total> is a hash ref summary of all the tests run. Its
462 keys and values are this:
464 bonus Number of individual todo tests unexpectedly passed
465 max Number of individual tests ran
466 ok Number of individual tests passed
467 sub_skipped Number of individual tests skipped
468 todo Number of individual todo tests
470 files Number of test files ran
471 good Number of test files passed
472 bad Number of test files failed
473 tests Number of test files originally given
474 skipped Number of test files skipped
476 If C<< $total->{bad} == 0 >> and C<< $total->{max} > 0 >>, you've
477 got a successful test.
479 C<$failed> is a hash ref of all the test scripts that failed. Each key
480 is the name of a test script, each value is another hash representing
481 how that script failed. Its keys are these:
483 name Name of the test which failed
484 estat Script's exit value
485 wstat Script's wait status
486 max Number of individual tests
487 failed Number which failed
488 canon List of tests which failed (as string).
490 C<$failed> should be empty if everything passed.
499 C<&runtests> is exported by C<Test::Harness> by default.
501 C<&execute_tests>, C<$verbose>, C<$switches> and C<$debug> are
502 exported upon request.
504 =head1 ENVIRONMENT VARIABLES THAT TAP::HARNESS::COMPATIBLE SETS
506 C<Test::Harness> sets these before executing the individual tests.
510 =item C<HARNESS_ACTIVE>
512 This is set to a true value. It allows the tests to determine if they
513 are being executed through the harness or by any other means.
515 =item C<HARNESS_VERSION>
517 This is the version of C<Test::Harness>.
521 =head1 ENVIRONMENT VARIABLES THAT AFFECT TEST::HARNESS
525 =item C<HARNESS_TIMER>
527 Setting this to true will make the harness display the number of
528 milliseconds each test took. You can also use F<prove>'s C<--timer>
531 =item C<HARNESS_VERBOSE>
533 If true, C<Test::Harness> will output the verbose results of running
534 its tests. Setting C<$Test::Harness::verbose> will override this,
535 or you can use the C<-v> switch in the F<prove> utility.
537 =item C<HARNESS_OPTIONS>
539 Provide additional options to the harness. Currently supported options are:
545 Run <n> (default 9) parallel jobs.
549 Use forked parallelism.
553 Multiple options may be separated by colons:
555 HARNESS_OPTIONS=j9:f make test
561 Normally when a Perl program is run in taint mode the contents of the
562 C<PERL5LIB> environment variable do not appear in C<@INC>.
564 Because C<PERL5LIB> is often used during testing to add build
565 directories to C<@INC> C<Test::Harness> (actually
566 L<TAP::Parser::Source::Perl>) passes the names of any directories found
567 in C<PERL5LIB> as -I switches. The net effect of this is that
568 C<PERL5LIB> is honoured even in taint mode.
576 Please report any bugs or feature requests to
577 C<bug-test-harness at rt.cpan.org>, or through the web interface at
578 L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Test-Harness>. I will be
579 notified, and then you'll automatically be notified of progress on your bug
584 Andy Armstrong C<< <andy@hexten.net> >>
586 L<Test::Harness> 2.64 (maintained by Andy Lester and on which this
587 module is based) has this attribution:
589 Either Tim Bunce or Andreas Koenig, we don't know. What we know for
590 sure is, that it was inspired by Larry Wall's F<TEST> script that came
591 with perl distributions for ages. Numerous anonymous contributors
592 exist. Andreas Koenig held the torch for many years, and then
595 =head1 LICENCE AND COPYRIGHT
597 Copyright (c) 2007-2008, Andy Armstrong C<< <andy@hexten.net> >>. All rights reserved.
599 This module is free software; you can redistribute it and/or
600 modify it under the same terms as Perl itself. See L<perlartistic>.