# -*- Mode: cperl; cperl-indent-level: 4 -*-
+
package Test::Harness;
-use 5.005_64;
+require 5.00405;
+use Test::Harness::Straps;
+use Test::Harness::Assert;
use Exporter;
use Benchmark;
use Config;
use strict;
-our($VERSION, $Verbose, $Switches, $Have_Devel_Corestack, $Curtest,
- $Columns, $verbose, $switches,
- @ISA, @EXPORT, @EXPORT_OK
- );
-# Backwards compatibility for exportable variable names.
-*verbose = \$Verbose;
-*switches = \$Switches;
+use vars qw(
+ $VERSION
+ @ISA @EXPORT @EXPORT_OK
+ $Verbose $Switches $Debug
+ $verbose $switches $debug
+ $Columns
+ $Timer
+ $ML $Last_ML_Print
+ $Strap
+ $has_time_hires
+);
+
+BEGIN {
+ eval "use Time::HiRes 'time'";
+ $has_time_hires = !$@;
+}
+
+=head1 NAME
+
+Test::Harness - Run Perl standard test scripts with statistics
-$Have_Devel_Corestack = 0;
+=head1 VERSION
-$VERSION = "1.1702";
+Version 2.58
+
+=cut
+
+$VERSION = '2.58_01';
+
+# Backwards compatibility for exportable variable names.
+*verbose = *Verbose;
+*switches = *Switches;
+*debug = *Debug;
$ENV{HARNESS_ACTIVE} = 1;
+$ENV{HARNESS_VERSION} = $VERSION;
-# Some experimental versions of OS/2 build have broken $?
-my $Ignore_Exitcode = $ENV{HARNESS_IGNORE_EXITCODE};
+END {
+ # For VMS.
+ delete $ENV{HARNESS_ACTIVE};
+ delete $ENV{HARNESS_VERSION};
+}
my $Files_In_Dir = $ENV{HARNESS_FILELEAK_IN_DIR};
+$Strap = Test::Harness::Straps->new;
+
+sub strap { return $Strap };
@ISA = ('Exporter');
@EXPORT = qw(&runtests);
-@EXPORT_OK = qw($verbose $switches);
+@EXPORT_OK = qw(&execute_tests $verbose $switches);
-$Verbose = 0;
+$Verbose = $ENV{HARNESS_VERBOSE} || 0;
+$Debug = $ENV{HARNESS_DEBUG} || 0;
$Switches = "-w";
$Columns = $ENV{HARNESS_COLUMNS} || $ENV{COLUMNS} || 80;
-$Columns--; # Do no write into the last column
+$Columns--; # Some shells have trouble with a full line of text.
+$Timer = $ENV{HARNESS_TIMER} || 0;
+
+=head1 SYNOPSIS
+
+ use Test::Harness;
+
+ runtests(@test_files);
+
+=head1 DESCRIPTION
+
+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.
+
+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>.
+
+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> 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
+Test::Harness. They are exported on request.
+
+=over 4
+
+=item C<$Test::Harness::Verbose>
+
+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 C<$Test::Harness::switches>
+
+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>. It overrides C<HARNESS_PERL_SWITCHES>.
+
+=item C<$Test::Harness::Timer>
+
+If set to true, and C<Time::HiRes> is available, print elapsed seconds
+after each test file.
+
+=back
+
+
+=head2 Failure
+
+When tests fail, analyze the summary report:
+
+ t/base..............ok
+ t/nonumbers.........ok
+ t/ok................ok
+ t/test-harness......ok
+ t/waterloo..........dubious
+ Test returned status 3 (wstat 768, 0x300)
+ DIED. FAILED tests 1, 3, 5, 7, 9, 11, 13, 15, 17, 19
+ Failed 10/20 tests, 50.00% okay
+ Failed Test Stat Wstat Total Fail List of Failed
+ ---------------------------------------------------------------
+ t/waterloo.t 3 768 20 10 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 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:
+
+=over 4
+
+=item B<Failed Test>
+
+The test file which failed.
-sub globdir { opendir DIRH, shift; my @f = readdir DIRH; closedir DIRH; @f }
+=item B<Stat>
+
+If the test exited with non-zero, this is its exit status.
+
+=item B<Wstat>
+
+The wait status of the test.
+
+=item B<Total>
+
+Total number of tests expected to run.
+
+=item B<Fail>
+
+Number which failed, either from "not ok" or because they never ran.
+
+=item B<List of Failed>
+
+A list of the tests which failed. Successive failures may be
+abbreviated (ie. 15-20 to indicate that tests 15, 16, 17, 18, 19 and
+20 failed).
+
+=back
+
+
+=head1 FUNCTIONS
+
+The following functions are available.
+
+=head2 runtests( @test_files )
+
+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. Otherwise it will C<die()> with
+one of the messages in the DIAGNOSTICS section.
+
+=cut
sub runtests {
my(@tests) = @_;
- my($tot, $failedtests) = _runtests(@tests);
- _show_results($tot, $failedtests);
+ local ($\, $,);
+
+ my ($tot, $failedtests,$todo_passed) = execute_tests(tests => \@tests);
+ print get_results($tot, $failedtests,$todo_passed);
- return ($tot->{bad} == 0 && $tot->{max}) ;
+ my $ok = _all_ok($tot);
+
+ assert(($ok xor keys %$failedtests),
+ q{ok status jives with $failedtests});
+
+ return $ok;
}
+# my $ok = _all_ok(\%tot);
+# Tells you if this test run is overall successful or not.
-sub _runtests {
- my(@tests) = @_;
- local($|) = 1;
- my(%failedtests);
+sub _all_ok {
+ my($tot) = shift;
+
+ return $tot->{bad} == 0 && ($tot->{max} || $tot->{skipped}) ? 1 : 0;
+}
+
+# Returns all the files in a directory. This is shorthand for backwards
+# compatibility on systems where C<glob()> doesn't work right.
+
+sub _globdir {
+ local *DIRH;
+
+ opendir DIRH, shift;
+ my @f = readdir DIRH;
+ closedir DIRH;
+
+ return @f;
+}
+
+=head2 execute_tests( tests => \@test_files, out => \*FH )
+
+Runs all the given C<@test_files> (just like C<runtests()>) but
+doesn't generate the final report. During testing, progress
+information will be written to the currently selected output
+filehandle (usually C<STDOUT>), or to the filehandle given by the
+C<out> parameter. The I<out> is optional.
+
+Returns a list of two values, C<$total> and C<$failed>, describing the
+results. C<$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
+ ok Number of individual tests passed
+ sub_skipped Number of individual tests skipped
+ todo Number of individual todo tests
+
+ files Number of test files ran
+ good Number of test files passed
+ bad Number of test files failed
+ tests Number of test files originally given
+ skipped Number of test files skipped
+
+If C<< $total->{bad} == 0 >> and C<< $total->{max} > 0 >>, you've
+got a successful test.
+
+C<$failed> is a hash ref of all the test scripts that failed. Each key
+is the name of a test script, each value is another hash representing
+how that script failed. Its keys are these:
+
+ name Name of the test which failed
+ estat Script's exit value
+ wstat Script's wait status
+ max Number of individual tests
+ failed Number which failed
+ canon List of tests which failed (as string).
+
+C<$failed> should be empty if everything passed.
+
+=cut
+
+sub execute_tests {
+ my %args = @_;
+ my @tests = @{$args{tests}};
+ my $out = $args{out} || select();
+
+ # We allow filehandles that are symbolic refs
+ no strict 'refs';
+ _autoflush($out);
+ _autoflush(\*STDERR);
+
+ my %failedtests;
+ my %todo_passed;
# Test-wide totals.
my(%tot) = (
good => 0,
tests => scalar @tests,
sub_skipped => 0,
+ todo => 0,
skipped => 0,
- bench => 0
+ bench => 0,
);
- # pass -I flags to children
- my $old5lib = $ENV{PERL5LIB};
-
- # VMS has a 255-byte limit on the length of %ENV entries, so
- # toss the ones that involve perl_root, the install location
- # for VMS
- my $new5lib;
- if ($^O eq 'VMS') {
- $new5lib = join($Config{path_sep}, grep {!/perl_root/i;} @INC);
- $Switches =~ s/-(\S*[A-Z]\S*)/"-$1"/g;
- }
- else {
- $new5lib = join($Config{path_sep}, @INC);
- }
-
- local($ENV{'PERL5LIB'}) = $new5lib;
-
- my @dir_files = globdir $Files_In_Dir if defined $Files_In_Dir;
- my $t_start = new Benchmark;
+ my @dir_files;
+ @dir_files = _globdir $Files_In_Dir if defined $Files_In_Dir;
+ my $run_start_time = new Benchmark;
- foreach my $test (@tests) {
- my $te = $test;
- chop($te); # XXX chomp?
+ my $width = _leader_width(@tests);
+ foreach my $tfile (@tests) {
+ $Last_ML_Print = 0; # so each test prints at least once
+ my($leader, $ml) = _mk_leader($tfile, $width);
+ local $ML = $ml;
- if ($^O eq 'VMS') { $te =~ s/^.*\.t\./[.t./s; }
- my $blank = (' ' x 77);
- my $leader = "$te" . '.' x (20 - length($te));
- my $ml = "";
- $ml = "\r$blank\r$leader"
- if -t STDOUT and not $ENV{HARNESS_NOTTY} and not $Verbose;
- print $leader;
+ print $out $leader;
- my $s = _set_switches($test);
+ $tot{files}++;
- 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';
- open(my $fh, $cmd) or print "can't run $test. $!\n";
+ $Strap->{_seen_header} = 0;
+ if ( $Test::Harness::Debug ) {
+ print $out "# Running: ", $Strap->_command_line($tfile), "\n";
+ }
+ my $test_start_time = $Timer ? time : 0;
+ my %results = $Strap->analyze_file($tfile) or
+ do { warn $Strap->{error}, "\n"; next };
+ my $elapsed;
+ if ( $Timer ) {
+ $elapsed = time - $test_start_time;
+ if ( $has_time_hires ) {
+ $elapsed = sprintf( " %8d ms", $elapsed*1000 );
+ }
+ else {
+ $elapsed = sprintf( " %8s s", $elapsed ? $elapsed : "<1" );
+ }
+ }
+ else {
+ $elapsed = "";
+ }
# state of the current test.
+ my @failed = grep { !$results{details}[$_-1]{ok} }
+ 1..@{$results{details}};
+ my @todo_pass = grep { $results{details}[$_-1]{actual_ok} &&
+ $results{details}[$_-1]{type} eq 'todo' }
+ 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,
+ todo_pass => \@todo_pass,
+ todo => $results{todo},
+ 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>) {
- if( _parse_header($_, \%test, \%tot) ) {
- warn "Test header seen twice!\n" if $seen_header;
-
- $seen_header = 1;
+ $tot{bonus} += $results{bonus};
+ $tot{max} += $results{max};
+ $tot{ok} += $results{ok};
+ $tot{todo} += $results{todo};
+ $tot{sub_skipped} += $results{skip};
+
+ my($estatus, $wstatus) = @results{qw(exit wait)};
+
+ if ($results{passing}) {
+ # XXX Combine these first two
+ if ($test{max} and $test{skipped} + $test{bonus}) {
+ my @msg;
+ push(@msg, "$test{skipped}/$test{max} skipped: $test{skip_reason}")
+ if $test{skipped};
+ if ($test{bonus}) {
+ my ($txt, $canon) = _canondetail($test{todo},0,'TODO passed',
+ @{$test{todo_pass}});
+ $todo_passed{$tfile} = {
+ canon => $canon,
+ max => $test{todo},
+ failed => $test{bonus},
+ name => $tfile,
+ estat => '',
+ wstat => '',
+ };
+
+ push(@msg, "$test{bonus}/$test{max} unexpectedly succeeded\n$txt");
+ }
+ print $out "$test{ml}ok$elapsed\n ".join(', ', @msg)."\n";
+ }
+ elsif ( $test{max} ) {
+ print $out "$test{ml}ok$elapsed\n";
+ }
+ elsif ( defined $test{skip_all} and length $test{skip_all} ) {
+ print $out "skipped\n all skipped: $test{skip_all}\n";
+ $tot{skipped}++;
+ }
+ else {
+ print $out "skipped\n all skipped: no reason given\n";
+ $tot{skipped}++;
+ }
+ $tot{good}++;
+ }
+ else {
+ # 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
+ }
+ }
- warn "1..M can only appear at the beginning or end of tests\n"
- if $tests_seen && $test{max} < $tests_seen;
+ if ($wstatus) {
+ $failedtests{$tfile} = _dubious_return(\%test, \%tot,
+ $estatus, $wstatus);
+ $failedtests{$tfile}{name} = $tfile;
}
- elsif( _parse_test_line($_, \%test, \%tot) ) {
- $tests_seen++;
+ elsif($results{seen}) {
+ if (@{$test{failed}} and $test{max}) {
+ my ($txt, $canon) = _canondetail($test{max},$test{skipped},'Failed',
+ @{$test{failed}});
+ print $out "$test{ml}$txt";
+ $failedtests{$tfile} = { canon => $canon,
+ max => $test{max},
+ failed => scalar @{$test{failed}},
+ name => $tfile,
+ estat => '',
+ wstat => '',
+ };
+ }
+ else {
+ print $out "Don't know which tests failed: got $test{ok} ok, ".
+ "expected $test{max}\n";
+ $failedtests{$tfile} = { canon => '??',
+ max => $test{max},
+ failed => '??',
+ name => $tfile,
+ estat => '',
+ wstat => '',
+ };
+ }
+ $tot{bad}++;
}
- # else, ignore it.
- }
+ else {
+ print $out "FAILED before any test output arrived\n";
+ $tot{bad}++;
+ $failedtests{$tfile} = { canon => '??',
+ max => '??',
+ failed => '??',
+ name => $tfile,
+ estat => '',
+ wstat => '',
+ };
+ }
+ }
+
+ if (defined $Files_In_Dir) {
+ my @new_dir_files = _globdir $Files_In_Dir;
+ if (@new_dir_files != @dir_files) {
+ my %f;
+ @f{@new_dir_files} = (1) x @new_dir_files;
+ delete @f{@dir_files};
+ my @f = sort keys %f;
+ print $out "LEAKED FILES: @f\n";
+ @dir_files = @new_dir_files;
+ }
+ }
+ } # foreach test
+ $tot{bench} = timediff(new Benchmark, $run_start_time);
- my($estatus, $wstatus) = _close_fh($fh);
+ $Strap->_restore_PERL5LIB;
- if ($wstatus) {
- $failedtests{$test} = _dubious_return(\%test, \%tot,
- $estatus, $wstatus);
- $failedtests{$test}{name} = $test;
- }
- elsif ($test{ok} == $test{max} && $test{next} == $test{max}+1) {
- 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";
- } elsif ($test{max}) {
- print "$test{ml}ok\n";
- } elsif (defined $test{skip_reason}) {
- print "skipped: $test{skip_reason}\n";
- $tot{skipped}++;
- } else {
- print "skipped test on this platform\n";
- $tot{skipped}++;
- }
- $tot{good}++;
- } elsif ($test{max}) {
- if ($test{next} <= $test{max}) {
- push @{$test{failed}}, $test{next}..$test{max};
- }
- if (@{$test{failed}}) {
- my ($txt, $canon) = canonfailed($test{max},$test{skipped},
- @{$test{failed}});
- print "$test{ml}$txt";
- $failedtests{$test} = { canon => $canon,
- max => $test{max},
- failed => scalar @{$test{failed}},
- name => $test,
- percent => 100*(scalar @{$test{failed}})/$test{max},
- estat => '',
- wstat => '',
- };
- } else {
- print "Don't know which tests failed: got $test{ok} ok, ".
- "expected $test{max}\n";
- $failedtests{$test} = { canon => '??',
- max => $test{max},
- failed => '??',
- name => $test,
- percent => undef,
- estat => '',
- wstat => '',
- };
- }
- $tot{bad}++;
- } elsif ($test{next} == 0) {
- print "FAILED before any test output arrived\n";
- $tot{bad}++;
- $failedtests{$test} = { canon => '??',
- max => '??',
- failed => '??',
- name => $test,
- percent => undef,
- estat => '',
- wstat => '',
- };
- }
- $tot{sub_skipped} += $test{skipped};
-
- if (defined $Files_In_Dir) {
- my @new_dir_files = globdir $Files_In_Dir;
- if (@new_dir_files != @dir_files) {
- my %f;
- @f{@new_dir_files} = (1) x @new_dir_files;
- delete @f{@dir_files};
- my @f = sort keys %f;
- print "LEAKED FILES: @f\n";
- @dir_files = @new_dir_files;
- }
- }
- }
- $tot{bench} = timediff(new Benchmark, $t_start);
+ return(\%tot, \%failedtests, \%todo_passed);
+}
+
+# Turns on autoflush for the handle passed
+sub _autoflush {
+ my $flushy_fh = shift;
+ my $old_fh = select $flushy_fh;
+ $| = 1;
+ select $old_fh;
+}
+
+=for private _mk_leader
+
+ my($leader, $ml) = _mk_leader($test_file, $width);
+
+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). C<$ml> may be empty if Test::Harness doesn't think you're
+on TTY.
+
+The C<$width> is the width of the "yada/blah.." string.
+
+=cut
+
+sub _mk_leader {
+ my($te, $width) = @_;
+ chomp($te);
+ $te =~ s/\.\w+$/./;
if ($^O eq 'VMS') {
- if (defined $old5lib) {
- $ENV{PERL5LIB} = $old5lib;
- } else {
- delete $ENV{PERL5LIB};
- }
+ $te =~ s/^.*\.t\./\[.t./s;
+ }
+ my $leader = "$te" . '.' x ($width - length($te));
+ my $ml = "";
+
+ if ( -t STDOUT and not $ENV{HARNESS_NOTTY} and not $Verbose ) {
+ $ml = "\r" . (' ' x 77) . "\r$leader"
}
- return(\%tot, \%failedtests);
+ return($leader, $ml);
}
+=for private _leader_width
-sub _show_results {
- my($tot, $failedtests) = @_;
+ my($width) = _leader_width(@test_files);
+
+Calculates how wide the leader should be based on the length of the
+longest test name.
+
+=cut
+
+sub _leader_width {
+ my $maxlen = 0;
+ my $maxsuflen = 0;
+ foreach (@_) {
+ my $suf = /\.(\w+)$/ ? $1 : '';
+ my $len = length;
+ my $suflen = length $suf;
+ $maxlen = $len if $len > $maxlen;
+ $maxsuflen = $suflen if $suflen > $maxsuflen;
+ }
+ # + 3 : we want three dots between the test name and the "ok"
+ return $maxlen + 3 - $maxsuflen;
+}
+
+sub get_results {
+ my $tot = shift;
+ my $failedtests = shift;
+ my $todo_passed = shift;
+
+ my $out = '';
- my $pct;
my $bonusmsg = _bonusmsg($tot);
- if ($tot->{bad} == 0 && $tot->{max}) {
- print "All tests successful$bonusmsg.\n";
- } elsif ($tot->{tests}==0){
- die "FAILED--no tests were run for some reason.\n";
- } elsif ($tot->{max} == 0) {
- my $blurb = $tot->{tests}==1 ? "script" : "scripts";
- die "FAILED--$tot->{tests} test $blurb could be run, ".
+ if (_all_ok($tot)) {
+ $out .= "All tests successful$bonusmsg.\n";
+ if ($tot->{bonus}) {
+ my($fmt_top, $fmt) = _create_fmts("Passed TODO",$todo_passed);
+ # Now write to formats
+ $out .= swrite( $fmt_top );
+ for my $script (sort keys %{$todo_passed||{}}) {
+ my $Curtest = $todo_passed->{$script};
+ $out .= swrite( $fmt, @{ $Curtest }{qw(name estat wstat max failed canon)} );
+ }
+ }
+ }
+ elsif (!$tot->{tests}){
+ die "FAILED--no tests were run for some reason.\n";
+ }
+ elsif (!$tot->{max}) {
+ my $blurb = $tot->{tests}==1 ? "script" : "scripts";
+ die "FAILED--$tot->{tests} test $blurb could be run, ".
"alas--no output ever seen\n";
- } else {
- $pct = sprintf("%.2f", $tot->{good} / $tot->{tests} * 100);
- my $subpct = sprintf " %d/%d subtests failed, %.2f%% okay.",
- $tot->{max} - $tot->{ok}, $tot->{max},
- 100*$tot->{ok}/$tot->{max};
-
- my($fmt_top, $fmt) = _create_fmts($failedtests);
-
- # Now write to formats
- for my $script (sort keys %$failedtests) {
- $Curtest = $failedtests->{$script};
- write;
- }
- if ($tot->{bad}) {
- $bonusmsg =~ s/^,\s*//;
- print "$bonusmsg.\n" if $bonusmsg;
- die "Failed $tot->{bad}/$tot->{tests} test scripts, $pct% okay.".
- "$subpct\n";
- }
+ }
+ else {
+ my $subresults = sprintf( " %d/%d subtests failed.",
+ $tot->{max} - $tot->{ok}, $tot->{max} );
+
+ my($fmt_top, $fmt1, $fmt2) = _create_fmts("Failed Test",$failedtests);
+
+ # Now write to formats
+ $out .= swrite( $fmt_top );
+ for my $script (sort keys %$failedtests) {
+ my $Curtest = $failedtests->{$script};
+ $out .= swrite( $fmt1, @{ $Curtest }{qw(name estat wstat max failed canon)} );
+ $out .= swrite( $fmt2, $Curtest->{canon} );
+ }
+ if ($tot->{bad}) {
+ $bonusmsg =~ s/^,\s*//;
+ $out .= "$bonusmsg.\n" if $bonusmsg;
+ $out .= "Failed $tot->{bad}/$tot->{tests} test scripts.$subresults\n";
+ }
}
- printf("Files=%d, Tests=%d, %s\n",
+ $out .= sprintf("Files=%d, Tests=%d, %s\n",
$tot->{files}, $tot->{max}, timestr($tot->{bench}, 'nop'));
+ return $out;
}
+sub swrite {
+ my $format = shift;
+ $^A = '';
+ formline($format,@_);
+ my $out = $^A;
+ $^A = '';
+ return $out;
+}
-sub _parse_header {
- my($line, $test, $tot) = @_;
- my $is_header = 0;
+my %Handlers = (
+ header => \&header_handler,
+ test => \&test_handler,
+ bailout => \&bailout_handler,
+);
+$Strap->{callback} = \&strap_callback;
+sub strap_callback {
+ my($self, $line, $type, $totals) = @_;
print $line if $Verbose;
- # 1..10 todo 4 7 10;
- if ($line =~ /^1\.\.([0-9]+) todo([\d\s]+);?/i) {
- $test->{max} = $1;
- for (split(/\s+/, $2)) { $test->{todo}{$_} = 1; }
+ my $meth = $Handlers{$type};
+ $meth->($self, $line, $type, $totals) if $meth;
+};
- $tot->{max} += $test->{max};
- $tot->{files}++;
- $is_header = 1;
- }
- # 1..10
- # 1..0 # skip Why? Because I said so!
- elsif ($line =~ /^1\.\.([0-9]+)
- (\s*\#\s*[Ss]kip\S*(?>\s+) (.+))?
- /x
- )
- {
- $test->{max} = $1;
- $tot->{max} += $test->{max};
- $tot->{files}++;
- $test->{next} = 1 unless $test->{next};
- $test->{skip_reason} = $3 if not $test->{max} and defined $3;
-
- $is_header = 1;
- }
- else {
- $is_header = 0;
- }
+sub header_handler {
+ my($self, $line, $type, $totals) = @_;
- return $is_header;
-}
+ warn "Test header seen more than once!\n" if $self->{_seen_header};
+ $self->{_seen_header}++;
-sub _parse_test_line {
- my($line, $test, $tot) = @_;
-
- if ($line =~ /^(not\s+)?ok\b/i) {
- my $this = $test->{next} || 1;
- # "not ok 23"
- if ($line =~ /^(not )?ok\s*(\d*)(\s*#.*)?/) {
- my($not, $tnum, $extra) = ($1, $2, $3);
-
- $this = $tnum if $tnum;
-
- my($type, $reason) = $extra =~ /^\s*#\s*([Ss]kip\S*|TODO)(\s+.+)?/
- if defined $extra;
-
- my($istodo, $isskip);
- if( defined $type ) {
- $istodo = $type =~ /TODO/;
- $isskip = $type =~ /skip/i;
- }
-
- $test->{todo}{$tnum} = 1 if $istodo;
-
- 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;
-
- 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;
- }
-
- $test->{bonus}++, $tot->{bonus}++ if $test->{todo}{$this};
- }
- }
- # XXX ummm... dunno
- elsif ($line =~ /^ok\s*(\d*)\s*\#([^\r]*)$/) { # XXX multiline ok?
- $this = $1 if $1 > 0;
- print "$test->{ml}ok $this/$test->{max}" if $test->{ml};
- $test->{ok}++;
- $tot->{ok}++;
- }
- else {
- # an ok or not ok not matching the 3 cases above...
- # just ignore it for compatibility with TEST
- next;
- }
+ warn "1..M can only appear at the beginning or end of tests\n"
+ if $totals->{seen} &&
+ $totals->{max} < $totals->{seen};
+};
- if ($this > $test->{next}) {
- # print "Test output counter mismatch [test $this]\n";
- # no need to warn probably
- 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;
+sub test_handler {
+ my($self, $line, $type, $totals) = @_;
+
+ my $curr = $totals->{seen};
+ my $next = $self->{'next'};
+ my $max = $totals->{max};
+ my $detail = $totals->{details}[-1];
+
+ if( $detail->{ok} ) {
+ _print_ml_less("ok $curr/$max");
+
+ 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};
}
- $test->{next} = $this + 1;
+ }
+ else {
+ _print_ml("NOK $curr");
+ }
+ if( $curr > $next ) {
+ print "Test output counter mismatch [test $curr]\n";
}
- elsif ($line =~ /^Bail out!\s*(.*)/i) { # magic words
- die "FAILED--Further testing stopped" .
- ($1 ? ": $1\n" : ".\n");
+ elsif( $curr < $next ) {
+ print "Confused test output: test $curr answered after ".
+ "test ", $next - 1, "\n";
}
+
+};
+
+sub bailout_handler {
+ my($self, $line, $type, $totals) = @_;
+
+ die "FAILED--Further testing stopped" .
+ ($self->{bailout_reason} ? ": $self->{bailout_reason}\n" : ".\n");
+};
+
+
+sub _print_ml {
+ print join '', $ML, @_ if $ML;
}
+# Print updates only once per second.
+sub _print_ml_less {
+ my $now = CORE::time;
+ if ( $Last_ML_Print != $now ) {
+ _print_ml(@_);
+ $Last_ML_Print = $now;
+ }
+}
+
sub _bonusmsg {
my($tot) = @_;
my $bonusmsg = '';
$bonusmsg = (" ($tot->{bonus} subtest".($tot->{bonus} > 1 ? 's' : '').
- " UNEXPECTEDLY SUCCEEDED)")
- if $tot->{bonus};
+ " UNEXPECTEDLY SUCCEEDED)")
+ if $tot->{bonus};
if ($tot->{skipped}) {
- $bonusmsg .= ", $tot->{skipped} test"
+ $bonusmsg .= ", $tot->{skipped} test"
. ($tot->{skipped} != 1 ? 's' : '');
- if ($tot->{sub_skipped}) {
- $bonusmsg .= " and $tot->{sub_skipped} subtest"
- . ($tot->{sub_skipped} != 1 ? 's' : '');
- }
- $bonusmsg .= ' skipped';
+ if ($tot->{sub_skipped}) {
+ $bonusmsg .= " and $tot->{sub_skipped} subtest"
+ . ($tot->{sub_skipped} != 1 ? 's' : '');
+ }
+ $bonusmsg .= ' skipped';
}
elsif ($tot->{sub_skipped}) {
- $bonusmsg .= ", $tot->{sub_skipped} subtest"
- . ($tot->{sub_skipped} != 1 ? 's' : '')
- . " skipped";
+ $bonusmsg .= ", $tot->{sub_skipped} subtest"
+ . ($tot->{sub_skipped} != 1 ? 's' : '')
+ . " skipped";
}
-
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;
-
- open(my $fh, $test) or print "can't open $test. $!\n";
- my $first = <$fh>;
- my $s = $Switches;
- $s .= " $ENV{'HARNESS_PERL_SWITCHES'}"
- if exists $ENV{'HARNESS_PERL_SWITCHES'};
- $s .= join " ", q[ "-T"], map {qq["-I$_"]} @INC
- if $first =~ /^#!.*\bperl.*-\w*T/;
-
- close($fh) or print "can't close $test. $!\n";
-
- return $s;
-}
-
-
# Test program go boom.
sub _dubious_return {
my($test, $tot, $estatus, $wstatus) = @_;
- my ($failed, $canon, $percent) = ('??', '??');
+
+ my $failed = '??';
+ my $canon = '??';
printf "$test->{ml}dubious\n\tTest returned status $estatus ".
"(wstat %d, 0x%x)\n",
$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}) {
- if ($test->{next} == $test->{max} + 1 and not @{$test->{failed}}) {
+ if ($test->{'next'} == $test->{max} + 1 and not @{$test->{failed}}) {
print "\tafter all the subtests completed successfully\n";
- $percent = 0;
- $failed = 0; # But we do not set $canon!
+ $failed = 0; # But we do not set $canon!
}
else {
- push @{$test->{failed}}, $test->{next}..$test->{max};
+ push @{$test->{failed}}, $test->{'next'}..$test->{max};
$failed = @{$test->{failed}};
- (my $txt, $canon) = canonfailed($test->{max},$test->{skipped},@{$test->{failed}});
- $percent = 100*(scalar @{$test->{failed}})/$test->{max};
+ (my $txt, $canon) = _canondetail($test->{max},$test->{skipped},'Failed',@{$test->{failed}});
print "DIED. ",$txt;
}
}
return { canon => $canon, max => $test->{max} || '??',
failed => $failed,
- percent => $percent,
estat => $estatus, wstat => $wstatus,
};
}
-sub _garbled_output {
- my($gibberish) = shift;
- warn "Confusing test output: '$gibberish'\n";
-}
-
-
sub _create_fmts {
- my($failedtests) = @_;
+ my $failed_str = shift;
+ my $failedtests = shift;
- my $failed_str = "Failed Test "; # Borrow up to 3 chars from Status
- my $middle_str = " Status Wstat Total Fail Failed ";
- my $list_str = "List of Failed";
+ my ($type) = split /\s/,$failed_str;
+ my $short = substr($type,0,4);
+ my $total = $short eq 'Pass' ? 'TODOs' : 'Total';
+ my $middle_str = " Stat Wstat $total $short ";
+ my $list_str = "List of $type";
# Figure out our longest name string for formatting purposes.
my $max_namelen = length($failed_str);
}
}
- my $failed_len = $max_namelen - 3;
- my $fmt_top = "format STDOUT_TOP =\n"
- . sprintf("%-${failed_len}s", "Failed Test")
+ my $fmt_top = sprintf("%-${max_namelen}s", $failed_str)
. $middle_str
- . $list_str . "\n"
- . "-" x $Columns
- . "\n.\n";
-
- my $fmt = "format STDOUT =\n"
- . "@" . "<" x ($max_namelen - 1)
- . " @>> @>>>> @>>>> @>>> ^##.##% "
- . "^" . "<" x ($list_len - 1) . "\n"
- . '{ $Curtest->{name}, $Curtest->{estat},'
- . ' $Curtest->{wstat}, $Curtest->{max},'
- . ' $Curtest->{failed}, $Curtest->{percent},'
- . ' $Curtest->{canon}'
- . "\n}\n"
- . "~~" . " " x ($Columns - $list_len - 2) . "^"
- . "<" x ($list_len - 1) . "\n"
- . '$Curtest->{canon}'
- . "\n.\n";
-
- eval $fmt_top;
- die $@ if $@;
- eval $fmt;
- die $@ if $@;
-
- return($fmt_top, $fmt);
-}
-
+ . $list_str . "\n"
+ . "-" x $Columns
+ . "\n";
-my $tried_devel_corestack;
-sub corestatus {
- my($st) = @_;
+ my $fmt1 = "@" . "<" x ($max_namelen - 1)
+ . " @>> @>>>> @>>>> @>>> "
+ . "^" . "<" x ($list_len - 1) . "\n";
+ my $fmt2 = "~~" . " " x ($Columns - $list_len - 2) . "^"
+ . "<" x ($list_len - 1) . "\n";
- eval {require 'wait.ph'};
- my $ret = defined &WCOREDUMP ? WCOREDUMP($st) : $st & 0200;
-
- eval { require Devel::CoreStack; $Have_Devel_Corestack++ }
- unless $tried_devel_corestack++;
-
- $ret;
+ return($fmt_top, $fmt1, $fmt2);
}
-sub canonfailed ($@) {
- my($max,$skipped,@failed) = @_;
+sub _canondetail {
+ my $max = shift;
+ my $skipped = shift;
+ my $type = shift;
+ my @detail = @_;
my %seen;
- @failed = sort {$a <=> $b} grep !$seen{$_}++, @failed;
- my $failed = @failed;
+ @detail = sort {$a <=> $b} grep !$seen{$_}++, @detail;
+ my $detail = @detail;
my @result = ();
my @canon = ();
my $min;
- my $last = $min = shift @failed;
+ my $last = $min = shift @detail;
my $canon;
- if (@failed) {
- for (@failed, $failed[-1]) { # don't forget the last one
- if ($_ > $last+1 || $_ == $last) {
- if ($min == $last) {
- push @canon, $last;
- } else {
- push @canon, "$min-$last";
- }
- $min = $_;
- }
- $last = $_;
- }
- local $" = ", ";
- push @result, "FAILED tests @canon\n";
- $canon = "@canon";
- } else {
- push @result, "FAILED test $last\n";
- $canon = $last;
+ my $uc_type = uc($type);
+ if (@detail) {
+ for (@detail, $detail[-1]) { # don't forget the last one
+ if ($_ > $last+1 || $_ == $last) {
+ push @canon, ($min == $last) ? $last : "$min-$last";
+ $min = $_;
+ }
+ $last = $_;
+ }
+ local $" = ", ";
+ push @result, "$uc_type tests @canon\n";
+ $canon = join ' ', @canon;
+ }
+ else {
+ push @result, "$uc_type test $last\n";
+ $canon = $last;
}
- push @result, "\tFailed $failed/$max tests, ";
- push @result, sprintf("%.2f",100*(1-$failed/$max)), "% okay";
+ return (join("", @result), $canon)
+ if $type=~/todo/i;
+ push @result, "\t$type $detail/$max tests, ";
+ if ($max) {
+ push @result, sprintf("%.2f",100*(1-$detail/$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 - $detail - $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);
+ return ($txt, $canon);
}
1;
__END__
-=head1 NAME
-Test::Harness - run perl standard test scripts with statistics
+=head1 EXPORT
-=head1 SYNOPSIS
+C<&runtests> is exported by Test::Harness by default.
- use Test::Harness;
+C<&execute_tests>, C<$verbose>, C<$switches> and C<$debug> are
+exported upon request.
- runtests(@test_files);
+=head1 DIAGNOSTICS
-=head1 DESCRIPTION
+=over 4
-(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!)
+=item C<All tests successful.\nFiles=%d, Tests=%d, %s>
-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.
+If all tests are successful some statistics about the performance are
+printed.
-After all tests have been performed, runtests() prints some
-performance statistics that are computed by the Benchmark module.
+=item C<FAILED tests %s\n\tFailed %d/%d tests, %.2f%% okay.>
-=head2 The test script output
+For any single script that has failing subtests statistics like the
+above are printed.
-The following explains how Test::Harness interprets the output of your
-test program.
+=item C<Test returned status %d (wstat %d)>
-=over 4
+Scripts that return a non-zero exit status, both C<$? E<gt>E<gt> 8>
+and C<$?> are printed in a message similar to the above.
-=item B<'1..M'>
+=item C<Failed 1 test, %.2f%% okay. %s>
-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).
+=item C<Failed %d/%d tests, %.2f%% okay. %s>
-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.
+If not all tests were successful, the script dies with one of the
+above messages.
-Under B<no> circumstances should 1..M appear in the middle of your
-output or more than once.
+=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.
-=item B<'ok', 'not ok'. Ok?>
+=back
-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.
+=head1 ENVIRONMENT VARIABLES THAT TEST::HARNESS SETS
-C</^not ok/> indicates a failed test. C</^ok/> is a successful test.
+Test::Harness sets these before executing the individual tests.
+=over 4
-=item B<test numbers>
+=item C<HARNESS_ACTIVE>
-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
+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.
- print <<END;
- 1..6
- not ok
- ok
- not ok
- ok
- ok
- END
+=item C<HARNESS_VERSION>
-will generate
+This is the version of Test::Harness.
- FAILED tests 1, 3, 6
- Failed 3/6 tests, 50.00% okay
+=back
+=head1 ENVIRONMENT VARIABLES THAT AFFECT TEST::HARNESS
-=item B<$Test::Harness::verbose>
+=over 4
-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.
+=item C<HARNESS_COLUMNS>
-=item B<$Test::Harness::switches>
+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.
-The global variable $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>.
+=item C<HARNESS_COMPILE_TEST>
-=item B<Skipping tests>
+When true it will make harness attempt to compile the test using
+C<perlcc> before running it.
-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.
+B<NOTE> This currently only works when sitting in the perl source
+directory!
- ok 23 # skip Insufficient flogiston pressure.
+=item C<HARNESS_DEBUG>
-Similarly, one can include a similar explanation in a C<1..0> line
-emitted if the test script is skipped completely:
+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.
- 1..0 # Skipped: no leverage found
+=item C<HARNESS_FILELEAK_IN_DIR>
-=item B<Todo tests>
+When set to the name of a directory, harness will check after each
+test whether new files appeared in that directory, and report them as
-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.
+ LEAKED FILES: scr.tmp 0 my.db
- not ok 13 # TODO harness the power of the atom
+If relative, directory name is with respect to the current directory at
+the moment runtests() was called. Putting absolute path into
+C<HARNESS_FILELEAK_IN_DIR> may give more predictable results.
-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 C<HARNESS_NOTTY>
-=item B<Bail out!>
+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.
-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
+If you're using the F<prove> utility, you can use the C<--perl> switch.
- Bail out!
+=item C<HARNESS_PERL_SWITCHES>
-to standard output. Any message after these words will be displayed by
-C<Test::Harness> as the reason why testing is stopped.
+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_TIMER>
-=item B<Comments>
+Setting this to true will make the harness display the number of
+milliseconds each test took. You can also use F<prove>'s C<--timer>
+switch.
-Additional comments may be put into the testing output on their own
-lines. Comment lines should begin with a '#', Test::Harness will
-ignore them.
+=item C<HARNESS_VERBOSE>
- ok 1
- # Life is good, the sun is shining, RAM is cheap.
- not ok 2
- # got 'Bush' expected 'Gore'
+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 EXPORT
+=head1 EXAMPLE
-C<&runtests> is exported by Test::Harness per default.
+Here's how Test::Harness tests itself
-C<$verbose> and C<$switches> are exported upon request.
+ $ cd ~/src/devel/Test-Harness
+ $ perl -Mblib -e 'use Test::Harness qw(&runtests $verbose);
+ $verbose=0; runtests @ARGV;' t/*.t
+ Using /home/schwern/src/devel/Test-Harness/blib
+ t/base..............ok
+ t/nonumbers.........ok
+ t/ok................ok
+ t/test-harness......ok
+ All tests successful.
+ Files=4, Tests=24, 2 wallclock secs ( 0.61 cusr + 0.41 csys = 1.02 CPU)
+=head1 SEE ALSO
-=head1 DIAGNOSTICS
+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, and L<Devel::Cover> for test coverage
+analysis.
-=over 4
+=head1 TODO
-=item C<All tests successful.\nFiles=%d, Tests=%d, %s>
+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. (Partially done in Test::Harness::Straps)
-If all tests are successful some statistics about the performance are
-printed.
+Document the format.
-=item C<FAILED tests %s\n\tFailed %d/%d tests, %.2f%% okay.>
+Fix HARNESS_COMPILE_TEST without breaking its core usage.
-For any single script that has failing subtests statistics like the
-above are printed.
+Figure a way to report test names in the failure summary.
-=item C<Test returned status %d (wstat %d)>
+Rework the test summary so long test names are not truncated as badly.
+(Partially done with new skip test styles)
-Scripts that return a non-zero exit status, both C<$? E<gt>E<gt> 8>
-and C<$?> are printed in a message similar to the above.
+Add option for coverage analysis.
-=item C<Failed 1 test, %.2f%% okay. %s>
+Trap STDERR.
-=item C<Failed %d/%d tests, %.2f%% okay. %s>
+Implement Straps total_results()
-If not all tests were successful, the script dies with one of the
-above messages.
+Remember exit code
-=item C<FAILED--Further testing stopped%s>
+Completely redo the print summary code.
-If a single subtest decides that further testing will not make sense,
-the script dies with this message.
+Implement Straps callbacks. (experimentally implemented)
-=back
+Straps->analyze_file() not taint clean, don't know if it can be
-=head1 ENVIRONMENT
+Fix that damned VMS nit.
-=over 4
+Add a test for verbose.
-=item C<HARNESS_IGNORE_EXITCODE>
+Change internal list of test results to a hash.
-Makes harness ignore the exit status of child processes when defined.
+Fix stats display when there's an overrun.
-=item C<HARNESS_NOTTY>
+Fix so perls with spaces in the filename work.
-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).
+Keeping whittling away at _run_all_tests()
-=item C<HARNESS_COMPILE_TEST>
+Clean up how the summary is printed. Get rid of those damned formats.
-When true it will make harness attempt to compile the test using
-C<perlcc> before running it.
+=head1 BUGS
-=item C<HARNESS_FILELEAK_IN_DIR>
+Please report any bugs or feature requests to
+C<bug-test-harness at rt.cpan.org>, or through the web interface at
+L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Test-Harness>.
+I will be notified, and then you'll automatically be notified of progress on
+your bug as I make changes.
-When set to the name of a directory, harness will check after each
-test whether new files appeared in that directory, and report them as
+=head1 SUPPORT
- LEAKED FILES: scr.tmp 0 my.db
+You can find documentation for this module with the F<perldoc> command.
-If relative, directory name is with respect to the current directory at
-the moment runtests() was called. Putting absolute path into
-C<HARNESS_FILELEAK_IN_DIR> may give more predicatable results.
+ perldoc Test::Harness
-=item C<HARNESS_PERL_SWITCHES>
+You can get docs for F<prove> with
-Its value will be prepended to the switches used to invoke perl on
-each test. For example, setting C<HARNESS_PERL_SWITCHES> to "-W" will
-run all tests with all warnings enabled.
+ prove --man
-=item C<HARNESS_COLUMNS>
+You can also look for information at:
-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.
+=over 4
-=item C<HARNESS_ACTIVE>
+=item * AnnoCPAN: Annotated CPAN documentation
-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.
+L<http://annocpan.org/dist/Test-Harness>
-=back
+=item * CPAN Ratings
+L<http://cpanratings.perl.org/d/Test-Harness>
-=head1 SEE ALSO
+=item * RT: CPAN's request tracker
+
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Test-Harness>
+
+=item * Search CPAN
+
+L<http://search.cpan.org/dist/Test-Harness>
+
+=back
+
+=head1 SOURCE CODE
-L<Test> for writing test scripts, L<Benchmark> for the underlying
-timing routines and L<Devel::Coverage> for test coverage analysis.
+The source code repository for Test::Harness is at
+L<http://svn.perl.org/modules/Test-Harness>.
=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
+sure is, that it was inspired by Larry Wall's F<TEST> script that came
with perl distributions for ages. Numerous anonymous contributors
-exist.
+exist. Andreas Koenig held the torch for many years, and then
+Michael G Schwern.
-Current maintainers are Andreas Koenig <andreas.koenig@anima.de> and
-Michael G Schwern <schwern@pobox.com>
+Current maintainer is Andy Lester C<< <andy at petdance.com> >>.
-=head1 BUGS
+=head1 COPYRIGHT
+
+Copyright 2002-2006
+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.
-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.
+See L<http://www.perl.com/perl/misc/Artistic.html>.
=cut
projects / p5sagit/p5-mst-13.2.git / blobdiff