Output skipped test information in test suite:
Malcolm Beattie [Thu, 27 Nov 1997 14:59:03 +0000 (14:59 +0000)]
Subject: 5.004_55: Making test harness platform_aware
Date: Wed, 26 Nov 1997 17:16:55 -0500 (EST)
Date: Wed, 26 Nov 1997 17:16:55 -0500 (EST)

p4raw-id: //depot/perl@318

lib/Test/Harness.pm
t/TEST
t/lib/anydbm.t
t/lib/db-btree.t
t/lib/db-hash.t
t/lib/db-recno.t
t/lib/gdbm.t
t/lib/ndbm.t
t/lib/odbm.t
t/lib/sdbm.t
t/op/taint.t

index f5fc3d8..37f4a9f 100644 (file)
@@ -73,6 +73,7 @@ sub runtests {
        $fh->open($cmd) or print "can't run $test. $!\n";
        $ok = $next = $max = 0;
        @failed = ();
+       my $skipped = 0;
        while (<$fh>) {
            if( $verbose ){
                print $_;
@@ -87,10 +88,11 @@ sub runtests {
                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";
@@ -142,7 +144,10 @@ sub runtests {
                                    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";
@@ -328,6 +333,11 @@ The global variable $Test::Harness::switches is exportable and can be
 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.
diff --git a/t/TEST b/t/TEST
index cae8103..a684b2a 100755 (executable)
--- a/t/TEST
+++ b/t/TEST
@@ -83,7 +83,7 @@ while ($test = shift) {
                $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;
index 6ddbf25..cadbfd5 100755 (executable)
@@ -23,7 +23,7 @@ if (! -e $Dfile) {
        ($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,
index bebb63d..c85c22f 100755 (executable)
@@ -601,6 +601,8 @@ EOM
     main::ok(101, $@ eq "") ;
     main::ok(102, $ret eq "[[11]]") ;
 
+    undef $X;
+    untie(%h);
     unlink "SubDB.pm", "dbbtree.tmp" ;
 
 }
index 9df918c..10c8d14 100755 (executable)
@@ -407,6 +407,8 @@ EOM
     main::ok(61, $@ eq "") ;
     main::ok(62, $ret eq "[[11]]") ;
 
+    undef $X;
+    untie(%h);
     unlink "SubDB.pm", "dbhash.tmp" ;
 
 }
index 9950741..b332c5e 100755 (executable)
@@ -378,6 +378,8 @@ EOM
     main::ok(65, $@ eq "") ;
     main::ok(66, $ret eq "[[11]]") ;
 
+    undef $X;
+    untie(@h);
     unlink "SubDB.pm", "recno.tmp" ;
 
 }
index 37660c2..ebc9f56 100755 (executable)
@@ -25,7 +25,7 @@ if (! -e $Dfile) {
        ($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,
@@ -201,6 +201,8 @@ EOM
     main::ok(19, $@ eq "") ;
     main::ok(20, $ret eq "[[5]]") ;
 
+    undef $X;
+    untie(%h);
     unlink "SubDB.pm", <dbhash.tmp*> ;
 
 }
index 27f3ec5..db9846a 100755 (executable)
@@ -28,7 +28,7 @@ if (! -e $Dfile) {
        ($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,
@@ -200,6 +200,8 @@ EOM
     main::ok(17, $@ eq "") ;
     main::ok(18, $ret eq "[[5]]") ;
 
+    undef $X;
+    untie(%h);
     unlink "SubDB.pm", <dbhash.tmp*> ;
 
 }
index 6cfefda..65c9870 100755 (executable)
@@ -28,7 +28,7 @@ if (! -e $Dfile) {
        ($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,
@@ -200,6 +200,8 @@ EOM
     main::ok(17, $@ eq "") ;
     main::ok(18, $ret eq "[[5]]") ;
 
+    undef $X;
+    untie(%h);
     unlink "SubDB.pm", <dbhash.tmp*> ;
 
 }
index c8ae092..ad25011 100755 (executable)
@@ -28,7 +28,7 @@ if (! -e $Dfile) {
        ($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,
@@ -200,6 +200,8 @@ EOM
     main::ok(17, $@ eq "") ;
     main::ok(18, $ret eq "[[5]]") ;
 
+    undef $X;
+    untie(%h);
     unlink "SubDB.pm", <dbhash.tmp*> ;
 
 }
index 8437c43..22bb574 100755 (executable)
@@ -120,10 +120,7 @@ print "1..140\n";
     }
 
     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]
@@ -136,7 +133,7 @@ print "1..140\n";
        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) {
@@ -149,14 +146,12 @@ print "1..140\n";
            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"; }
     }
 }
 
@@ -292,8 +287,7 @@ else {
        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}) {
@@ -301,8 +295,7 @@ else {
        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}) {
@@ -310,8 +303,7 @@ else {
        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" }
     }
 }
 
@@ -331,8 +323,7 @@ else {
        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" }
     }
 }
 
@@ -360,8 +351,7 @@ else {
     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';
@@ -388,7 +378,7 @@ else {
        test 81, $@ eq '', $@;
     }
     else {
-       for (80..81) { print "ok $_\n"; }
+       for (80..81) { print "ok $_ # Skipped: this is not VMS\n"; }
     }
 }
 
@@ -402,8 +392,7 @@ else {
        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}) {
@@ -411,8 +400,7 @@ else {
        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" }
     }
 }
 
@@ -423,8 +411,7 @@ else {
        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" }
     }
 
     {
@@ -443,8 +430,7 @@ else {
            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;
@@ -534,8 +520,7 @@ else {
                  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
@@ -545,8 +530,7 @@ else {
        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}) {
@@ -557,8 +541,7 @@ else {
        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";
     }
 }