package Test::Harness;
+use 5.002;
use Exporter;
use Benchmark;
use Config;
use FileHandle;
-use vars qw($VERSION $verbose $switches);
-require 5.002;
+use vars qw($VERSION $verbose $switches $have_devel_corestack);
+$have_devel_corestack = 0;
-$VERSION = "1.07";
+$VERSION = "1.12";
@ISA=('Exporter');
@EXPORT= qw(&runtests);
if( $verbose ){
print $_;
}
- unless (/^\s*\#/) {
- if (/^1\.\.([0-9]+)/) {
- $max = $1;
- $totmax += $max;
- $files++;
- $next = 1;
- } elsif ($max && /^(not\s+)?ok\b/) {
- my $this = $next;
- if (/^not ok\s*(\d*)/){
- $this = $1 if $1 > 0;
- push @failed, $this;
- } elsif (/^ok\s*(\d*)/) {
- $this = $1 if $1 > 0;
- $ok++;
- $totok++;
- }
- if ($this > $next) {
- # warn "Test output counter mismatch [test $this]\n";
- # no need to warn probably
- push @failed, $next..$this-1;
- } elsif ($this < $next) {
- #we have seen more "ok" lines than the number suggests
- warn "Aborting test: output counter mismatch [test $this answered when test $next expected]\n";
- last;
- }
- $next = $this + 1;
+ if (/^1\.\.([0-9]+)/) {
+ $max = $1;
+ $totmax += $max;
+ $files++;
+ $next = 1;
+ } elsif ($max && /^(not\s+)?ok\b/) {
+ my $this = $next;
+ if (/^not ok\s*(\d*)/){
+ $this = $1 if $1 > 0;
+ push @failed, $this;
+ } elsif (/^ok\s*(\d*)/) {
+ $this = $1 if $1 > 0;
+ $ok++;
+ $totok++;
}
+ if ($this > $next) {
+ # warn "Test output counter mismatch [test $this]\n";
+ # no need to warn probably
+ push @failed, $next..$this-1;
+ } elsif ($this < $next) {
+ #we have seen more "ok" lines than the number suggests
+ warn "Confused test output: test $this answered after test ", $next-1, "\n";
+ $next = $this;
+ }
+ $next = $this + 1;
}
}
$fh->close; # must close to reap child resource values
my $wstatus = $?;
- my $estatus = $wstatus >> 8;
- if ($ok == $max && $next == $max+1 && ! $estatus) {
- print "ok\n";
+ my $estatus = $^O eq 'VMS' ? $wstatus : $wstatus >> 8;
+ if ($^O eq 'VMS' ? !($wstatus & 1) : $wstatus) {
+ print "dubious\n\tTest returned status $estatus (wstat $wstatus)\n";
+ 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";
+ }
+ }
+ $bad++;
+ } elsif ($ok == $max && $next == $max+1) {
+ if ($max) {
+ print "ok\n";
+ } else {
+ print "skipping test on this platform\n";
+ }
$good++;
} elsif ($max) {
if ($next <= $max) {
if (@failed) {
print canonfailed($max,@failed);
} else {
- print "Don't know which tests failed for some reason\n";
+ print "Don't know which tests failed: got $ok ok, expected $max\n";
}
$bad++;
} elsif ($next == 0) {
print "FAILED before any test output arrived\n";
$bad++;
}
- if ($wstatus) {
- print "\tTest returned status $estatus (wstat $wstatus)\n";
- }
}
my $t_total = timediff(new Benchmark, $t_start);
die "FAILED--no tests were run for some reason.\n";
} elsif ($totmax==0) {
my $blurb = $total==1 ? "script" : "scripts";
- die "FAILED--$total test $blurb could be run, alas -- no output ever seen\n";
+ die "FAILED--$total test $blurb could be run, alas--no output ever seen\n";
} else {
$pct = sprintf("%.2f", $good / $total * 100);
my $subpct = sprintf " %d/%d subtests failed, %.2f%% okay.",
printf("Files=%d, Tests=%d, %s\n", $files, $totmax, timestr($t_total, 'nop'));
}
+sub corestatus {
+ my($st) = @_;
+ my($ret);
+
+ eval {require 'wait.ph'};
+ if ($@) {
+ SWITCH: {
+ $ret = ($st & 0200); # Tim says, this is for 90%
+ }
+ } else {
+ $ret = WCOREDUMP($st);
+ }
+
+ eval {require Devel::CoreStack};
+ $have_devel_corestack++ unless $@;
+
+ $ret;
+}
+
sub canonfailed ($@) {
my($max,@failed) = @_;
my %seen;
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 scxript is C<"1..M"> with C<M> being the
+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::runscripts(@tests) runs all the testscripts
+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, runscripts() prints some
+After all tests have been performed, runtests() prints some
performance statistics that are computed by the Benchmark module.
=head2 The test script output
Any output from the testscript to standard error is ignored and
bypassed, thus will be seen by the user. Lines written to standard
-output that look like perl comments (start with C</^\s*\#/>) are
-discarded. Lines containing C</^(not\s+)?ok\b/> are interpreted as
-feedback for runtests().
+output containing C</^(not\s+)?ok\b/> are interpreted as feedback for
+runtests(). All other lines are discarded.
It is tolerated if the test numbers after C<ok> are omitted. In this
case Test::Harness maintains temporarily its own counter until the
Failed 3/6 tests, 50.00% okay
The global variable $Test::Harness::verbose is exportable and can be
-used to let runscripts() display the standard output of the script
+used to let runtests() display the standard output of the script
without altering the behavior otherwise.
=head1 EXPORT
-C<&runscripts> is exported by Test::Harness per default.
+C<&runtests> is exported by Test::Harness per default.
=head1 DIAGNOSTICS
projects / p5sagit/p5-mst-13.2.git / commitdiff