Make t/TEST more helpful
Andy Lester [Tue, 23 May 2006 21:07:48 +0000 (16:07 -0500)]
Message-ID: <20060524020748.GA16729@petdance.com>

p4raw-id: //depot/perl@28294

t/TEST

diff --git a/t/TEST b/t/TEST
index 3e2fdf1..08530ff 100755 (executable)
--- a/t/TEST
+++ b/t/TEST
@@ -261,6 +261,7 @@ EOT
     my $good_files = 0;
     my $tested_files  = 0;
     my $totmax = 0;
+    my %failed_tests;
 
     while (my $test = shift @tests) {
         my $test_start_time = $show_elapsed_time ? Time::HiRes::time() : 0;
@@ -564,10 +565,10 @@ EOT
        if (defined $failure) {
            print "${te}$failure\n";
            $::bad_files++;
-           $_ = $test;
-           if (/^base/) {
-               die "Failed a basic test--cannot continue.\n";
+           if ($test =~ /^base/) {
+               die "Failed a basic test ($test) -- cannot continue.\n";
            }
+           ++$failed_tests{$test};
        }
        else {
            if ($max) {
@@ -599,11 +600,10 @@ EOT
     }
     else {
        my $pct = $tested_files ? sprintf("%.2f", ($tested_files - $::bad_files) / $tested_files * 100) : "0.00";
-       if ($::bad_files == 1) {
-           warn "Failed 1 test script out of $tested_files, $pct% okay.\n";
-       }
-       else {
-           warn "Failed $::bad_files test scripts out of $tested_files, $pct% okay.\n";
+       my $s = $::bad_files == 1 ? "" : "s";
+       warn "Failed $::bad_files test$s out of $tested_files, $pct% okay.\n";
+       for my $test ( sort keys %failed_tests ) {
+           print "\t$test\n";
        }
        warn <<'SHRDLU_1';
 ### Since not all tests were successful, you may want to run some of
@@ -650,3 +650,5 @@ SHRDLU_5
     }
 }
 exit ($::bad_files != 0);
+
+# ex: set ts=8 sts=4 sw=4 noet: