Sys::Hostname fails under Solaris 2.5 when setuid

[p5sagit/p5-mst-13.2.git] / lib / Test / Harness.pm

diff --git a/lib/Test/Harness.pm b/lib/Test/Harness.pm
index ba0683a..24e9148 100644 (file)
--- 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.15";
+$VERSION = "1.1502";
 
 @ISA=('Exporter');
 @EXPORT= qw(&runtests);
@@ -58,11 +58,17 @@ sub runtests {
     while ($test = shift(@tests)) {
        $te = $test;
        chop($te);
+       if ($^O eq 'VMS') { $te =~ s/^.*\.t\./[.t./; }
        print "$te" . '.' x (20 - length($te));
        my $fh = new FileHandle;
-       my $cmd = "$^X $switches $test|";
+       $fh->open($test) or print "can't open $test. $!\n";
+       my $first = <$fh>;
+       my $s = $switches;
+       $s .= q[ "-T"] if $first =~ /^#!.*\bperl.*-\w*T/;
+       $fh->close or print "can't close $test. $!\n";
+       my $cmd = "$^X $s $test|";
        $cmd = "MCR $cmd" if $^O eq 'VMS';
-       $fh->open($cmd) or print "can't run. $!\n";
+       $fh->open($cmd) or print "can't run $test. $!\n";
        $ok = $next = $max = 0;
        @failed = ();
        while (<$fh>) {
@@ -98,9 +104,14 @@ sub runtests {
        }
        $fh->close; # must close to reap child resource values
        my $wstatus = $?;
-       my $estatus = $^O eq 'VMS' ? $wstatus : $wstatus >> 8;
-       if ($^O eq 'VMS' ? !($wstatus & 1) : $wstatus) {
+       my $estatus;
+       $estatus = ($^O eq 'VMS'
+                      ? eval 'use vmsish "status"; $estatus = $?'
+                      : $wstatus >> 8);
+       if ($wstatus) {
+           my ($failed, $canon, $percent) = ('??', '??');
            print "dubious\n\tTest returned status $estatus (wstat $wstatus)\n";
+           print "\t\t(VMS status is $estatus)\n" if $^O eq 'VMS';
            if (corestatus($wstatus)) { # until we have a wait module
                if ($have_devel_corestack) {
                    Devel::CoreStack::stack($^X);
@@ -109,9 +120,22 @@ sub runtests {
                }
            }
            $bad++;
-           $failedtests{$test} = { canon => '??',  max => $max || '??',
-                                   failed => '??', 
-                                   name => $test, percent => undef,
+           if ($max) {
+             if ($next == $max + 1 and not @failed) {
+               print "\tafter all the subtests completed successfully\n";
+               $percent = 0;
+               $failed = 0;    # But we do not set $canon!
+             } else {
+               push @failed, $next..$max;
+               $failed = @failed;
+               (my $txt, $canon) = canonfailed($max,@failed);
+               $percent = 100*(scalar @failed)/$max;
+               print "DIED. ",$txt;
+             }
+           }
+           $failedtests{$test} = { canon => $canon,  max => $max || '??',
+                                   failed => $failed, 
+                                   name => $test, percent => $percent,
                                    estat => $estatus, wstat => $wstatus,
                                  };
        } elsif ($ok == $max && $next == $max+1) {
@@ -186,6 +210,7 @@ sub runtests {
     return ($bad == 0 && $totmax) ;
 }
 
+my $tried_devel_corestack;
 sub corestatus {
     my($st) = @_;
     my($ret);
@@ -199,8 +224,8 @@ sub corestatus {
        $ret = WCOREDUMP($st);
     }
 
-    eval {require Devel::CoreStack};
-    $have_devel_corestack++ unless $@;
+    eval { require Devel::CoreStack; $have_devel_corestack++ } 
+      unless $tried_devel_corestack++;
 
     $ret;
 }