This syncs up bleadperl with Test::Harness 2.04. It has Guru's requested skip message reformatting and fixes for the failing tests on VMS.
WRT to VMS tests, the problem was Test::Harness made a special case to
display native VMS exit codes rather than do POSIX emulation.
Test::Harness::Straps didn't emulate this until just now. Is this the
desired behavior?
--- bleadperl/lib/Test/Harness/Assert.pm Fri Jan 11 10:04:27 2002
+++ perl-current/lib/Test/Harness/Assert.pm Tue Apr 30 01:00:35 2002
@@ -1,4 +1,4 @@
-# $Id: Assert.pm,v 1.1.2.1 2001/08/12 03:01:27 schwern Exp $
+# $Id: Assert.pm,v 1.2 2002/04/26 05:12:27 schwern Exp $
package Test::Harness::Assert;
--- bleadperl/lib/Test/Harness/Straps.pm Thu Apr 25 11:33:38 2002
+++ perl-current/lib/Test/Harness/Straps.pm Tue Apr 30 01:00:35 2002
@@ -1,5 +1,5 @@
# -*- Mode: cperl; cperl-indent-level: 4 -*-
-# $Id: Straps.pm,v 1.1.2.20 2002/04/25 05:04:35 schwern Exp $
+# $Id: Straps.pm,v 1.3 2002/04/30 04:55:27 schwern Exp $
package Test::Harness::Straps;
@@ -273,7 +273,12 @@
my %results = $self->analyze_fh($file, \*FILE);
my $exit = close FILE;
$results{'wait'} = $?;
- $results{'exit'} = $? / 256;
+ if( $? && $self->{_is_vms} ) {
+ eval q{use vmsish "status"; $results{'exit'} = $?};
+ }
+ else {
+ $results{'exit'} = $? / 256;
+ }
$results{passing} = 0 unless $? == 0;
$self->_restore_PERL5LIB();
--- bleadperl/lib/Test/Harness/t/strap-analyze.t Thu Apr 25 11:33:38 2002
+++ perl-current/lib/Test/Harness/t/strap-analyze.t Tue Apr 30 01:00:56 2002
@@ -20,6 +20,10 @@
my $IsVMS = $^O eq 'VMS';
+# VMS uses native, not POSIX, exit codes.
+my $die_exit = $IsVMS ? 44 : 1;
+my $die_wait = $IsVMS ? 1024 : 256;
+
my %samples = (
combined => {
passing => 0,
@@ -308,8 +312,8 @@
'die' => {
passing => 0,
- 'exit' => 1,
- 'wait' => 256,
+ 'exit' => $die_exit,
+ 'wait' => $die_wait,
max => 0,
seen => 0,
@@ -325,8 +329,8 @@
die_head_end => {
passing => 0,
- 'exit' => 1,
- 'wait' => 256,
+ 'exit' => $die_exit,
+ 'wait' => $die_wait,
max => 0,
seen => 4,
@@ -343,8 +347,8 @@
die_last_minute => {
passing => 0,
- 'exit' => 1,
- 'wait' => 256,
+ 'exit' => $die_exit,
+ 'wait' => $die_wait,
max => 4,
seen => 4,
@@ -391,5 +395,5 @@
delete $expect->{details};
delete $results{details};
- is_deeply(\%results, $expect, " the rest" );
+ is_deeply(\%results, $expect, " the rest $test" );
}
--- bleadperl/lib/Test/Harness/t/test-harness.t Thu Apr 25 11:33:38 2002
+++ perl-current/lib/Test/Harness/t/test-harness.t Tue Apr 30 01:00:56 2002
@@ -35,341 +35,342 @@
use Test::More;
-use vars qw($Total_tests %samples);
+my $IsVMS = $^O eq 'VMS';
-plan tests => $Total_tests;
-use Test::Harness;
-use_ok('Test::Harness');
+# VMS uses native, not POSIX, exit codes.
+my $die_estat = $IsVMS ? 44 : 1;
+my $die_wstat = $IsVMS ? 1024 : 256;
+
+my %samples = (
+ simple => {
+ total => {
+ bonus => 0,
+ max => 5,
+ 'ok' => 5,
+ files => 1,
+ bad => 0,
+ good => 1,
+ tests => 1,
+ sub_skipped=> 0,
+ 'todo' => 0,
+ skipped => 0,
+ },
+ failed => { },
+ all_ok => 1,
+ },
+ simple_fail => {
+ total => {
+ bonus => 0,
+ max => 5,
+ 'ok' => 3,
+ files => 1,
+ bad => 1,
+ good => 0,
+ tests => 1,
+ sub_skipped => 0,
+ 'todo' => 0,
+ skipped => 0,
+ },
+ failed => {
+ canon => '2 5',
+ },
+ all_ok => 0,
+ },
+ descriptive => {
+ total => {
+ bonus => 0,
+ max => 5,
+ 'ok' => 5,
+ files => 1,
+ bad => 0,
+ good => 1,
+ tests => 1,
+ sub_skipped=> 0,
+ 'todo' => 0,
+ skipped => 0,
+ },
+ failed => { },
+ all_ok => 1,
+ },
+ no_nums => {
+ total => {
+ bonus => 0,
+ max => 5,
+ 'ok' => 4,
+ files => 1,
+ bad => 1,
+ good => 0,
+ tests => 1,
+ sub_skipped=> 0,
+ 'todo' => 0,
+ skipped => 0,
+ },
+ failed => {
+ canon => '3',
+ },
+ all_ok => 0,
+ },
+ 'todo' => {
+ total => {
+ bonus => 1,
+ max => 5,
+ 'ok' => 5,
+ files => 1,
+ bad => 0,
+ good => 1,
+ tests => 1,
+ sub_skipped=> 0,
+ 'todo' => 2,
+ skipped => 0,
+ },
+ failed => { },
+ all_ok => 1,
+ },
+ todo_inline => {
+ total => {
+ bonus => 1,
+ max => 3,
+ 'ok' => 3,
+ files => 1,
+ bad => 0,
+ good => 1,
+ tests => 1,
+ sub_skipped => 0,
+ 'todo' => 2,
+ skipped => 0,
+ },
+ failed => { },
+ all_ok => 1,
+ },
+ 'skip' => {
+ total => {
+ bonus => 0,
+ max => 5,
+ 'ok' => 5,
+ files => 1,
+ bad => 0,
+ good => 1,
+ tests => 1,
+ sub_skipped=> 1,
+ 'todo' => 0,
+ skipped => 0,
+ },
+ failed => { },
+ all_ok => 1,
+ },
+ bailout => 0,
+ combined => {
+ total => {
+ bonus => 1,
+ max => 10,
+ 'ok' => 8,
+ files => 1,
+ bad => 1,
+ good => 0,
+ tests => 1,
+ sub_skipped=> 1,
+ 'todo' => 2,
+ skipped => 0
+ },
+ failed => {
+ canon => '3 9',
+ },
+ all_ok => 0,
+ },
+ duplicates => {
+ total => {
+ bonus => 0,
+ max => 10,
+ 'ok' => 11,
+ files => 1,
+ bad => 1,
+ good => 0,
+ tests => 1,
+ sub_skipped=> 0,
+ 'todo' => 0,
+ skipped => 0,
+ },
+ failed => {
+ canon => '??',
+ },
+ all_ok => 0,
+ },
+ head_end => {
+ total => {
+ bonus => 0,
+ max => 4,
+ 'ok' => 4,
+ files => 1,
+ bad => 0,
+ good => 1,
+ tests => 1,
+ sub_skipped=> 0,
+ 'todo' => 0,
+ skipped => 0,
+ },
+ failed => { },
+ all_ok => 1,
+ },
+ head_fail => {
+ total => {
+ bonus => 0,
+ max => 4,
+ 'ok' => 3,
+ files => 1,
+ bad => 1,
+ good => 0,
+ tests => 1,
+ sub_skipped=> 0,
+ 'todo' => 0,
+ skipped => 0,
+ },
+ failed => {
+ canon => '2',
+ },
+ all_ok => 0,
+ },
+ skip_all => {
+ total => {
+ bonus => 0,
+ max => 0,
+ 'ok' => 0,
+ files => 1,
+ bad => 0,
+ good => 1,
+ tests => 1,
+ sub_skipped=> 0,
+ 'todo' => 0,
+ skipped => 1,
+ },
+ failed => { },
+ all_ok => 1,
+ },
+ with_comments => {
+ total => {
+ bonus => 2,
+ max => 5,
+ 'ok' => 5,
+ files => 1,
+ bad => 0,
+ good => 1,
+ tests => 1,
+ sub_skipped=> 0,
+ 'todo' => 4,
+ skipped => 0,
+ },
+ failed => { },
+ all_ok => 1,
+ },
+ taint => {
+ total => {
+ bonus => 0,
+ max => 1,
+ 'ok' => 1,
+ files => 1,
+ bad => 0,
+ good => 1,
+ tests => 1,
+ sub_skipped=> 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 => $die_estat,
+ wstat => $die_wstat,
+ max => '??',
+ failed => '??',
+ canon => '??',
+ },
+ all_ok => 0,
+ },
-BEGIN {
- %samples = (
- simple => {
- total => {
- bonus => 0,
- max => 5,
- 'ok' => 5,
- files => 1,
- bad => 0,
- good => 1,
- tests => 1,
- sub_skipped=> 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => { },
- all_ok => 1,
- },
- simple_fail => {
- total => {
- bonus => 0,
- max => 5,
- 'ok' => 3,
- files => 1,
- bad => 1,
- good => 0,
- tests => 1,
- sub_skipped => 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => {
- canon => '2 5',
- },
- all_ok => 0,
- },
- descriptive => {
- total => {
- bonus => 0,
- max => 5,
- 'ok' => 5,
- files => 1,
- bad => 0,
- good => 1,
- tests => 1,
- sub_skipped=> 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => { },
- all_ok => 1,
- },
- no_nums => {
- total => {
- bonus => 0,
- max => 5,
- 'ok' => 4,
- files => 1,
- bad => 1,
- good => 0,
- tests => 1,
- sub_skipped=> 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => {
- canon => '3',
- },
- all_ok => 0,
- },
- 'todo' => {
- total => {
- bonus => 1,
- max => 5,
- 'ok' => 5,
- files => 1,
- bad => 0,
- good => 1,
- tests => 1,
- sub_skipped=> 0,
- 'todo' => 2,
- skipped => 0,
- },
- failed => { },
- all_ok => 1,
- },
- todo_inline => {
- total => {
- bonus => 1,
- max => 3,
- 'ok' => 3,
- files => 1,
- bad => 0,
- good => 1,
- tests => 1,
- sub_skipped => 0,
- 'todo' => 2,
- skipped => 0,
- },
- failed => { },
- all_ok => 1,
- },
- 'skip' => {
- total => {
- bonus => 0,
- max => 5,
- 'ok' => 5,
- files => 1,
- bad => 0,
- good => 1,
- tests => 1,
- sub_skipped=> 1,
- 'todo' => 0,
- skipped => 0,
- },
- failed => { },
- all_ok => 1,
- },
- bailout => 0,
- combined => {
- total => {
- bonus => 1,
- max => 10,
- 'ok' => 8,
- files => 1,
- bad => 1,
- good => 0,
- tests => 1,
- sub_skipped=> 1,
- 'todo' => 2,
- skipped => 0
- },
- failed => {
- canon => '3 9',
- },
- all_ok => 0,
- },
- duplicates => {
- total => {
- bonus => 0,
- max => 10,
- 'ok' => 11,
- files => 1,
- bad => 1,
- good => 0,
- tests => 1,
- sub_skipped=> 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => {
- canon => '??',
- },
- all_ok => 0,
- },
- head_end => {
- total => {
- bonus => 0,
- max => 4,
- 'ok' => 4,
- files => 1,
- bad => 0,
- good => 1,
- tests => 1,
- sub_skipped=> 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => { },
- all_ok => 1,
- },
- head_fail => {
- total => {
- bonus => 0,
- max => 4,
- 'ok' => 3,
- files => 1,
- bad => 1,
- good => 0,
- tests => 1,
- sub_skipped=> 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => {
- canon => '2',
- },
- all_ok => 0,
- },
- skip_all => {
- total => {
- bonus => 0,
- max => 0,
- 'ok' => 0,
- files => 1,
- bad => 0,
- good => 1,
- tests => 1,
- sub_skipped=> 0,
- 'todo' => 0,
- skipped => 1,
- },
- failed => { },
- all_ok => 1,
- },
- with_comments => {
- total => {
- bonus => 2,
- max => 5,
- 'ok' => 5,
- files => 1,
- bad => 0,
- good => 1,
- tests => 1,
- sub_skipped=> 0,
- 'todo' => 4,
- skipped => 0,
- },
- failed => { },
- all_ok => 1,
- },
- taint => {
- total => {
- bonus => 0,
- max => 1,
- 'ok' => 1,
- files => 1,
- bad => 0,
- good => 1,
- tests => 1,
- sub_skipped=> 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => { },
- all_ok => 1,
- },
+ 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 => $die_estat,
+ wstat => $die_wstat,
+ max => '??',
+ failed => '??',
+ canon => '??',
+ },
+ all_ok => 0,
+ },
- '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_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 => $die_estat,
+ wstat => $die_wstat,
+ 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,
+ },
+ );
- 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,
- },
+plan tests => (keys(%samples) * 4) + 1;
- 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,
- },
- );
+use Test::Harness;
+use_ok('Test::Harness');
- $Total_tests = (keys(%samples) * 4) + 1;
-}
tie *NULL, 'My::Dev::Null' or die $!;
--- bleadperl/lib/Test/Harness.pm Thu Apr 25 11:33:38 2002
+++ perl-current/lib/Test/Harness.pm Tue Apr 30 01:00:40 2002
@@ -1,5 +1,5 @@
# -*- Mode: cperl; cperl-indent-level: 4 -*-
-# $Id: Harness.pm,v 1.14.2.18 2002/04/25 05:04:35 schwern Exp $
+# $Id: Harness.pm,v 1.22 2002/04/30 04:55:27 schwern Exp $
package Test::Harness;
@@ -22,7 +22,7 @@
$Have_Devel_Corestack = 0;
-$VERSION = '2.03';
+$VERSION = '2.04';
$ENV{HARNESS_ACTIVE} = 1;
@@ -505,14 +505,14 @@
if $test{skipped};
push(@msg, "$test{bonus}/$test{max} unexpectedly succeeded")
if $test{bonus};
- print "$test{ml}ok, ".join(', ', @msg)."\n";
+ print "$test{ml}ok\n ".join(', ', @msg)."\n";
} elsif ($test{max}) {
print "$test{ml}ok\n";
} elsif (defined $test{skip_reason}) {
- print "skipped: $test{skip_reason}\n";
+ print "skipped\n all skipped: $test{skip_reason}\n";
$tot{skipped}++;
} else {
- print "skipped test on this platform\n";
+ print "\n skipped test on this platform\n";
$tot{skipped}++;
}
$tot{good}++;
@@ -1016,7 +1016,7 @@
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, ".
+ push @result, " (less $skipped skipped test$ender: $good okay, ".
"$goodper%)"
if $skipped;
push @result, "\n";
--
Michael G. Schwern <[EMAIL PROTECTED]> http://www.pobox.com/~schwern/
Perl Quality Assurance <[EMAIL PROTECTED]> Kwalitee Is Job One
navy ritual:
first caulk the boards of the deck,
then plug up my ass.
-- japhy
