Test-Harness breaks libwww-perl, Sorry
Andreas Koenig (k@anna.mind.de)
Wed, 7 Feb 1996 15:37:50 +0100
Gisle,
indeed there was still an incompatibility in Test-Harness against the
original version. Triggered by your test scripts. (Background: You
sometimes print "HTTP::Date 1.11 tested ok" and Harness took that as
an "ok" with the number of the test missing.)
1.07, just uploaded to CPAN, fixes that. A patch against beta3 follows
below. This also introduces the hexameterized FAILED message ;-)
Test-Harness still accepts "ok" and "not ok" lines without a number
following and maintains its own counter in such cases. The regex of
interpreted test feedback now is /^(not\s+)?ok\b/ . I consider this a
feature. If anybody thinks it is a misfeature, please speak up.
With this Harness I get:
base/afm............ok
base/base64.........ok
base/date...........ok
base/entities.......ok
base/headers........ok
base/html-parse.....ok
base/mailcap........ok
base/mediatypes.....ok
base/message........ok
base/quoted-print...ok
base/robot-rules....ok
base/status.........ok
base/uri............ok
local/autoload......FAILED test 1
Failed 1/1 tests, 0.00% okay
local/get...........ok
Failed 1 test script, 93.33% okay. 1/390 subtests failed, 99.74% okay.
More about the failure in a separate message.
Regards,
andreas
cd ~/sources/Test-Harness/
diff -c /usr/sources/perl/perl/perl5.002b3/lib/Test/Harness.pm /usr/people/k/sources/Test-Harness/lib/Test/Harness.pm
*** /usr/sources/perl/perl/perl5.002b3/lib/Test/Harness.pm Sat Jan 27 01:06:10 1996
--- /usr/people/k/sources/Test-Harness/lib/Test/Harness.pm Wed Feb 7 15:18:25 1996
***************
*** 3,24 ****
use Exporter;
use Benchmark;
use Config;
require 5.002;
! $VERSION = $VERSION = "1.02";
@ISA=('Exporter');
@EXPORT= qw(&runtests);
@EXPORT_OK= qw($verbose $switches);
! $Test::Harness::verbose = 0;
! $Test::Harness::switches = "-w";
sub runtests {
my(@tests) = @_;
local($|) = 1;
! my($test,$te,$ok,$next,$max,$totmax, $files,$pct,@failed);
my $bad = 0;
my $good = 0;
my $total = @tests;
--- 3,28 ----
use Exporter;
use Benchmark;
use Config;
+ use FileHandle;
+ use vars qw($VERSION $verbose $switches);
require 5.002;
! $VERSION = "1.07";
@ISA=('Exporter');
@EXPORT= qw(&runtests);
@EXPORT_OK= qw($verbose $switches);
! $verbose = 0;
! $switches = "-w";
sub runtests {
my(@tests) = @_;
local($|) = 1;
! my($test,$te,$ok,$next,$max,$pct);
! my $totmax = 0;
! my $files = 0;
my $bad = 0;
my $good = 0;
my $total = @tests;
***************
*** 29,96 ****
$te = $test;
chop($te);
print "$te" . '.' x (20 - length($te));
! my $fh = "RESULTS";
! open($fh,"$^X $Test::Harness::switches $test|") || (print "can't run. $!\n");
$ok = $next = $max = 0;
@failed = ();
while (<$fh>) {
! if( $Test::Harness::verbose ){
print $_;
}
! unless (/^\#/) {
if (/^1\.\.([0-9]+)/) {
$max = $1;
$totmax += $max;
$files++;
$next = 1;
! } elsif ($max) {
! if (/^not ok ([0-9]*)/){
! push @failed, $next;
! } elsif (/^ok (.*)/ && $1 == $next) {
$ok++;
}
! $next = $1 + 1;
}
}
}
! close($fh); # must close to reap child resource values
my $wstatus = $?;
my $estatus = $wstatus >> 8;
! $next-- if $next;
! if ($ok == $max && $next == $max && ! $wstatus) {
print "ok\n";
$good++;
! } else {
if (@failed) {
print canonfailed($max,@failed);
} else {
! if ($next == 0) {
! print "FAILED before any test output arrived\n";
! } else {
! print canonfailed($max,$next+1..$max);
! }
! }
! if ($wstatus) {
! print "\tTest returned status $estatus (wstat $wstatus)\n";
}
$bad++;
! $_ = $test;
}
}
my $t_total = timediff(new Benchmark, $t_start);
! if ($bad == 0) {
! if ($ok) {
print "All tests successful.\n";
! } else {
! die "FAILED--no tests were run for some reason.\n";
! }
} else {
$pct = sprintf("%.2f", $good / $total * 100);
if ($bad == 1) {
! die "Failed 1 test script, $pct% okay.\n";
} else {
! die "Failed $bad/$total test scripts, $pct% okay.\n";
}
}
printf("Files=%d, Tests=%d, %s\n", $files, $totmax, timestr($t_total, 'nop'));
--- 33,116 ----
$te = $test;
chop($te);
print "$te" . '.' x (20 - length($te));
! my $fh = new FileHandle;
! $fh->open("$^X $switches $test|") || (print "can't run. $!\n");
$ok = $next = $max = 0;
@failed = ();
while (<$fh>) {
! 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;
}
}
}
! $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";
$good++;
! } elsif ($max) {
! if ($next <= $max) {
! push @failed, $next..$max;
! }
if (@failed) {
print canonfailed($max,@failed);
} else {
! print "Don't know which tests failed for some reason\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);
! if ($bad == 0 && $totmax) {
print "All tests successful.\n";
! } elsif ($total==0){
! 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";
} else {
$pct = sprintf("%.2f", $good / $total * 100);
+ my $subpct = sprintf " %d/%d subtests failed, %.2f%% okay.",
+ $totmax - $totok, $totmax, 100*$totok/$totmax;
if ($bad == 1) {
! die "Failed 1 test script, $pct% okay.$subpct\n";
} else {
! die "Failed $bad/$total test scripts, $pct% okay.$subpct\n";
}
}
printf("Files=%d, Tests=%d, %s\n", $files, $totmax, timestr($t_total, 'nop'));
***************
*** 98,103 ****
--- 118,125 ----
sub canonfailed ($@) {
my($max,@failed) = @_;
+ my %seen;
+ @failed = sort {$a <=> $b} grep !$seen{$_}++, @failed;
my $failed = @failed;
my @result = ();
my @canon = ();
***************
*** 152,157 ****
--- 174,209 ----
After all tests have been performed, runscripts() 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().
+
+ It is tolerated if the test numbers after C<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
+
+ The global variable $Test::Harness::verbose is exportable and can be
+ used to let runscripts() display the standard output of the script
+ without altering the behavior otherwise.
+
=head1 EXPORT
C<&runscripts> is exported by Test::Harness per default.
***************
*** 165,173 ****
If all tests are successful some statistics about the performance are
printed.
! =item C<Failed 1 test, $pct% okay.>
! =item C<Failed %d/%d tests, %.2f%% okay.>
If not all tests were successful, the script dies with one of the
above messages.
--- 217,235 ----
If all tests are successful some statistics about the performance are
printed.
! =item C<FAILED tests %s\n\tFailed %d/%d tests, %.2f%% okay.>
!
! For any single script that has failing subtests statistics like the
! above are printed.
!
! =item C<Test returned status %d (wstat %d)>
!
! Scripts that return a non-zero exit status, both $?>>8 and $? are
! printed in a message similar to the above.
!
! =item C<Failed 1 test, %.2f%% okay. %s>
! =item C<Failed %d/%d tests, %.2f%% okay. %s>
If not all tests were successful, the script dies with one of the
above messages.
***************
*** 188,196 ****
=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.
=cut
--- 250,258 ----
=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.
=cut