# -*- Mode: cperl; cperl-indent-level: 4 -*-
-# $Id: Harness.pm,v 1.14.2.13 2002/01/07 22:34:32 schwern Exp $
package Test::Harness;
-require 5.004;
+require 5.00405;
use Test::Harness::Straps;
use Test::Harness::Assert;
use Exporter;
use Config;
use strict;
-use vars qw($VERSION $Verbose $Switches $Have_Devel_Corestack $Curtest
- $Columns $verbose $switches
- @ISA @EXPORT @EXPORT_OK
- );
+use vars qw(
+ $VERSION
+ @ISA @EXPORT @EXPORT_OK
+ $Verbose $Switches $Debug
+ $verbose $switches $debug
+ $Curtest
+ $Columns
+ $ML $Last_ML_Print
+ $Strap
+);
-# Backwards compatibility for exportable variable names.
-*verbose = \$Verbose;
-*switches = \$Switches;
+=head1 NAME
+
+Test::Harness - Run Perl standard test scripts with statistics
+
+=head1 VERSION
-$Have_Devel_Corestack = 0;
+Version 2.48
-$VERSION = '2.01';
+=cut
+
+$VERSION = "2.48";
+
+# Backwards compatibility for exportable variable names.
+*verbose = *Verbose;
+*switches = *Switches;
+*debug = *Debug;
$ENV{HARNESS_ACTIVE} = 1;
+$ENV{HARNESS_VERSION} = $VERSION;
END {
# For VMS.
delete $ENV{HARNESS_ACTIVE};
+ delete $ENV{HARNESS_VERSION};
}
# Some experimental versions of OS/2 build have broken $?
my $Files_In_Dir = $ENV{HARNESS_FILELEAK_IN_DIR};
-my $Strap = Test::Harness::Straps->new;
+$Strap = Test::Harness::Straps->new;
+
+sub strap { return $Strap };
@ISA = ('Exporter');
@EXPORT = qw(&runtests);
@EXPORT_OK = qw($verbose $switches);
-$Verbose = 0;
+$Verbose = $ENV{HARNESS_VERBOSE} || 0;
+$Debug = $ENV{HARNESS_DEBUG} || 0;
$Switches = "-w";
$Columns = $ENV{HARNESS_COLUMNS} || $ENV{COLUMNS} || 80;
$Columns--; # Some shells have trouble with a full line of text.
-
-=head1 NAME
-
-Test::Harness - run perl standard test scripts with statistics
-
=head1 SYNOPSIS
use Test::Harness;
=head1 DESCRIPTION
-B<STOP!> If all you want to do is write a test script, consider using
-Test::Simple. Otherwise, read on.
-
-(By using the Test module, you can write test scripts without
-knowing the exact output this module expects. However, if you need to
-know the specifics, read on!)
-
-Perl test scripts print to standard output C<"ok N"> for each single
-test, where C<N> is an increasing sequence of integers. The first line
-output by a standard test script is C<"1..M"> with C<M> being the
-number of tests that should be run within the test
-script. Test::Harness::runtests(@tests) runs all the testscripts
-named as arguments and checks standard output for the expected
-C<"ok N"> strings.
-
-After all tests have been performed, runtests() prints some
-performance statistics that are computed by the Benchmark module.
-
-=head2 The test script output
-
-The following explains how Test::Harness interprets the output of your
-test program.
-
-=over 4
-
-=item B<'1..M'>
-
-This header tells how many tests there will be. It should be the
-first line output by your test program (but its okay if its preceded
-by comments).
-
-In certain instanced, you may not know how many tests you will
-ultimately be running. In this case, it is permitted (but not
-encouraged) for the 1..M header to appear as the B<last> line output
-by your test (again, it can be followed by further comments). But we
-strongly encourage you to put it first.
-
-Under B<no> circumstances should 1..M appear in the middle of your
-output or more than once.
-
-
-=item B<'ok', 'not ok'. Ok?>
-
-Any output from the testscript to standard error is ignored and
-bypassed, thus will be seen by the user. Lines written to standard
-output containing C</^(not\s+)?ok\b/> are interpreted as feedback for
-runtests(). All other lines are discarded.
-
-C</^not ok/> indicates a failed test. C</^ok/> is a successful test.
-
-
-=item B<test numbers>
-
-Perl normally expects the 'ok' or 'not ok' to be followed by a test
-number. It is tolerated if the test numbers after 'ok' are
-omitted. In this case Test::Harness maintains temporarily its own
-counter until the script supplies test numbers again. So the following
-test script
-
- print <<END;
- 1..6
- not ok
- ok
- not ok
- ok
- ok
- END
-
-will generate
-
- FAILED tests 1, 3, 6
- Failed 3/6 tests, 50.00% okay
-
-=item B<test names>
-
-Anything after the test number but before the # is considered to be
-the name of the test.
-
- ok 42 this is the name of the test
-
-Currently, Test::Harness does nothing with this information.
-
-=item B<Skipping tests>
-
-If the standard output line contains the substring C< # Skip> (with
-variations in spacing and case) after C<ok> or C<ok NUMBER>, it is
-counted as a skipped test. If the whole testscript succeeds, the
-count of skipped tests is included in the generated output.
-C<Test::Harness> reports the text after C< # Skip\S*\s+> as a reason
-for skipping.
-
- ok 23 # skip Insufficient flogiston pressure.
-
-Similarly, one can include a similar explanation in a C<1..0> line
-emitted if the test script is skipped completely:
-
- 1..0 # Skipped: no leverage found
-
-=item B<Todo tests>
-
-If the standard output line contains the substring C< # TODO> after
-C<not ok> or C<not ok NUMBER>, it is counted as a todo test. The text
-afterwards is the thing that has to be done before this test will
-succeed.
-
- not ok 13 # TODO harness the power of the atom
-
-=begin _deprecated
-
-Alternatively, you can specify a list of what tests are todo as part
-of the test header.
-
- 1..23 todo 5 12 23
-
-This only works if the header appears at the beginning of the test.
-
-This style is B<deprecated>.
-
-=end _deprecated
-
-These tests represent a feature to be implemented or a bug to be fixed
-and act as something of an executable "thing to do" list. They are
-B<not> expected to succeed. Should a todo test begin succeeding,
-Test::Harness will report it as a bonus. This indicates that whatever
-you were supposed to do has been done and you should promote this to a
-normal test.
-
-=item B<Bail out!>
-
-As an emergency measure, a test script can decide that further tests
-are useless (e.g. missing dependencies) and testing should stop
-immediately. In that case the test script prints the magic words
-
- Bail out!
-
-to standard output. Any message after these words will be displayed by
-C<Test::Harness> as the reason why testing is stopped.
+B<STOP!> If all you want to do is write a test script, consider
+using Test::Simple. Test::Harness is the module that reads the
+output from Test::Simple, Test::More and other modules based on
+Test::Builder. You don't need to know about Test::Harness to use
+those modules.
-=item B<Comments>
+Test::Harness runs tests and expects output from the test in a
+certain format. That format is called TAP, the Test Anything
+Protocol. It is defined in L<Test::Harness::TAP>.
-Additional comments may be put into the testing output on their own
-lines. Comment lines should begin with a '#', Test::Harness will
-ignore them.
-
- ok 1
- # Life is good, the sun is shining, RAM is cheap.
- not ok 2
- # got 'Bush' expected 'Gore'
-
-=item B<Anything else>
-
-Any other output Test::Harness sees it will silently ignore B<BUT WE
-PLAN TO CHANGE THIS!> If you wish to place additional output in your
-test script, please use a comment.
-
-=back
+C<Test::Harness::runtests(@tests)> runs all the testscripts named
+as arguments and checks standard output for the expected strings
+in TAP format.
+The F<prove> utility is a thin wrapper around Test::Harness.
=head2 Taint mode
-Test::Harness will honor the C<-T> in the #! line on your test files. So
-if you begin a test with:
+Test::Harness will honor the C<-T> or C<-t> in the #! line on your
+test files. So if you begin a test with:
#!perl -T
the test will be run with taint mode on.
-
=head2 Configuration variables.
These variables can be used to configure the behavior of
=over 4
-=item B<$Test::Harness::verbose>
+=item C<$Test::Harness::Verbose>
-The global variable $Test::Harness::verbose is exportable and can be
-used to let runtests() display the standard output of the script
-without altering the behavior otherwise.
+The package variable C<$Test::Harness::Verbose> is exportable and can be
+used to let C<runtests()> display the standard output of the script
+without altering the behavior otherwise. The F<prove> utility's C<-v>
+flag will set this.
-=item B<$Test::Harness::switches>
+=item C<$Test::Harness::switches>
-The global variable $Test::Harness::switches is exportable and can be
+The package variable C<$Test::Harness::switches> is exportable and can be
used to set perl command line options used for running the test
-script(s). The default value is C<-w>.
+script(s). The default value is C<-w>. It overrides C<HARNESS_SWITCHES>.
=back
=head2 Failure
-It will happen, your tests will fail. After you mop up your ego, you
-can begin examining the summary report:
+When tests fail, analyze the summary report:
t/base..............ok
t/nonumbers.........ok
t/waterloo.t 3 768 20 10 50.00% 1 3 5 7 9 11 13 15 17 19
Failed 1/5 test scripts, 80.00% okay. 10/44 subtests failed, 77.27% okay.
-Everything passed but t/waterloo.t. It failed 10 of 20 tests and
+Everything passed but F<t/waterloo.t>. It failed 10 of 20 tests and
exited with non-zero status indicating something dubious happened.
The columns in the summary report mean:
=item B<Wstat>
-The wait status of the test I<umm, I need a better explanation here>.
+The wait status of the test.
=item B<Total>
my $allok = runtests(@test_files);
-This runs all the given @test_files and divines whether they passed
+This runs all the given I<@test_files> and divines whether they passed
or failed based on their output to STDOUT (details above). It prints
out each individual test which failed along with a summary report and
a how long it all took.
-It returns true if everything was ok, false otherwise.
-
-=for _private
-This is just _run_all_tests() plus _show_results()
+It returns true if everything was ok. Otherwise it will C<die()> with
+one of the messages in the DIAGNOSTICS section.
=cut
my @files = _globdir $dir;
Returns all the files in a directory. This is shorthand for backwards
-compatibility on systems where glob() doesn't work right.
+compatibility on systems where C<glob()> doesn't work right.
=cut
my($total, $failed) = _run_all_tests(@test_files);
-Runs all the given @test_files (as runtests()) but does it quietly (no
-report). $total is a hash ref summary of all the tests run. Its keys
-and values are this:
+Runs all the given C<@test_files> (as C<runtests()>) but does it
+quietly (no report). $total is a hash ref summary of all the tests
+run. Its keys and values are this:
bonus Number of individual todo tests unexpectedly passed
max Number of individual tests ran
tests Number of test files originally given
skipped Number of test files skipped
-If $total->{bad} == 0 and $total->{max} > 0, you've got a successful
-test.
+If C<< $total->{bad} == 0 >> and C<< $total->{max} > 0 >>, you've
+got a successful test.
$failed is a hash ref of all the test scripts which failed. Each key
is the name of a test script, each value is another hash representing
percent Percentage of tests which failed
canon List of tests which failed (as string).
-Needless to say, $failed should be empty if everything passed.
+C<$failed> should be empty if everything passed.
B<NOTE> Currently this function is still noisy. I'm working on it.
=cut
+# Turns on autoflush for the handle passed
+sub _autoflush {
+ my $flushy_fh = shift;
+ my $old_fh = select $flushy_fh;
+ $| = 1;
+ select $old_fh;
+}
+
sub _run_all_tests {
- my(@tests) = @_;
- local($|) = 1;
+ my @tests = @_;
+
+ _autoflush(\*STDOUT);
+ _autoflush(\*STDERR);
+
my(%failedtests);
# Test-wide totals.
bench => 0,
);
- local($ENV{'PERL5LIB'}) = $Strap->_INC2PERL5LIB;
-
- my @dir_files = _globdir $Files_In_Dir if defined $Files_In_Dir;
+ my @dir_files;
+ @dir_files = _globdir $Files_In_Dir if defined $Files_In_Dir;
my $t_start = new Benchmark;
my $width = _leader_width(@tests);
foreach my $tfile (@tests) {
- $Strap->_reset_file_state;
-
+ $Last_ML_Print = 0; # so each test prints at least once
my($leader, $ml) = _mk_leader($tfile, $width);
+ local $ML = $ml;
+
print $leader;
- my $fh = _open_test($tfile);
+ $tot{files}++;
+
+ $Strap->{_seen_header} = 0;
+ if ( $Test::Harness::Debug ) {
+ print "# Running: ", $Strap->_command_line($tfile), "\n";
+ }
+ my %results = $Strap->analyze_file($tfile) or
+ do { warn $Strap->{error}, "\n"; next };
# state of the current test.
+ my @failed = grep { !$results{details}[$_-1]{ok} }
+ 1..@{$results{details}};
my %test = (
- ok => 0,
- 'next' => 0,
- max => 0,
- failed => [],
- todo => {},
- bonus => 0,
- skipped => 0,
- skip_reason => undef,
+ ok => $results{ok},
+ 'next' => $Strap->{'next'},
+ max => $results{max},
+ failed => \@failed,
+ bonus => $results{bonus},
+ skipped => $results{skip},
+ skip_reason => $results{skip_reason},
+ skip_all => $Strap->{skip_all},
ml => $ml,
);
- my($seen_header, $tests_seen) = (0,0);
- while (<$fh>) {
- print if $Verbose;
-
- $Strap->{line}++;
- if( _parse_header($_, \%test, \%tot) ) {
- warn "Test header seen twice!\n" if $seen_header;
-
- $seen_header = 1;
-
- warn "1..M can only appear at the beginning or end of tests\n"
- if $tests_seen && $test{max} < $tests_seen;
- }
- elsif( _parse_test_line($_, \%test, \%tot) ) {
- $tests_seen++;
- }
- # else, ignore it.
- }
-
- my($estatus, $wstatus) = _close_fh($fh);
+ $tot{bonus} += $results{bonus};
+ $tot{max} += $results{max};
+ $tot{ok} += $results{ok};
+ $tot{todo} += $results{todo};
+ $tot{sub_skipped} += $results{skip};
- my $allok = $test{ok} == $test{max} && $test{'next'} == $test{max}+1;
+ my($estatus, $wstatus) = @results{qw(exit wait)};
- if ($wstatus) {
- $failedtests{$tfile} = _dubious_return(\%test, \%tot,
- $estatus, $wstatus);
- $failedtests{$tfile}{name} = $tfile;
- }
- elsif ($allok) {
+ if ($results{passing}) {
if ($test{max} and $test{skipped} + $test{bonus}) {
my @msg;
push(@msg, "$test{skipped}/$test{max} skipped: $test{skip_reason}")
if $test{skipped};
push(@msg, "$test{bonus}/$test{max} unexpectedly succeeded")
if $test{bonus};
- print "$test{ml}ok, ".join(', ', @msg)."\n";
+ print "$test{ml}ok\n ".join(', ', @msg)."\n";
} elsif ($test{max}) {
print "$test{ml}ok\n";
- } elsif (defined $test{skip_reason}) {
- print "skipped: $test{skip_reason}\n";
+ } elsif (defined $test{skip_all} and length $test{skip_all}) {
+ print "skipped\n all skipped: $test{skip_all}\n";
$tot{skipped}++;
} else {
- print "skipped test on this platform\n";
+ print "skipped\n all skipped: no reason given\n";
$tot{skipped}++;
}
$tot{good}++;
}
else {
- if ($test{max}) {
- if ($test{'next'} <= $test{max}) {
- push @{$test{failed}}, $test{'next'}..$test{max};
+ # List unrun tests as failures.
+ if ($test{'next'} <= $test{max}) {
+ push @{$test{failed}}, $test{'next'}..$test{max};
+ }
+ # List overruns as failures.
+ else {
+ my $details = $results{details};
+ foreach my $overrun ($test{max}+1..@$details) {
+ next unless ref $details->[$overrun-1];
+ push @{$test{failed}}, $overrun
}
- if (@{$test{failed}}) {
- my ($txt, $canon) = canonfailed($test{max},$test{skipped},
+ }
+
+ if ($wstatus) {
+ $failedtests{$tfile} = _dubious_return(\%test, \%tot,
+ $estatus, $wstatus);
+ $failedtests{$tfile}{name} = $tfile;
+ }
+ elsif($results{seen}) {
+ if (@{$test{failed}} and $test{max}) {
+ my ($txt, $canon) = _canonfailed($test{max},$test{skipped},
@{$test{failed}});
print "$test{ml}$txt";
$failedtests{$tfile} = { canon => $canon,
};
}
$tot{bad}++;
- } elsif ($test{'next'} == 0) {
+ } else {
print "FAILED before any test output arrived\n";
$tot{bad}++;
$failedtests{$tfile} = { canon => '??',
}
}
- $tot{sub_skipped} += $test{skipped};
-
if (defined $Files_In_Dir) {
my @new_dir_files = _globdir $Files_In_Dir;
if (@new_dir_files != @dir_files) {
@dir_files = @new_dir_files;
}
}
-
- close $fh;
- }
+ } # foreach test
$tot{bench} = timediff(new Benchmark, $t_start);
$Strap->_restore_PERL5LIB;
my($leader, $ml) = _mk_leader($test_file, $width);
-Generates the 't/foo........' $leader for the given $test_file as well
+Generates the 't/foo........' leader for the given C<$test_file> as well
as a similar version which will overwrite the current line (by use of
-\r and such). $ml may be empty if Test::Harness doesn't think you're
+\r and such). C<$ml> may be empty if Test::Harness doesn't think you're
on TTY.
-The $width is the width of the "yada/blah.." string.
+The C<$width> is the width of the "yada/blah.." string.
=cut
}
-sub _parse_header {
- my($line, $test, $tot) = @_;
+my %Handlers = (
+ header => \&header_handler,
+ test => \&test_handler,
+ bailout => \&bailout_handler,
+);
- my $is_header = 0;
+$Strap->{callback} = \&strap_callback;
+sub strap_callback {
+ my($self, $line, $type, $totals) = @_;
+ print $line if $Verbose;
- if( $Strap->_is_header($line) ) {
- $is_header = 1;
+ my $meth = $Handlers{$type};
+ $meth->($self, $line, $type, $totals) if $meth;
+};
- $test->{max} = $Strap->{max};
- for ( keys %{$Strap->{todo}} ) { $test->{todo}{$_} = 1; }
- $test->{skip_reason} = $Strap->{skip_all}
- if not $test->{max} and defined $Strap->{skip_all};
+sub header_handler {
+ my($self, $line, $type, $totals) = @_;
- $test->{'next'} = 1 unless $test->{'next'};
-
-
- $tot->{max} += $test->{max};
- $tot->{files}++;
- }
- else {
- $is_header = 0;
- }
+ warn "Test header seen more than once!\n" if $self->{_seen_header};
- return $is_header;
-}
+ $self->{_seen_header}++;
+ warn "1..M can only appear at the beginning or end of tests\n"
+ if $totals->{seen} &&
+ $totals->{max} < $totals->{seen};
+};
-sub _open_test {
- my($test) = shift;
+sub test_handler {
+ my($self, $line, $type, $totals) = @_;
- my $s = _set_switches($test);
+ my $curr = $totals->{seen};
+ my $next = $self->{'next'};
+ my $max = $totals->{max};
+ my $detail = $totals->{details}[-1];
- # XXX This is WAY too core specific!
- my $cmd = ($ENV{'HARNESS_COMPILE_TEST'})
- ? "./perl -I../lib ../utils/perlcc $test "
- . "-r 2>> ./compilelog |"
- : "$^X $s $test|";
- $cmd = "MCR $cmd" if $^O eq 'VMS';
+ if( $detail->{ok} ) {
+ _print_ml_less("ok $curr/$max");
- if( open(PERL, $cmd) ) {
- return \*PERL;
+ if( $detail->{type} eq 'skip' ) {
+ $totals->{skip_reason} = $detail->{reason}
+ unless defined $totals->{skip_reason};
+ $totals->{skip_reason} = 'various reasons'
+ if $totals->{skip_reason} ne $detail->{reason};
+ }
}
else {
- print "can't run $test. $!\n";
- return;
+ _print_ml("NOK $curr");
}
-}
-
-
-sub _parse_test_line {
- my($line, $test, $tot) = @_;
- my %result;
- if ( $Strap->_is_test($line, \%result) ) {
- $test->{'next'} ||= 1;
- my $this = $test->{'next'};
-
- my($not, $tnum) = (!$result{ok}, $result{number});
+ if( $curr > $next ) {
+ print "Test output counter mismatch [test $curr]\n";
+ }
+ elsif( $curr < $next ) {
+ print "Confused test output: test $curr answered after ".
+ "test ", $next - 1, "\n";
+ }
- $this = $tnum if $tnum;
+};
- my($type, $reason) = ($result{type}, $result{reason});
+sub bailout_handler {
+ my($self, $line, $type, $totals) = @_;
- my($istodo, $isskip);
- if( defined $type ) {
- $istodo = 1 if $type eq 'todo';
- $isskip = 1 if $type eq 'skip';
- }
+ die "FAILED--Further testing stopped" .
+ ($self->{bailout_reason} ? ": $self->{bailout_reason}\n" : ".\n");
+};
- $test->{todo}{$this} = 1 if $istodo;
- $tot->{todo}++ if $test->{todo}{$this};
-
- if( $not ) {
- print "$test->{ml}NOK $this" if $test->{ml};
- if (!$test->{todo}{$this}) {
- push @{$test->{failed}}, $this;
- } else {
- $test->{ok}++;
- $tot->{ok}++;
- }
- }
- else {
- print "$test->{ml}ok $this/$test->{max}" if $test->{ml};
- $test->{ok}++;
- $tot->{ok}++;
- $test->{skipped}++ if $isskip;
-
- $reason = '[no reason given]'
- if $isskip and not defined $reason;
- if (defined $reason and defined $test->{skip_reason}) {
- # print "was: '$skip_reason' new '$reason'\n";
- $test->{skip_reason} = 'various reasons'
- if $test->{skip_reason} ne $reason;
- } elsif (defined $reason) {
- $test->{skip_reason} = $reason;
- }
+sub _print_ml {
+ print join '', $ML, @_ if $ML;
+}
- $test->{bonus}++, $tot->{bonus}++ if $test->{todo}{$this};
- }
- if ($this > $test->{'next'}) {
- print "Test output counter mismatch [test $this]\n";
- push @{$test->{failed}}, $test->{'next'}..$this-1;
- }
- elsif ($this < $test->{'next'}) {
- #we have seen more "ok" lines than the number suggests
- print "Confused test output: test $this answered after ".
- "test ", $test->{'next'}-1, "\n";
- $test->{'next'} = $this;
- }
- $test->{'next'} = $this + 1;
-
- }
- else {
- my $bail_reason;
- if( $Strap->_is_bail_out($line, \$bail_reason) ) { # bail out!
- die "FAILED--Further testing stopped" .
- ($bail_reason ? ": $bail_reason\n" : ".\n");
- }
+# For slow connections, we save lots of bandwidth by printing only once
+# per second.
+sub _print_ml_less {
+ if ( $Last_ML_Print != time ) {
+ _print_ml(@_);
+ $Last_ML_Print = time;
}
}
-
sub _bonusmsg {
my($tot) = @_;
return $bonusmsg;
}
-# VMS has some subtle nastiness with closing the test files.
-sub _close_fh {
- my($fh) = shift;
-
- close($fh); # must close to reap child resource values
-
- my $wstatus = $Ignore_Exitcode ? 0 : $?; # Can trust $? ?
- my $estatus;
- $estatus = ($^O eq 'VMS'
- ? eval 'use vmsish "status"; $estatus = $?'
- : $wstatus >> 8);
-
- return($estatus, $wstatus);
-}
-
-
-# Set up the command-line switches to run perl as.
-sub _set_switches {
- my($test) = shift;
-
- my $s = $Switches;
- $s .= $Strap->_switches($test);
-
- return $s;
-}
-
-
# Test program go boom.
sub _dubious_return {
my($test, $tot, $estatus, $wstatus) = @_;
$wstatus,$wstatus;
print "\t\t(VMS status is $estatus)\n" if $^O eq 'VMS';
- if (corestatus($wstatus)) { # until we have a wait module
- if ($Have_Devel_Corestack) {
- Devel::CoreStack::stack($^X);
- } else {
- print "\ttest program seems to have generated a core\n";
- }
- }
-
$tot->{bad}++;
if ($test->{max}) {
else {
push @{$test->{failed}}, $test->{'next'}..$test->{max};
$failed = @{$test->{failed}};
- (my $txt, $canon) = canonfailed($test->{max},$test->{skipped},@{$test->{failed}});
+ (my $txt, $canon) = _canonfailed($test->{max},$test->{skipped},@{$test->{failed}});
$percent = 100*(scalar @{$test->{failed}})/$test->{max};
print "DIED. ",$txt;
}
}
-sub _garbled_output {
- my($gibberish) = shift;
- warn "Confusing test output: '$gibberish'\n";
-}
-
-
sub _create_fmts {
my($failedtests) = @_;
return($fmt_top, $fmt);
}
-{
- my $tried_devel_corestack;
-
- sub corestatus {
- my($st) = @_;
-
- eval {require 'wait.ph'};
- my $ret = defined &WCOREDUMP ? WCOREDUMP($st) : $st & 0200;
-
- eval { require Devel::CoreStack; $Have_Devel_Corestack++ }
- unless $tried_devel_corestack++;
-
- $ret;
- }
-}
-
-sub canonfailed ($@) {
+sub _canonfailed ($$@) {
my($max,$skipped,@failed) = @_;
my %seen;
@failed = sort {$a <=> $b} grep !$seen{$_}++, @failed;
}
push @result, "\tFailed $failed/$max tests, ";
- push @result, sprintf("%.2f",100*(1-$failed/$max)), "% okay";
+ if ($max) {
+ push @result, sprintf("%.2f",100*(1-$failed/$max)), "% okay";
+ } else {
+ push @result, "?% okay";
+ }
my $ender = 's' x ($skipped > 1);
- my $good = $max - $failed - $skipped;
- my $goodper = sprintf("%.2f",100*($good/$max));
- push @result, " (-$skipped skipped test$ender: $good okay, ".
- "$goodper%)"
- if $skipped;
+ if ($skipped) {
+ my $good = $max - $failed - $skipped;
+ my $skipmsg = " (less $skipped skipped test$ender: $good okay, ";
+ if ($max) {
+ my $goodper = sprintf("%.2f",100*($good/$max));
+ $skipmsg .= "$goodper%)";
+ } else {
+ $skipmsg .= "?%)";
+ }
+ push @result, $skipmsg;
+ }
push @result, "\n";
my $txt = join "", @result;
($txt, $canon);
=head1 EXPORT
-C<&runtests> is exported by Test::Harness per default.
-
-C<$verbose> and C<$switches> are exported upon request.
+C<&runtests> is exported by Test::Harness by default.
+C<$verbose>, C<$switches> and C<$debug> are exported upon request.
=head1 DIAGNOSTICS
If not all tests were successful, the script dies with one of the
above messages.
-=item C<FAILED--Further testing stopped%s>
+=item C<FAILED--Further testing stopped: %s>
If a single subtest decides that further testing will not make sense,
the script dies with this message.
=back
-=head1 ENVIRONMENT
+=head1 ENVIRONMENT VARIABLES THAT TEST::HARNESS SETS
+
+Test::Harness sets these before executing the individual tests.
=over 4
-=item C<HARNESS_IGNORE_EXITCODE>
+=item C<HARNESS_ACTIVE>
-Makes harness ignore the exit status of child processes when defined.
+This is set to a true value. It allows the tests to determine if they
+are being executed through the harness or by any other means.
-=item C<HARNESS_NOTTY>
+=item C<HARNESS_VERSION>
-When set to a true value, forces it to behave as though STDOUT were
-not a console. You may need to set this if you don't want harness to
-output more frequent progress messages using carriage returns. Some
-consoles may not handle carriage returns properly (which results in a
-somewhat messy output).
+This is the version of Test::Harness.
+
+=back
+
+=head1 ENVIRONMENT VARIABLES THAT AFFECT TEST::HARNESS
+
+=over 4
+
+=item C<HARNESS_COLUMNS>
+
+This value will be used for the width of the terminal. If it is not
+set then it will default to C<COLUMNS>. If this is not set, it will
+default to 80. Note that users of Bourne-sh based shells will need to
+C<export COLUMNS> for this module to use that variable.
=item C<HARNESS_COMPILE_TEST>
B<NOTE> This currently only works when sitting in the perl source
directory!
+=item C<HARNESS_DEBUG>
+
+If true, Test::Harness will print debugging information about itself as
+it runs the tests. This is different from C<HARNESS_VERBOSE>, which prints
+the output from the test being run. Setting C<$Test::Harness::Debug> will
+override this, or you can use the C<-d> switch in the F<prove> utility.
+
=item C<HARNESS_FILELEAK_IN_DIR>
When set to the name of a directory, harness will check after each
the moment runtests() was called. Putting absolute path into
C<HARNESS_FILELEAK_IN_DIR> may give more predictable results.
+=item C<HARNESS_IGNORE_EXITCODE>
+
+Makes harness ignore the exit status of child processes when defined.
+
+=item C<HARNESS_NOTTY>
+
+When set to a true value, forces it to behave as though STDOUT were
+not a console. You may need to set this if you don't want harness to
+output more frequent progress messages using carriage returns. Some
+consoles may not handle carriage returns properly (which results in a
+somewhat messy output).
+
+=item C<HARNESS_PERL>
+
+Usually your tests will be run by C<$^X>, the currently-executing Perl.
+However, you may want to have it run by a different executable, such as
+a threading perl, or a different version.
+
+If you're using the F<prove> utility, you can use the C<--perl> switch.
+
=item C<HARNESS_PERL_SWITCHES>
Its value will be prepended to the switches used to invoke perl on
each test. For example, setting C<HARNESS_PERL_SWITCHES> to C<-W> will
run all tests with all warnings enabled.
-=item C<HARNESS_COLUMNS>
-
-This value will be used for the width of the terminal. If it is not
-set then it will default to C<COLUMNS>. If this is not set, it will
-default to 80. Note that users of Bourne-sh based shells will need to
-C<export COLUMNS> for this module to use that variable.
-
-=item C<HARNESS_ACTIVE>
+=item C<HARNESS_VERBOSE>
-Harness sets this before executing the individual tests. This allows
-the tests to determine if they are being executed through the harness
-or by any other means.
+If true, Test::Harness will output the verbose results of running
+its tests. Setting C<$Test::Harness::verbose> will override this,
+or you can use the C<-v> switch in the F<prove> utility.
=back
=head1 SEE ALSO
+The included F<prove> utility for running test scripts from the command line,
L<Test> and L<Test::Simple> for writing test scripts, L<Benchmark> for
-the underlying timing routines, L<Devel::CoreStack> to generate core
-dumps from failed tests and L<Devel::Cover> for test coverage
+the underlying timing routines, and L<Devel::Cover> for test coverage
analysis.
-=head1 AUTHORS
-
-Either Tim Bunce or Andreas Koenig, we don't know. What we know for
-sure is, that it was inspired by Larry Wall's TEST script that came
-with perl distributions for ages. Numerous anonymous contributors
-exist. Andreas Koenig held the torch for many years.
-
-Current maintainer is Michael G Schwern E<lt>schwern@pobox.comE<gt>
-
=head1 TODO
Provide a way of running tests quietly (ie. no printing) for automated
validation of tests. This will probably take the form of a version
of runtests() which rather than printing its output returns raw data
-on the state of the tests.
+on the state of the tests. (Partially done in Test::Harness::Straps)
+
+Document the format.
Fix HARNESS_COMPILE_TEST without breaking its core usage.
Figure a way to report test names in the failure summary.
Rework the test summary so long test names are not truncated as badly.
+(Partially done with new skip test styles)
-Merge back into bleadperl.
+Add option for coverage analysis.
-Deal with VMS's "not \nok 4\n" mistake.
+Trap STDERR.
-Add option for coverage analysis.
+Implement Straps total_results()
+
+Remember exit code
+
+Completely redo the print summary code.
+
+Implement Straps callbacks. (experimentally implemented)
+
+Straps->analyze_file() not taint clean, don't know if it can be
+
+Fix that damned VMS nit.
+
+HARNESS_TODOFAIL to display TODO failures
+
+Add a test for verbose.
+
+Change internal list of test results to a hash.
+
+Fix stats display when there's an overrun.
+
+Fix so perls with spaces in the filename work.
-=for _private
Keeping whittling away at _run_all_tests()
-=for _private
Clean up how the summary is printed. Get rid of those damned formats.
=head1 BUGS
-Test::Harness uses $^X to determine the perl binary to run the tests
-with. Test scripts running via the shebang (C<#!>) line may not be
-portable because $^X is not consistent for shebang scripts across
-platforms. This is no problem when Test::Harness is run with an
-absolute path to the perl binary or when $^X can be found in the path.
-
-HARNESS_COMPILE_TEST currently assumes its run from the Perl source
+HARNESS_COMPILE_TEST currently assumes it's run from the Perl source
directory.
+Please use the CPAN bug ticketing system at L<http://rt.cpan.org/>.
+You can also mail bugs, fixes and enhancements to
+C<< <bug-test-harness >> at C<< rt.cpan.org> >>.
+
+=head1 AUTHORS
+
+Either Tim Bunce or Andreas Koenig, we don't know. What we know for
+sure is, that it was inspired by Larry Wall's TEST script that came
+with perl distributions for ages. Numerous anonymous contributors
+exist. Andreas Koenig held the torch for many years, and then
+Michael G Schwern.
+
+Current maintainer is Andy Lester C<< <andy at petdance.com> >>.
+
+=head1 COPYRIGHT
+
+Copyright 2002-2005
+by Michael G Schwern C<< <schwern at pobox.com> >>,
+Andy Lester C<< <andy at petdance.com> >>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See L<http://www.perl.com/perl/misc/Artistic.html>.
+
=cut