diff options
| author | Ilya Zakharevich <ilya@math.berkeley.edu> | 1999-05-09 22:07:01 -0400 |
|---|---|---|
| committer | Gurusamy Sarathy <gsar@cpan.org> | 1999-05-11 14:40:58 +0000 |
| commit | c854dc73dd785a05dca58d094503a8e06b4b3220 (patch) | |
| tree | 5fcd0fb3d25d310f0d215fcc397eaac2b4ab69e8 /lib/Test | |
| parent | f6ec51f74c8ac3114d6ab404cd0d7ce83d50adc9 (diff) | |
| download | perl-c854dc73dd785a05dca58d094503a8e06b4b3220.tar.gz | |
Explanations by Test::Harness
Message-Id: <199905100607.CAA26045@monk.mps.ohio-state.edu>
p4raw-id: //depot/perl@3389
Diffstat (limited to 'lib/Test')
| -rw-r--r-- | lib/Test/Harness.pm | 17 |
1 files changed, 14 insertions, 3 deletions
diff --git a/lib/Test/Harness.pm b/lib/Test/Harness.pm index 71c0c1c1ce..e4becb5d17 100644 --- a/lib/Test/Harness.pm +++ b/lib/Test/Harness.pm @@ -11,7 +11,7 @@ use vars qw($VERSION $verbose $switches $have_devel_corestack $curtest @ISA @EXPORT @EXPORT_OK); $have_devel_corestack = 0; -$VERSION = "1.1602"; +$VERSION = "1.1603"; $ENV{HARNESS_ACTIVE} = 1; @@ -91,6 +91,7 @@ sub runtests { my %todo = (); my $bonus = 0; my $skipped = 0; + my $skip_reason; while (<$fh>) { if( $verbose ){ print $_; @@ -116,11 +117,21 @@ sub runtests { $ok++; $totok++; } - } elsif (/^ok\s*(\d*)(\s*\#\s*[Ss]kip)?/) { + } elsif (/^ok\s*(\d*)(\s*\#\s*[Ss]kip\S*(?:(?>\s+)(.+))?)?/) { $this = $1 if $1 > 0; $ok++; $totok++; $skipped++ if defined $2; + my $reason; + $reason = 'unknown reason' if defined $2; + $reason = $3 if defined $3; + if (defined $reason and defined $skip_reason) { + # print "was: '$skip_reason' new '$reason'\n"; + $skip_reason = 'various reasons' + if $skip_reason ne $reason; + } elsif (defined $reason) { + $skip_reason = $reason; + } $bonus++, $totbonus++ if $todo{$this}; } if ($this > $next) { @@ -175,7 +186,7 @@ sub runtests { } elsif ($ok == $max && $next == $max+1) { if ($max and $skipped + $bonus) { my @msg; - push(@msg, "$skipped/$max subtest".($skipped>1?'s':'')." skipped") + push(@msg, "$skipped/$max subtest".($skipped>1?'s':'')." skipped: $skip_reason") if $skipped; push(@msg, "$bonus subtest".($bonus>1?'s':''). " unexpectedly succeeded") |