more testsuite smarts (many of them courtesy Ilya)

p4raw-id: //depot/perl@3399

diff --git a/lib/Test/Harness.pm b/lib/Test/Harness.pm
index 8665513..8804cbd 100644 (file)
--- a/lib/Test/Harness.pm
+++ b/lib/Test/Harness.pm
@@ -74,9 +74,10 @@ sub runtests {
        $te = $test;
        chop($te);
        if ($^O eq 'VMS') { $te =~ s/^.*\.t\./[.t./; }
+       my $blank = (' ' x 77);
        my $leader = "$te" . '.' x (20 - length($te));
        my $ml = "";
-       $ml = "\r$leader" if -t STDOUT and not $ENV{HARNESS_NOTTY};
+       $ml = "\r$blank\r$leader" if -t STDOUT and not $ENV{HARNESS_NOTTY};
        print $leader;
        my $fh = new FileHandle;
        $fh->open($test) or print "can't open $test. $!\n";
@@ -105,16 +106,17 @@ sub runtests {
                $totmax += $max;
                $files++;
                $next = 1;
-           } elsif (/^1\.\.([0-9]+)/) {
+           } elsif (/^1\.\.([0-9]+)(\s*\#\s*[Ss]kip\S*(?>\s+)(.+))?/) {
                $max = $1;
                $totmax += $max;
                $files++;
                $next = 1;
+               $skip_reason = $3 if not $max and defined $3;
            } elsif ($max && /^(not\s+)?ok\b/) {
                my $this = $next;
                if (/^not ok\s*(\d*)/){
                    $this = $1 if $1 > 0;
-                   print "${ml}NOK $this   \n" if $ml;
+                   print "${ml}NOK $this\n" if $ml;
                    if (!$todo{$this}) {
                        push @failed, $this;
                    } else {
@@ -123,7 +125,7 @@ sub runtests {
                    }
                } elsif (/^ok\s*(\d*)(\s*\#\s*[Ss]kip\S*(?:(?>\s+)(.+))?)?/) {
                    $this = $1 if $1 > 0;
-                   print "${ml}ok $this   " if $ml;
+                   print "${ml}ok $this/$max" if $ml;
                    $ok++;
                    $totok++;
                    $skipped++ if defined $2;
@@ -191,16 +193,18 @@ sub runtests {
        } elsif ($ok == $max && $next == $max+1) {
            if ($max and $skipped + $bonus) {
                my @msg;
-               push(@msg, "$skipped/$max subtest".($skipped>1?'s':'')." skipped: $skip_reason")
+               push(@msg, "$skipped/$max skipped: $skip_reason")
                    if $skipped;
-               push(@msg, "$bonus subtest".($bonus>1?'s':'').
-                    " unexpectedly succeeded")
+               push(@msg, "$bonus/$max unexpectedly succeeded")
                    if $bonus;
-               print "${ml}ok, ".join(', ', @msg)."     \n";
+               print "${ml}ok, ".join(', ', @msg)."\n";
            } elsif ($max) {
-               print "${ml}ok      \n";
+               print "${ml}ok\n";
+           } elsif (defined $skip_reason) {
+               print "skipped: $skip_reason\n";
+               $tests_skipped++;
            } else {
-               print "skipping test on this platform\n";
+               print "skipped test on this platform\n";
                $tests_skipped++;
            }
            $good++;
@@ -429,6 +433,12 @@ 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.
 
+C<Test::Harness> reports the text after C< # Skip(whatever)> as a
+reason for skipping.  Similarly, one can include a similar explanation
+in a C<1..0> line emitted if the test is skipped completely:
+
+  1..0 # Skipped: no leverage found
+
 =head1 EXPORT
 
 C<&runtests> is exported by Test::Harness per default.

diff --git a/t/comp/cpp.t b/t/comp/cpp.t
index f6450a5..bbff38c 100755 (executable)
--- a/t/comp/cpp.t
+++ b/t/comp/cpp.t
@@ -11,7 +11,7 @@ use Config;
 if ( $^O eq 'MSWin32' or
      ($Config{'cppstdin'} =~ /\bcppstdin\b/) and
      ( ! -x $Config{'binexp'} . "/cppstdin") ) {
-    print "1..0\n";
+    print "1..0 # Skip: \$Config{cppstdin} unavailable\n";
     exit;              # Cannot test till after install, alas.
 }
 

diff --git a/t/io/pipe.t b/t/io/pipe.t
index 9f12ed8..1c72440 100755 (executable)
--- a/t/io/pipe.t
+++ b/t/io/pipe.t
@@ -7,7 +7,7 @@ BEGIN {
     unshift @INC, '../lib';
     require Config; import Config;
     unless ($Config{'d_fork'}) {
-       print "1..0\n";
+       print "1..0 # Skip: no fork\n";
        exit 0;
     }
 }

diff --git a/t/lib/db-btree.t b/t/lib/db-btree.t
index 7f982d6..2729048 100755 (executable)
--- a/t/lib/db-btree.t
+++ b/t/lib/db-btree.t
@@ -4,7 +4,7 @@ BEGIN {
     unshift @INC, '../lib' if -d '../lib' ;
     require Config; import Config;
     if ($Config{'extensions'} !~ /\bDB_File\b/) {
-       print "1..0\n";
+       print "1..0 # Skip: DB_File was not built\n";
        exit 0;
     }
 }

diff --git a/t/lib/db-hash.t b/t/lib/db-hash.t
index 21f2aad..ecf3886 100755 (executable)
--- a/t/lib/db-hash.t
+++ b/t/lib/db-hash.t
@@ -4,7 +4,7 @@ BEGIN {
     unshift @INC, '../lib' if -d '../lib' ;
     require Config; import Config;
     if ($Config{'extensions'} !~ /\bDB_File\b/) {
-       print "1..0\n";
+       print "1..0 # Skip: DB_File was not built\n";
        exit 0;
     }
 }

diff --git a/t/lib/db-recno.t b/t/lib/db-recno.t
index cb223b1..ce33313 100755 (executable)
--- a/t/lib/db-recno.t
+++ b/t/lib/db-recno.t
@@ -4,7 +4,7 @@ BEGIN {
     unshift @INC, '../lib' if -d '../lib' ;
     require Config; import Config;
     if ($Config{'extensions'} !~ /\bDB_File\b/) {
-       print "1..0\n";
+       print "1..0 # Skip: DB_File was not built\n";
        exit 0;
     }
 }

diff --git a/t/lib/gdbm.t b/t/lib/gdbm.t
index d8c0ed2..dc4e96e 100755 (executable)
--- a/t/lib/gdbm.t
+++ b/t/lib/gdbm.t
@@ -6,7 +6,7 @@ BEGIN {
     unshift @INC, '../lib';
     require Config; import Config;
     if ($Config{'extensions'} !~ /\bGDBM_File\b/) {
-       print "1..0\n";
+       print "1..0 # Skip: GDBM_File was not built\n";
        exit 0;
     }
 }

diff --git a/t/lib/io_multihomed.t b/t/lib/io_multihomed.t
index de15b3e..8dc46e9 100644 (file)
--- a/t/lib/io_multihomed.t
+++ b/t/lib/io_multihomed.t
@@ -11,11 +11,19 @@ use Config;
 
 BEGIN {
     if(-d "lib" && -f "TEST") {
-        if (!$Config{'d_fork'} ||
-           (($Config{'extensions'} !~ /\bSocket\b/ ||
-             $Config{'extensions'} !~ /\bIO\b/) &&
-            !(($^O eq 'VMS') && $Config{d_socket}))) {
-           print "1..0\n";
+       my $reason;
+       if (! $Config{'d_fork'}) {
+           $reason = 'no fork';
+       }
+       elsif ($Config{'extensions'} !~ /\bSocket\b/) {
+           $reason = 'Socket extension unavailable';
+       }
+       elsif ($Config{'extensions'} !~ /\bIO\b/) {
+           $reason = 'IO extension unavailable';
+       }
+       undef $reason if $^O eq 'VMS' and $Config{d_socket};
+       if ($reason) {
+           print "1..0 # Skip: $reason\n";
            exit 0;
         }
     }

diff --git a/t/lib/io_pipe.t b/t/lib/io_pipe.t
index 0c1a498..bcb89a0 100755 (executable)
--- a/t/lib/io_pipe.t
+++ b/t/lib/io_pipe.t
@@ -11,10 +11,16 @@ use Config;
 
 BEGIN {
     if(-d "lib" && -f "TEST") {
-        if (! $Config{'d_fork'} ||
-           ($Config{'extensions'} !~ /\bIO\b/ && $^O ne 'VMS'))
-       {
-           print "1..0\n";
+       my $reason;
+       if (! $Config{'d_fork'}) {
+           $reason = 'no fork';
+       }
+       elsif ($Config{'extensions'} !~ /\bIO\b/) {
+           $reason = 'IO extension unavailable';
+       }
+       undef $reason if $^O eq 'VMS';
+       if ($reason) {
+           print "1..0 # Skip: $reason\n";
            exit 0;
         }
     }

diff --git a/t/lib/io_sock.t b/t/lib/io_sock.t
index 0e002be..e236f5f 100755 (executable)
--- a/t/lib/io_sock.t
+++ b/t/lib/io_sock.t
@@ -11,11 +11,19 @@ use Config;
 
 BEGIN {
     if (-d "lib" && -f "TEST") {
-        if (!$Config{'d_fork'} ||
-           (($Config{'extensions'} !~ /\bSocket\b/ ||
-             $Config{'extensions'} !~ /\bIO\b/) &&
-            !(($^O eq 'VMS') && $Config{d_socket}))) {
-           print "1..0\n";
+       my $reason;
+       if (! $Config{'d_fork'}) {
+           $reason = 'no fork';
+       }
+       elsif ($Config{'extensions'} !~ /\bSocket\b/) {
+           $reason = 'Socket extension unavailable';
+       }
+       elsif ($Config{'extensions'} !~ /\bIO\b/) {
+           $reason = 'IO extension unavailable';
+       }
+       undef $reason if $^O eq 'VMS' and $Config{d_socket};
+       if ($reason) {
+           print "1..0 # Skip: $reason\n";
            exit 0;
         }
     }

diff --git a/t/lib/io_udp.t b/t/lib/io_udp.t
index 435533f..02112a2 100755 (executable)
--- a/t/lib/io_udp.t
+++ b/t/lib/io_udp.t
@@ -11,13 +11,25 @@ use Config;
 
 BEGIN {
     if(-d "lib" && -f "TEST") {
-        if ( ($Config{'extensions'} !~ /\bSocket\b/ ||
-              $Config{'extensions'} !~ /\bIO\b/        ||
-             ($^O eq 'os2') || $^O eq 'apollo')    &&
-              !(($^O eq 'VMS') && $Config{d_socket})) {
-           print "1..0\n";
+       my $reason;
+
+       if ($Config{'extensions'} !~ /\bSocket\b/) {
+         $reason = 'Socket was not built';
+       }
+       elsif ($Config{'extensions'} !~ /\bIO\b/) {
+         $reason = 'IO was not built';
+       }
+       elsif ($^O eq 'os2') {
+         $reason = "blocks on OS/2, not debugged yet";
+       }
+       elsif ($^O eq 'apollo') {
+         $reason = "unknown *FIXME*";
+       }
+       undef $reason if $^O eq 'VMS' and $Config{d_socket};
+       if ($reason) {
+           print "1..0 # Skip: $reason\n";
            exit 0;
-        }
+       }
     }
 }
 

diff --git a/t/lib/io_unix.t b/t/lib/io_unix.t
index 30e7c0e..7a4556d 100644 (file)
--- a/t/lib/io_unix.t
+++ b/t/lib/io_unix.t
@@ -10,17 +10,21 @@ BEGIN {
 use Config;
 
 BEGIN {
-    if (!$Config{d_fork}) {
-        print "1..0\n";
-        exit 0;
-    }
-
     if(-d "lib" && -f "TEST") {
-        if ( ($Config{'extensions'} !~ /\bSocket\b/ ||
-              $Config{'extensions'} !~ /\bIO\b/)    &&
-              !(($^O eq 'VMS') && $Config{d_socket})) {
-            print "1..0\n";
-            exit 0;
+       my $reason;
+       if (! $Config{'d_fork'}) {
+           $reason = 'no fork';
+       }
+       elsif ($Config{'extensions'} !~ /\bSocket\b/) {
+           $reason = 'Socket extension unavailable';
+       }
+       elsif ($Config{'extensions'} !~ /\bIO\b/) {
+           $reason = 'IO extension unavailable';
+       }
+       undef $reason if $^O eq 'VMS' and $Config{d_socket};
+       if ($reason) {
+           print "1..0 # Skip: $reason\n";
+           exit 0;
         }
     }
 }

diff --git a/t/lib/ipc_sysv.t b/t/lib/ipc_sysv.t
index 42b8458..00a157b 100755 (executable)
--- a/t/lib/ipc_sysv.t
+++ b/t/lib/ipc_sysv.t
@@ -7,10 +7,16 @@ BEGIN {
 
     require Config; import Config;
 
-    unless ($Config{'d_msg'} eq 'define' &&
-           $Config{'d_sem'} eq 'define') {
-       print "1..0\n";
-       exit;
+    my $reason;
+
+    if ($Config{'d_sem'} ne 'define') {
+      $reason = '$Config{d_sem} undefined';
+    } elsif ($Config{'d_msg'} ne 'define') {
+      $reason = '$Config{d_msg} undefined';
+    }
+    if ($reason) {
+       print "1..0 # Skip: $reason\n";
+       exit 0;
     }
 }
 

diff --git a/t/lib/ndbm.t b/t/lib/ndbm.t
index de42c0d..39c3f40 100755 (executable)
--- a/t/lib/ndbm.t
+++ b/t/lib/ndbm.t
@@ -7,7 +7,7 @@ BEGIN {
     unshift @INC, '../lib';
     require Config; import Config;
     if ($Config{'extensions'} !~ /\bNDBM_File\b/) {
-       print "1..0\n";
+       print "1..0 # Skip: NDBM_File was not built\n";
        exit 0;
     }
 }

diff --git a/t/lib/odbm.t b/t/lib/odbm.t
index 0ef2592..fc15d13 100755 (executable)
--- a/t/lib/odbm.t
+++ b/t/lib/odbm.t
@@ -7,7 +7,7 @@ BEGIN {
     unshift @INC, '../lib';
     require Config; import Config;
     if ($Config{'extensions'} !~ /\bODBM_File\b/) {
-       print "1..0\n";
+       print "1..0 # Skip: ODBM_File was not built\n";
        exit 0;
     }
 }

diff --git a/t/lib/thread.t b/t/lib/thread.t
index 5cc2eaf..3bca8ba 100755 (executable)
--- a/t/lib/thread.t
+++ b/t/lib/thread.t
@@ -5,7 +5,7 @@ BEGIN {
     unshift @INC, '../lib';
     require Config; import Config;
     if (! $Config{'usethreads'}) {
-       print "1..0\n";
+       print "1..0 # Skip: this perl is not threaded\n";
        exit 0;
     }
 

diff --git a/t/op/exec.t b/t/op/exec.t
index 098a455..5cf7386 100755 (executable)
--- a/t/op/exec.t
+++ b/t/op/exec.t
@@ -1,13 +1,10 @@
 #!./perl
 
-# $RCSfile: exec.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:49 $
-
 $| = 1;                                # flush stdout
 
 if ($^O eq 'MSWin32') {
-    print "# exec is unsupported on Win32\n";
     # XXX the system tests could be written to use ./perl and so work on Win32
-    print "1..0\n";
+    print "1..0 # Skip: shh, win32\n";
     exit(0);
 }
 

diff --git a/t/op/fork.t b/t/op/fork.t
index 516aa73..20c8747 100755 (executable)
--- a/t/op/fork.t
+++ b/t/op/fork.t
@@ -7,7 +7,7 @@ BEGIN {
     unshift @INC, '../lib';
     require Config; import Config;
     unless ($Config{'d_fork'}) {
-       print "1..0\n";
+       print "1..0 # Skip: no fork\n";
        exit 0;
     }
 }

diff --git a/t/op/grent.t b/t/op/grent.t
index abe6b5a..9b06f11 100755 (executable)
--- a/t/op/grent.t
+++ b/t/op/grent.t
@@ -4,12 +4,12 @@ BEGIN {
     chdir 't' if -d 't';
     unshift @INC, "../lib" if -d "../lib";
     eval { require Config; import Config; };
-
-    unless (defined $Config{'i_grp'} &&
-                   $Config{'i_grp'} eq 'define' &&
-           -f "/etc/group" ) { # Play safe.
-       print "1..0\n";
-       exit 0;
+    my $reason;
+    if ($Config{'i_grp'} ne 'define') {
+       $reason = '$Config{i_grp} not defined';
+    }
+    elsif (not -f "/etc/group" ) { # Play safe.
+       $reason = 'no /etc/group file';
     }
 
     if (not defined $where) {  # Try NIS.
@@ -18,6 +18,7 @@ BEGIN {
                open(GR, "$ypcat group 2>/dev/null |") &&
                defined(<GR>)) {
                $where = "NIS group";
+               undef $reason;
                last;
            }
        }
@@ -29,6 +30,7 @@ BEGIN {
                open(GR, "$nidump group . 2>/dev/null |") &&
                defined(<GR>)) {
                $where = "NetInfo group";
+               undef $reason;
                last;
            }
        }
@@ -37,12 +39,12 @@ BEGIN {
     if (not defined $where) {  # Try local.
        my $GR = "/etc/group";
        if (-f $GR && open(GR, $GR) && defined(<GR>)) {
+           undef $reason;
            $where = $GR;
        }
     }
-
-    if (not defined $where) {  # Give up.
-       print "1..0\n";
+    if ($reason) {
+       print "1..0 # Skip: $reason\n";
        exit 0;
     }
 }

diff --git a/t/op/groups.t b/t/op/groups.t
index 5778795..d22d8f0 100755 (executable)
--- a/t/op/groups.t
+++ b/t/op/groups.t
@@ -6,7 +6,7 @@ $ENV{LC_ALL} = "C"; # so that external utilities speak English
 $ENV{LANGUAGE} = 'C'; # GNU locale extension
 
 sub quit {
-    print "1..0\n";
+    print "1..0 # Skip: no `id` or `groups`\n";
     exit 0;
 }
 

diff --git a/t/op/nothread.t b/t/op/nothread.t
index cee8e2d..a434956 100755 (executable)
--- a/t/op/nothread.t
+++ b/t/op/nothread.t
@@ -11,7 +11,7 @@ BEGIN
   import Config;
   if ($Config{'usethreads'})
    {
-    print "1..0\n";
+    print "1..0 # Skip: this perl is threaded\n";
     exit 0;
    }
  }

diff --git a/t/op/numconvert.t b/t/op/numconvert.t
index 405f721..f71fd6c 100755 (executable)
--- a/t/op/numconvert.t
+++ b/t/op/numconvert.t
@@ -42,15 +42,7 @@ BEGIN {
 
 use strict 'vars';
 
-my $max_chain = $ENV{PERL_TEST_NUMCONVERTS};
-unless (defined $max_chain) {
-  my $is_debug;
-  eval <<'EOE';
-    use Config;
-    $is_debug = 1 if $Config{ccflags} =~ /-DDEBUGGING\b/;
-EOE
-  $max_chain = $is_debug ? 3 : 2;
-}
+my $max_chain = $ENV{PERL_TEST_NUMCONVERTS} || 2;
 
 # Bulk out if unsigned type is hopelessly wrong:
 my $max_uv1 = ~0;

diff --git a/t/op/pwent.t b/t/op/pwent.t
index cd5db34..feee6f2 100755 (executable)
--- a/t/op/pwent.t
+++ b/t/op/pwent.t
@@ -4,12 +4,12 @@ BEGIN {
     chdir 't' if -d 't';
     unshift @INC, "../lib" if -d "../lib";
     eval { require Config; import Config; };
-
-    unless (defined $Config{'i_pwd'} &&
-                   $Config{'i_pwd'} eq 'define' &&
-           -f "/etc/passwd" ) { # Play safe.
-       print "1..0\n";
-       exit 0;
+    my $reason;
+    if ($Config{'i_pwd'} ne 'define') {
+       $reason = '$Config{i_pwd} undefined';
+    }
+    elsif (not -f "/etc/passwd" ) { # Play safe.
+       $reason = 'no /etc/passwd file';
     }
 
     if (not defined $where) {  # Try NIS.
@@ -18,6 +18,7 @@ BEGIN {
                open(PW, "$ypcat passwd 2>/dev/null |") &&
                defined(<PW>)) {
                $where = "NIS passwd";
+               undef $reason;
                last;
            }
        }
@@ -29,6 +30,7 @@ BEGIN {
                open(PW, "$nidump passwd . 2>/dev/null |") &&
                defined(<PW>)) {
                $where = "NetInfo passwd";
+               undef $reason;
                last;
            }
        }
@@ -38,11 +40,12 @@ BEGIN {
        my $PW = "/etc/passwd";
        if (-f $PW && open(PW, $PW) && defined(<PW>)) {
            $where = $PW;
+           undef $reason;
        }
     }
 
-    if (not defined $where) {  # Give up.
-       print "1..0\n";
+    if ($reason) {     # Give up.
+       print "1..0 # Skip: $reason\n";
        exit 0;
     }
 }