# -*- Mode: cperl; cperl-indent-level: 4 -*-
-# $Id: Harness.pm,v 1.14.2.13 2002/01/07 22:34:32 schwern Exp $
+# $Id: Harness.pm,v 1.14.2.18 2002/04/25 05:04:35 schwern Exp $
package Test::Harness;
$Have_Devel_Corestack = 0;
-$VERSION = '2.01';
+$VERSION = '2.03';
$ENV{HARNESS_ACTIVE} = 1;
my $Files_In_Dir = $ENV{HARNESS_FILELEAK_IN_DIR};
-my $Running_In_Perl_Tree = 0;
-++$Running_In_Perl_Tree if -d "../t" and -f "../sv.c";
-
my $Strap = Test::Harness::Straps->new;
@ISA = ('Exporter');
@EXPORT = qw(&runtests);
@EXPORT_OK = qw($verbose $switches);
-$Verbose = 0;
+$Verbose = $ENV{HARNESS_VERBOSE} || 0;
$Switches = "-w";
$Columns = $ENV{HARNESS_COLUMNS} || $ENV{COLUMNS} || 80;
$Columns--; # Some shells have trouble with a full line of text.
=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 it is okay if it is preceded
-by comments).
+This header tells how many tests there will be. For example, C<1..10>
+means you plan on running 10 tests. This is a safeguard in case your
+test dies quietly in the middle of its run.
+
+It should be the first non-comment line output by your test program.
-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.
+In certain instances, you may not know how many tests you will
+ultimately be running. In this case, it is permitted for the 1..M
+header to appear as the B<last> line output by your test (again, it
+can be followed by further comments).
Under B<no> circumstances should 1..M appear in the middle of your
output or more than once.
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.
+for skipping.
ok 23 # skip Insufficient flogiston pressure.
my $fh = _open_test($tfile);
+ $tot{files}++;
+
# state of the current test.
my %test = (
ok => 0,
chomp($te);
$te =~ s/\.\w+$/./;
- if ($^O eq 'VMS') {
- $te =~ s/^.*\.t\./\[.t./s;
- }
- $te =~ s,\\,/,g if $^O eq 'MSWin32';
- $te =~ s,^\.\./,/, if $Running_In_Perl_Tree;
+ if ($^O eq 'VMS') { $te =~ s/^.*\.t\./\[.t./s; }
my $blank = (' ' x 77);
my $leader = "$te" . '.' x ($width - length($te));
my $ml = "";
foreach (@_) {
my $suf = /\.(\w+)$/ ? $1 : '';
my $len = length;
- $len -= 2 if $Running_In_Perl_Tree and m{^\.\.[/\\]};
my $suflen = length $suf;
$maxlen = $len if $len > $maxlen;
$maxsuflen = $suflen if $suflen > $maxsuflen;
}
- # we want three dots between the test name and the "ok" for
- # typical lengths, and just two dots if longer than 30 characters
- $maxlen -= $maxsuflen;
- return $maxlen + ($maxlen >= 30 ? 2 : 3);
+ # + 3 : we want three dots between the test name and the "ok"
+ return $maxlen + 3 - $maxsuflen;
}
$tot->{max} += $test->{max};
- $tot->{files}++;
}
else {
$is_header = 0;
my $s = _set_switches($test);
+ my $perl = -x $^X ? $^X : $Config{perlpath};
+
# 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|";
+ : "$perl $s $test|";
$cmd = "MCR $cmd" if $^O eq 'VMS';
if( open(PERL, $cmd) ) {
}
$test->{todo}{$this} = 1 if $istodo;
+ if( $test->{todo}{$this} ) {
+ $tot->{todo}++;
+ $test->{bonus}++, $tot->{bonus}++ unless $not;
+ }
- $tot->{todo}++ if $test->{todo}{$this};
-
- if( $not ) {
+ if( $not && !$test->{todo}{$this} ) {
print "$test->{ml}NOK $this" if $test->{ml};
- if (!$test->{todo}{$this}) {
- push @{$test->{failed}}, $this;
- } else {
- $test->{ok}++;
- $tot->{ok}++;
- }
+ push @{$test->{failed}}, $this;
}
else {
print "$test->{ml}ok $this/$test->{max}" if $test->{ml};
} elsif (defined $reason) {
$test->{skip_reason} = $reason;
}
-
- $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;
+
+ # Guard against resource starvation.
+ if( $this > 100000 ) {
+ print "Enourmous test number seen [test $this]\n";
+ }
+ else {
+ push @{$test->{failed}}, $test->{'next'}..$this-1;
+ }
}
elsif ($this < $test->{'next'}) {
#we have seen more "ok" lines than the number suggests
sub corestatus {
my($st) = @_;
- eval {require 'wait.ph'};
- my $ret = defined &WCOREDUMP ? WCOREDUMP($st) : $st & 0200;
+ eval {
+ local $^W = 0; # *.ph files are often *very* noisy
+ require 'wait.ph'
+ };
+ return if $@;
+ my $did_core = defined &WCOREDUMP ? WCOREDUMP($st) : $st & 0200;
eval { require Devel::CoreStack; $Have_Devel_Corestack++ }
unless $tried_devel_corestack++;
- $ret;
+ return $did_core;
}
}
=over 4
-=item C<HARNESS_IGNORE_EXITCODE>
+=item C<HARNESS_ACTIVE>
-Makes harness ignore the exit status of child processes when defined.
+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.
-=item C<HARNESS_NOTTY>
+=item C<HARNESS_COLUMNS>
-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 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>
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_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>
+=item C<HARNESS_VERBOSE>
-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>
-
-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 $Test::Harness::verbose will override this.
=back
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)
Fix HARNESS_COMPILE_TEST without breaking its core usage.
Rework the test summary so long test names are not truncated as badly.
-Merge back into bleadperl.
-
Deal with VMS's "not \nok 4\n" mistake.
Add option for coverage analysis.
=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 it is run from the Perl source
+HARNESS_COMPILE_TEST currently assumes it's run from the Perl source
directory.
=cut
# -*- Mode: cperl; cperl-indent-level: 4 -*-
-# $Id: Straps.pm,v 1.1.2.17 2002/01/07 22:34:33 schwern Exp $
+# $Id: Straps.pm,v 1.1.2.20 2002/04/25 05:04:35 schwern Exp $
package Test::Harness::Straps;
use strict;
use vars qw($VERSION);
use Config;
-$VERSION = '0.08';
+$VERSION = '0.09';
use Test::Harness::Assert;
use Test::Harness::Iterator;
last if $self->{saw_bailout};
}
+ $totals{skip_all} = $self->{skip_all} if defined $self->{skip_all};
+
my $passed = $totals{skip_all} ||
- ($totals{max} == $totals{seen} &&
+ ($totals{max} && $totals{seen} &&
+ $totals{max} == $totals{seen} &&
$totals{max} == $totals{ok});
$totals{passing} = $passed ? 1 : 0;
- $totals{skip_all} = $self->{skip_all} if defined $self->{skip_all};
-
$self->{totals}{$name} = \%totals;
return %totals;
}
$totals->{ok}++ if $pass;
- $totals->{details}[$result{number} - 1] =
+ if( $result{number} > 100000 ) {
+ warn "Enourmous test number seen [test $result{number}]\n";
+ warn "Can't detailize, too big.\n";
+ }
+ else {
+ $totals->{details}[$result{number} - 1] =
{$self->_detailize($pass, \%result)};
+ }
# XXX handle counter mismatch
}
my %results = $strap->analyze_file($test_file);
-Like C<analyze>, but it reads from the given $test_file. It will also
-use that name for the total report.
+Like C<analyze>, but it runs the given $test_file and parses it's
+results. It will also use that name for the total report.
=cut
}
my %results = $self->analyze_fh($file, \*FILE);
- close FILE;
+ my $exit = close FILE;
+ $results{'wait'} = $?;
+ $results{'exit'} = $? / 256;
+ $results{passing} = 0 unless $? == 0;
$self->_restore_PERL5LIB();
passing true if the whole test is considered a pass
(or skipped), false if its a failure
+ exit the exit code of the test run, if from a file
+ wait the wait code of the test run, if from a file
+
max total tests which should have been run
seen total tests actually seen
skip_all if the whole test was skipped, this will
-#!/usr/bin/perl
+#!/usr/bin/perl -w
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
- @INC = '../lib';
+ @INC = ('../lib', 'lib');
+ }
+ else {
+ unshift @INC, 't/lib';
}
}
package main;
-# Utility testing functions.
-my $test_num = 1;
-sub ok ($;$) {
- my($test, $name) = @_;
- my $okstring = '';
- $okstring = "not " unless $test;
- $okstring .= "ok $test_num";
- $okstring .= " - $name" if defined $name;
- print "$okstring\n";
- $test_num++;
-}
-
-sub eqhash {
- my($a1, $a2) = @_;
- return 0 unless keys %$a1 == keys %$a2;
-
- my $ok = 1;
- foreach my $k (keys %$a1) {
- $ok = $a1->{$k} eq $a2->{$k};
- last unless $ok;
- }
-
- return $ok;
-}
+use Test::More;
use vars qw($Total_tests %samples);
-my $loaded;
-BEGIN { $| = 1; $^W = 1; }
-END {print "not ok $test_num\n" unless $loaded;}
-print "1..$Total_tests\n";
+plan tests => $Total_tests;
use Test::Harness;
-$loaded = 1;
-ok(1, 'compile');
-######################### End of black magic.
+use_ok('Test::Harness');
+
BEGIN {
%samples = (
good => 1,
tests => 1,
sub_skipped=> 0,
- todo => 0,
+ 'todo' => 0,
skipped => 0,
},
failed => { },
good => 0,
tests => 1,
sub_skipped => 0,
- todo => 0,
+ 'todo' => 0,
skipped => 0,
},
failed => {
good => 1,
tests => 1,
sub_skipped=> 0,
- todo => 0,
+ 'todo' => 0,
skipped => 0,
},
failed => { },
good => 0,
tests => 1,
sub_skipped=> 0,
- todo => 0,
+ 'todo' => 0,
skipped => 0,
},
failed => {
},
all_ok => 0,
},
- todo => {
+ 'todo' => {
total => {
bonus => 1,
max => 5,
good => 1,
tests => 1,
sub_skipped=> 0,
- todo => 2,
+ 'todo' => 2,
skipped => 0,
},
failed => { },
good => 1,
tests => 1,
sub_skipped => 0,
- todo => 2,
+ 'todo' => 2,
skipped => 0,
},
failed => { },
all_ok => 1,
},
- skip => {
+ 'skip' => {
total => {
bonus => 0,
max => 5,
good => 1,
tests => 1,
sub_skipped=> 1,
- todo => 0,
+ 'todo' => 0,
skipped => 0,
},
failed => { },
good => 0,
tests => 1,
sub_skipped=> 1,
- todo => 2,
+ 'todo' => 2,
skipped => 0
},
failed => {
good => 0,
tests => 1,
sub_skipped=> 0,
- todo => 0,
+ 'todo' => 0,
skipped => 0,
},
failed => {
good => 1,
tests => 1,
sub_skipped=> 0,
- todo => 0,
+ 'todo' => 0,
skipped => 0,
},
failed => { },
good => 0,
tests => 1,
sub_skipped=> 0,
- todo => 0,
+ 'todo' => 0,
skipped => 0,
},
failed => {
good => 1,
tests => 1,
sub_skipped=> 0,
- todo => 0,
+ 'todo' => 0,
skipped => 1,
},
failed => { },
good => 1,
tests => 1,
sub_skipped=> 0,
- todo => 4,
+ 'todo' => 4,
skipped => 0,
},
failed => { },
good => 1,
tests => 1,
sub_skipped=> 0,
- todo => 0,
+ 'todo' => 0,
skipped => 0,
},
failed => { },
all_ok => 1,
},
+
+ 'die' => {
+ total => {
+ bonus => 0,
+ max => 0,
+ 'ok' => 0,
+ files => 1,
+ bad => 1,
+ good => 0,
+ tests => 1,
+ sub_skipped=> 0,
+ 'todo' => 0,
+ skipped => 0,
+ },
+ failed => {
+ estat => 1,
+ wstat => 256,
+ max => '??',
+ failed => '??',
+ canon => '??',
+ },
+ all_ok => 0,
+ },
+
+ die_head_end => {
+ total => {
+ bonus => 0,
+ max => 0,
+ 'ok' => 4,
+ files => 1,
+ bad => 1,
+ good => 0,
+ tests => 1,
+ sub_skipped=> 0,
+ 'todo' => 0,
+ skipped => 0,
+ },
+ failed => {
+ estat => 1,
+ wstat => 256,
+ max => '??',
+ failed => '??',
+ canon => '??',
+ },
+ all_ok => 0,
+ },
+
+ die_last_minute => {
+ total => {
+ bonus => 0,
+ max => 4,
+ 'ok' => 4,
+ files => 1,
+ bad => 1,
+ good => 0,
+ tests => 1,
+ sub_skipped=> 0,
+ 'todo' => 0,
+ skipped => 0,
+ },
+ failed => {
+ estat => 1,
+ wstat => 256,
+ max => 4,
+ failed => 0,
+ canon => '??',
+ },
+ all_ok => 0,
+ },
+ bignum => {
+ total => {
+ bonus => 0,
+ max => 2,
+ 'ok' => 4,
+ files => 1,
+ bad => 1,
+ good => 0,
+ tests => 1,
+ sub_skipped=> 0,
+ 'todo' => 0,
+ skipped => 0,
+ },
+ failed => {
+ canon => '??',
+ },
+ all_ok => 0,
+ },
);
- $Total_tests = (keys(%samples) * 4);
+ $Total_tests = (keys(%samples) * 4) + 1;
}
tie *NULL, 'My::Dev::Null' or die $!;
select STDOUT;
unless( $@ ) {
- ok( Test::Harness::_all_ok($totals) == $expect->{all_ok},
+ is( Test::Harness::_all_ok($totals), $expect->{all_ok},
"$test - all ok" );
ok( defined $expect->{total}, "$test - has total" );
- ok( eqhash( $expect->{total},
- {map { $_=>$totals->{$_} } keys %{$expect->{total}}} ),
+ is_deeply( {map { $_=>$totals->{$_} } keys %{$expect->{total}}},
+ $expect->{total},
"$test - totals" );
- ok( eqhash( $expect->{failed},
- {map { $_=>$failed->{"$SAMPLE_TESTS/$test"}{$_} }
- keys %{$expect->{failed}}} ),
+ is_deeply( {map { $_=>$failed->{"$SAMPLE_TESTS/$test"}{$_} }
+ keys %{$expect->{failed}}},
+ $expect->{failed},
"$test - failed" );
}
else { # special case for bailout
- ok( ($test eq 'bailout' and $@ =~ /Further testing stopped: GERONI/i),
- $test );
- ok( 1, 'skipping for bailout' );
- ok( 1, 'skipping for bailout' );
+ is( $test, 'bailout' );
+ like( $@, '/Further testing stopped: GERONI/i', $test );
+ pass( 'skipping for bailout' );
+ pass( 'skipping for bailout' );
}
}
https://perl5.git.perl.org / perl5.git / commitdiff