$fh->open($cmd) or print "can't run $test. $!\n";
$ok = $next = $max = 0;
@failed = ();
+ my $skipped = 0;
while (<$fh>) {
if( $verbose ){
print $_;
if (/^not ok\s*(\d*)/){
$this = $1 if $1 > 0;
push @failed, $this;
- } elsif (/^ok\s*(\d*)/) {
+ } elsif (/^ok\s*(\d*)(\s*\#\s*[Ss]kip)?/) {
$this = $1 if $1 > 0;
$ok++;
$totok++;
+ $skipped++ if defined $2;
}
if ($this > $next) {
# warn "Test output counter mismatch [test $this]\n";
estat => $estatus, wstat => $wstatus,
};
} elsif ($ok == $max && $next == $max+1) {
- if ($max) {
+ if ($max and $skipped) {
+ my $ender = 's' x ($skipped > 1);
+ print "ok, $skipped subtest$ender skipped on this platform\n";
+ } elsif ($max) {
print "ok\n";
} else {
print "skipping test on this platform\n";
used to set perl command line options used for running the test
script(s). The default value is C<-w>.
+If the standard output line contains substring C< # Skip> (with
+variations in spacing and case) after C<ok> or C<ok NUMBER>, it is
+counted as a skipped test. If the whole testscript succeeds, the
+count of skipped tests is included in the generated output.
+
=head1 EXPORT
C<&runtests> is exported by Test::Harness per default.
$ok = 1;
} else {
$next = $1, $ok = 0, last if /^not ok ([0-9]*)/;
- if (/^ok (.*)/ && $1 == $next) {
+ if (/^ok (\d+)(\s*#.*)?$/ && $1 == $next) {
$next = $next + 1;
} else {
$ok = 0;
($Dfile) = <Op.dbmx*>;
}
if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32') {
- print "ok 2\n";
+ print "ok 2 # Skipped: different file permission semantics\n";
}
else {
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
main::ok(101, $@ eq "") ;
main::ok(102, $ret eq "[[11]]") ;
+ undef $X;
+ untie(%h);
unlink "SubDB.pm", "dbbtree.tmp" ;
}
main::ok(61, $@ eq "") ;
main::ok(62, $ret eq "[[11]]") ;
+ undef $X;
+ untie(%h);
unlink "SubDB.pm", "dbhash.tmp" ;
}
main::ok(65, $@ eq "") ;
main::ok(66, $ret eq "[[11]]") ;
+ undef $X;
+ untie(@h);
unlink "SubDB.pm", "recno.tmp" ;
}
($Dfile) = <Op.dbmx*>;
}
if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32') {
- print "ok 2\n";
+ print "ok 2 # Skipped: different file permission semantics\n";
}
else {
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
main::ok(19, $@ eq "") ;
main::ok(20, $ret eq "[[5]]") ;
+ undef $X;
+ untie(%h);
unlink "SubDB.pm", <dbhash.tmp*> ;
}
($Dfile) = <Op.dbmx*>;
}
if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32') {
- print "ok 2\n";
+ print "ok 2 # Skipped: different file permission semantics\n";
}
else {
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
main::ok(17, $@ eq "") ;
main::ok(18, $ret eq "[[5]]") ;
+ undef $X;
+ untie(%h);
unlink "SubDB.pm", <dbhash.tmp*> ;
}
($Dfile) = <Op.dbmx*>;
}
if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32') {
- print "ok 2\n";
+ print "ok 2 # Skipped: different file permission semantics\n";
}
else {
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
main::ok(17, $@ eq "") ;
main::ok(18, $ret eq "[[5]]") ;
+ undef $X;
+ untie(%h);
unlink "SubDB.pm", <dbhash.tmp*> ;
}
($Dfile) = <Op.dbmx*>;
}
if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32') {
- print "ok 2\n";
+ print "ok 2 # Skipped: different file permission semantics\n";
}
else {
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
main::ok(17, $@ eq "") ;
main::ok(18, $ret eq "[[5]]") ;
+ undef $X;
+ untie(%h);
unlink "SubDB.pm", <dbhash.tmp*> ;
}
}
my $tmp;
- if ($^O eq 'os2' || $^O eq 'amigaos' || $Is_MSWin32) {
- print "# all directories are writeable\n";
- }
- else {
+ unless ($^O eq 'os2' || $^O eq 'amigaos' || $Is_MSWin32) {
$tmp = (grep { defined and -d and (stat _)[2] & 2 }
qw(/tmp /var/tmp /usr/tmp /sys$scratch),
@ENV{qw(TMP TEMP)})[0]
test 7, $@ =~ /^Insecure directory in \$ENV{PATH}/, $@;
}
else {
- for (6..7) { print "ok $_\n" }
+ for (6..7) { print "ok $_ # Skipped: all directories are writeable\n" }
}
if ($Is_VMS) {
test 11, $@ =~ /^Insecure directory in \$ENV{DCL\$PATH}/, $@;
}
else {
- print "# can't find world-writeable directory to test DCL\$PATH\n";
- for (10..11) { print "ok $_\n" }
+ for (10..11) { print "ok $_ # Skipped: can't find world-writeable directory to test DCL\$PATH\n" }
}
$ENV{'DCL$PATH'} = '';
}
else {
- print "# This is not VMS\n";
- for (8..11) { print "ok $_\n"; }
+ for (8..11) { print "ok $_ # Skipped: This is not VMS\n"; }
}
}
test 50, $@ =~ /^Insecure dependency/, $@;
}
else {
- print "# chown() is not available\n";
- for (49..50) { print "ok $_\n" }
+ for (49..50) { print "ok $_ # Skipped: chown() is not available\n" }
}
if ($Config{d_link}) {
test 52, $@ =~ /^Insecure dependency/, $@;
}
else {
- print "# link() is not available\n";
- for (51..52) { print "ok $_\n" }
+ for (51..52) { print "ok $_ # Skipped: link() is not available\n" }
}
if ($Config{d_symlink}) {
test 54, $@ =~ /^Insecure dependency/, $@;
}
else {
- print "# symlink() is not available\n";
- for (53..54) { print "ok $_\n" }
+ for (53..54) { print "ok $_ # Skipped: symlink() is not available\n" }
}
}
test 62, $@ =~ /^Insecure dependency/, $@;
}
else {
- print "# chroot() is not available\n";
- for (61..62) { print "ok $_\n" }
+ for (61..62) { print "ok $_ # Skipped: chroot() is not available\n" }
}
}
my $foo = $TAINT;
if ($^O eq 'amigaos') {
- print "# open(\"|\") is not available\n";
- for (70..73) { print "ok $_\n" }
+ for (70..73) { print "ok $_ # Skipped: open('|') is not available\n" }
}
else {
test 70, eval { open FOO, "| $foo" } eq '', 'popen to';
test 81, $@ eq '', $@;
}
else {
- for (80..81) { print "ok $_\n"; }
+ for (80..81) { print "ok $_ # Skipped: this is not VMS\n"; }
}
}
test 85, $@ =~ /^Insecure dependency/, $@;
}
else {
- print "# setpgrp() is not available\n";
- for (84..85) { print "ok $_\n" }
+ for (84..85) { print "ok $_ # Skipped: setpgrp() is not available\n" }
}
if ($Config{d_setprior}) {
test 87, $@ =~ /^Insecure dependency/, $@;
}
else {
- print "# setpriority() is not available\n";
- for (86..87) { print "ok $_\n" }
+ for (86..87) { print "ok $_ # Skipped: setpriority() is not available\n" }
}
}
test 89, $@ =~ /^Insecure dependency/, $@;
}
else {
- print "# syscall() is not available\n";
- for (88..89) { print "ok $_\n" }
+ for (88..89) { print "ok $_ # Skipped: syscall() is not available\n" }
}
{
test 94, $@ =~ /^Insecure dependency/, $@;
}
else {
- print "# fcntl() is not available\n";
- for (93..94) { print "ok $_\n" }
+ for (93..94) { print "ok $_ # Skipped: fcntl() is not available\n" }
}
close FOO;
and not tainted $getpwent[8]);
endpwent();
} else {
- print "# getpwent() is not available\n";
- print "ok 136\n";
+ print "ok 136 # Skipped: getpwent() is not available\n";
}
if ($Config{d_readdir}) { # pretty hard to imagine not
test 137, tainted $readdir;
closedir(OP);
} else {
- print "# readdir() is not available\n";
- print "ok 137\n";
+ print "ok 137 # Skipped: readdir() is not available\n";
}
if ($Config{d_readlink} && $Config{d_symlink}) {
test 138, tainted $readlink;
unlink($symlink);
} else {
- print "# readlink() or symlink() is not available\n";
- print "ok 138\n";
+ print "ok 138 # Skipped: readlink() or symlink() is not available\n";
}
}