make t/TEST detect various failure modes in testfile outputs

in particular:
    multiple leader lines
    leader line not first or last line of file
    unrecognised lines
    out-of-sequence test numbers

p4raw-id: //depot/perl@24390

diff --git a/t/TEST b/t/TEST
index 7dd688d..88e40fd 100755 (executable)
--- a/t/TEST
+++ b/t/TEST
@@ -259,7 +259,6 @@ EOT
     my $good_files = 0;
     my $tested_files  = 0;
     my $totmax = 0;
-    my $ok;
 
     my $test;
     while ($test = shift @tests) {
@@ -405,10 +404,11 @@ EOT
                or print "can't compile '$compile_cmd': $!.\n";
        }
 
-        $ok = 0;
+        my $failure;
         my $next = 0;
         my $seen_leader = 0;
         my $seen_ok = 0;
+       my $trailing_leader = 0;
        my $max;
        while (<RESULTS>) {
            next if /^\s*$/; # skip blank lines
@@ -417,26 +417,42 @@ EOT
            }
            unless (/^\#/) {
                my %todo;
+               if ($trailing_leader) {
+                   # shouldn't be anything following a postfix 1..n
+                   $failure = 'extra output after trailing 1..n';
+                   last;
+               }
                if (/^1\.\.([0-9]+)( todo ([\d ]+))?/) {
+                   if ($seen_leader) {
+                       $failure = 'seen duplicate leader';
+                       last;
+                   }
                    $max = $1;
                     %todo = map { $_ => 1 } split / /, $3 if $3;
                    $totmax += $max;
                    $tested_files++;
-                    unless ($seen_ok) {
-                      $next = 1;
-                      $ok = 1;
-                    }
+                    if ($seen_ok) {
+                       # 1..n appears at end of file
+                       $trailing_leader = 1;
+                       if ($next != $max) {
+                           $failure = "expected $max tests, saw $next";
+                           last;
+                       }
+                   }
+                   else {
+                       $next = 0;
+                   }
                     $seen_leader = 1;
                }
                else {
                    if (/^(not )?ok (\d+)[^\#]*(\s*\#.*)?/) {
                        unless ($seen_leader) {
                            unless ($seen_ok) {
-                               $next = 1;
-                               $ok = 1;
+                               $next = 0;
                            }
                        }
                        $seen_ok = 1;
+                       $next++;
                        if ($2 == $next) {
                            my($not, $num, $extra, $istodo) = ($1, $2, $3, 0);
                            # SKIP is essentially the same as TODO for t/TEST
@@ -446,25 +462,31 @@ EOT
                            $istodo = 1 if $todo{$num};
 
                            if( $not && !$istodo ) {
-                               $ok = 0;
-                               $next = $num;
+                               $failure = "FAILED at test $num";
                                last;
                            }
-                           else {
-                               $next = $next + 1;
-                           }
+                       }
+                       else {
+                           $failure ="expected test $next, saw test $2";
+                           last;
                        }
                     }
                     elsif (/^Bail out!\s*(.*)/i) { # magic words
                         die "FAILED--Further testing stopped" . ($1 ? ": $1\n" : ".\n");
                    }
                    else {
-                       $ok = 0;
+                       $failure = "Unexpected output at test $next";
+                       last;
                    }
                }
            }
        }
        close RESULTS;
+
+       if (not defined $failure) {
+           $failure = 'no leader found' unless $seen_leader;
+       }
+
        if ($ENV{PERL_VALGRIND}) {
            my @valgrind;
            if (-e $valgrind_log) {
@@ -517,13 +539,23 @@ EOT
            rename("perl.3log", $tpp) ||
                die "rename: perl3.log to $tpp: $!\n";
        }
-       $next = $next - 1;
         # test if the compiler compiled something
         if( $type eq 'compile' && !-e "$test_executable" ) {
-            $ok = 0;
-            print "Test did not compile\n";
+            $failure = "Test did not compile";
         }
-       if ($ok && $next == $max ) {
+       if (not defined $failure and $next != $max) {
+           $failure="expected $max tests, saw $next";
+       }
+
+       if (defined $failure) {
+           print "${te}$failure\n";
+           $::bad_files++;
+           $_ = $test;
+           if (/^base/) {
+               die "Failed a basic test--cannot continue.\n";
+           }
+       }
+       else {
            if ($max) {
                print "${te}ok\n";
                $good_files++;
@@ -533,24 +565,10 @@ EOT
                $tested_files -= 1;
            }
        }
-       else {
-           $next += 1;
-           if ($next > $max) {
-               print "${te}FAILED at test $next\tpossibly due to extra output\n";
-           }
-           else {
-               print "${te}FAILED at test $next\n";
-           }
-           $::bad_files++;
-           $_ = $test;
-           if (/^base/) {
-               die "Failed a basic test--cannot continue.\n";
-           }
-       }
     }
 
     if ($::bad_files == 0) {
-       if ($ok) {
+       if ($good_files) {
            print "All tests successful.\n";
            # XXX add mention of 'perlbug -ok' ?
        }