Fix crash in (Gnu)TLS debug output

[exim.git] / test / runtest

diff --git a/test/runtest b/test/runtest
index fb1cfc762043c2918cf0190e374ee66649e924c8..088c742be5ff0532712a4a6139542594ee6d8620 100755 (executable)
--- a/test/runtest
+++ b/test/runtest
@@ -26,9 +26,9 @@ use Socket;
 use Time::Local;
 use Cwd;
 use File::Basename;
 use Time::Local;
 use Cwd;
 use File::Basename;

-use FindBin qw'$Bin';
+use FindBin qw'$RealBin';

 
 

-use lib "$Bin/lib";
+use lib "$RealBin/lib";

 use Exim::Runtest;
 
 use if $ENV{DEBUG} && $ENV{DEBUG} =~ /\bruntest\b/ => ('Smart::Comments' => '####');
 use Exim::Runtest;
 
 use if $ENV{DEBUG} && $ENV{DEBUG} =~ /\bruntest\b/ => ('Smart::Comments' => '####');


@@ -36,7 +36,7 @@ use if $ENV{DEBUG} && $ENV{DEBUG} =~ /\bruntest\b/ => ('Smart::Comments' => '###
 
 # Start by initializing some global variables
 
 
 # Start by initializing some global variables
 

-$testversion = "4.80 (08-May-12)";
+chomp(my $testversion = `git describe --always --dirty 2>&1` || '<unknown>');

 
 # This gets embedded in the D-H params filename, and the value comes
 # from asking GnuTLS for "normal", but there appears to be no way to
 
 # This gets embedded in the D-H params filename, and the value comes
 # from asking GnuTLS for "normal", but there appears to be no way to


@@ -44,30 +44,34 @@ $testversion = "4.80 (08-May-12)";
 # We also clamp it because of NSS interop, see addition of tls_dh_max_bits.
 # This value is correct as of GnuTLS 2.12.18 as clamped by tls_dh_max_bits.
 # normal = 2432   tls_dh_max_bits = 2236
 # We also clamp it because of NSS interop, see addition of tls_dh_max_bits.
 # This value is correct as of GnuTLS 2.12.18 as clamped by tls_dh_max_bits.
 # normal = 2432   tls_dh_max_bits = 2236

-$gnutls_dh_bits_normal = 2236;
-
-$cf = "bin/cf -exact";
-$cr = "\r";
-$debug = 0;
-$flavour = 'FOO';
-$force_continue = 0;
-$force_update = 0;
-$log_failed_filename = "failed-summary.log";
-$more = "less -XF";
-$optargs = "";
-$save_output = 0;
-$server_opts = "";
-$valgrind = 0;
-
-$have_ipv4 = 1;
-$have_ipv6 = 1;
-$have_largefiles = 0;
-
-$test_start = 1;
-$test_end = $test_top = 8999;
-$test_special_top = 9999;
-@test_list = ();
-@test_dirs = ();
+my $gnutls_dh_bits_normal = 2236;
+
+my $cf = 'bin/cf -exact';
+my $cr = "\r";
+my $debug = 0;
+my $flavour = do {
+  my $f = Exim::Runtest::flavour();
+  (grep { $f eq $_ } Exim::Runtest::flavours()) ? $f : 'FOO';
+};
+my $force_continue = 0;
+my $force_update = 0;
+my $log_failed_filename = 'failed-summary.log';
+my $log_summary_filename = 'run-summary.log';
+my $more = 'less -XF';
+my $optargs = '';
+my $save_output = 0;
+my $server_opts = '';
+my $valgrind = 0;
+
+my $have_ipv4 = 1;
+my $have_ipv6 = 1;
+my $have_largefiles = 0;
+
+my $test_start = 1;
+my $test_end = $test_top = 8999;
+my $test_special_top = 9999;
+my @test_list = ();
+my @test_dirs = ();

 
 
 # Networks to use for DNS tests. We need to choose some networks that will
 
 
 # Networks to use for DNS tests. We need to choose some networks that will


@@ -80,17 +84,17 @@ $test_special_top = 9999;
 # are defined, so it is trivially possible to change them should that ever
 # become necessary.
 
 # are defined, so it is trivially possible to change them should that ever
 # become necessary.
 

-$parm_ipv4_test_net = "224";
-$parm_ipv6_test_net = "ff00";
+my $parm_ipv4_test_net = 224;
+my $parm_ipv6_test_net = 'ff00';

 
 # Port numbers are currently hard-wired
 
 
 # Port numbers are currently hard-wired
 

-$parm_port_n = 1223;         # Nothing listening on this port
-$parm_port_s = 1224;         # Used for the "server" command
-$parm_port_d = 1225;         # Used for the Exim daemon
-$parm_port_d2 = 1226;        # Additional for daemon
-$parm_port_d3 = 1227;        # Additional for daemon
-$parm_port_d4 = 1228;        # Additional for daemon
+my $parm_port_n = 1223;         # Nothing listening on this port
+my $parm_port_s = 1224;         # Used for the "server" command
+my $parm_port_d = 1225;         # Used for the Exim daemon
+my $parm_port_d2 = 1226;        # Additional for daemon
+my $parm_port_d3 = 1227;        # Additional for daemon
+my $parm_port_d4 = 1228;        # Additional for daemon

 my $dynamic_socket;          # allocated later for PORT_DYNAMIC
 
 # Find a suiteable group name for test (currently only 0001
 my $dynamic_socket;          # allocated later for PORT_DYNAMIC
 
 # Find a suiteable group name for test (currently only 0001


@@ -100,10 +104,8 @@ my $parm_mailgroup = Exim::Runtest::mailgroup('mail');
 # Manually set locale
 $ENV{LC_ALL} = 'C';
 
 # Manually set locale
 $ENV{LC_ALL} = 'C';
 

-# In some environments USER does not exists, but we
-# need it for some test(s)
-$ENV{USER} = getpwuid($>)
-  if not exists $ENV{USER};
+# In some environments USER does not exist, but we need it for some test(s)
+$ENV{USER} = getpwuid($>) if not exists $ENV{USER};

 
 my ($parm_configure_owner, $parm_configure_group);
 my ($parm_ipv4, $parm_ipv6);
 
 my ($parm_configure_owner, $parm_configure_group);
 my ($parm_ipv4, $parm_ipv6);


@@ -458,7 +460,7 @@ RESET_AFTER_EXTRA_LINE_READ:
   if (/^($date)\s+($date)\s+($date)(\s+\*)?\s*$/)
     {
     my($date1,$date2,$date3,$expired) = ($1,$2,$3,$4);
   if (/^($date)\s+($date)\s+($date)(\s+\*)?\s*$/)
     {
     my($date1,$date2,$date3,$expired) = ($1,$2,$3,$4);

-    $expired = "" if !defined $expired;
+    $expired = '' if !defined $expired;

     my($increment) = date_seconds($date3) - date_seconds($date2);
 
     # We used to use globally unique replacement values, but timing
     my($increment) = date_seconds($date3) - date_seconds($date2);
 
     # We used to use globally unique replacement values, but timing


@@ -550,6 +552,10 @@ RESET_AFTER_EXTRA_LINE_READ:
   s/\bAES256-GCM-SHA384\b/AES256-SHA/g;
   s/\bDHE-RSA-AES256-SHA\b/AES256-SHA/g;
 
   s/\bAES256-GCM-SHA384\b/AES256-SHA/g;
   s/\bDHE-RSA-AES256-SHA\b/AES256-SHA/g;
 

+  # LibreSSL
+  # TLSv1:ECDHE-RSA-CHACHA20-POLY1305:256
+  s/\bECDHE-RSA-CHACHA20-POLY1305\b/AES256-SHA/g;
+

   # GnuTLS have seen:
   #   TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256
   #   TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128
   # GnuTLS have seen:
   #   TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256
   #   TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128


@@ -1075,6 +1081,8 @@ RESET_AFTER_EXTRA_LINE_READ:
       {
       $_ .= <IN>;
       s/ \.\.\. >>> / ... /;
       {
       $_ .= <IN>;
       s/ \.\.\. >>> / ... /;

+      s/Address family not supported by protocol family/Network Error/;
+      s/Network is unreachable/Network Error/;

       }
 
     next if /^(ppppp )?setsockopt FASTOPEN: Protocol not available$/;
       }
 
     next if /^(ppppp )?setsockopt FASTOPEN: Protocol not available$/;


@@ -1197,6 +1205,15 @@ sub log_failure {
         . "failed\n";
 }
 
         . "failed\n";
 }
 

+# Computer-readable summary results logfile
+
+sub log_test {
+  my ($logfile, $testno, $resultchar) = @_;
+
+  open(my $fh, '>>', $logfile) or return;
+  print $fh "$testno $resultchar\n";
+}
+

 
 
 ##################################################
 
 
 ##################################################


@@ -1214,8 +1231,9 @@ sub log_failure {
 #             [4] TRUE if this is a log file whose deliveries must be sorted
 #             [5] optionally, a custom munge command
 #
 #             [4] TRUE if this is a log file whose deliveries must be sorted
 #             [5] optionally, a custom munge command
 #

-# Returns:    0 comparison succeeded or differences to be ignored
-#             1 comparison failed; files may have been updated (=> re-compare)
+# Returns:    0 comparison succeeded
+#             1 comparison failed; differences to be ignored
+#             2 comparison failed; files may have been updated (=> re-compare)

 #
 # Does not return if the user replies "Q" to a prompt.
 
 #
 # Does not return if the user replies "Q" to a prompt.
 


@@ -1243,8 +1261,11 @@ if (! -e $sf_current)
     {
     $_ = interact('Continue, Show, or Quit? [Q] ', undef, $force_continue);
     tests_exit(1) if /^q?$/;
     {
     $_ = interact('Continue, Show, or Quit? [Q] ', undef, $force_continue);
     tests_exit(1) if /^q?$/;

-    log_failure($log_failed_filename, $testno, $rf) if (/^c$/ && $force_continue);
-    return 0 if /^c$/i;
+    if (/^c$/ && $force_continue) {
+      log_failure($log_failed_filename, $testno, $rf);
+      log_test($log_summary_filename, $testno, 'F') if ($force_continue);
+    }
+    return 1 if /^c$/i;

     last if (/^s$/);
     }
 
     last if (/^s$/);
     }
 


@@ -1264,8 +1285,11 @@ if (! -e $sf_current)
     {
     $_ = interact('Continue, Update & retry, Quit? [Q] ', $force_update, $force_continue);
     tests_exit(1) if /^q?$/;
     {
     $_ = interact('Continue, Update & retry, Quit? [Q] ', $force_update, $force_continue);
     tests_exit(1) if /^q?$/;

-    log_failure($log_failed_filename, $testno, $rsf) if (/^c$/ && $force_continue);
-    return 0 if /^c$/i;
+    if (/^c$/ && $force_continue) {
+      log_failure($log_failed_filename, $testno, $rf);
+      log_test($log_summary_filename, $testno, 'F')
+    }
+    return 1 if /^c$/i;

     last if (/^u$/i);
     }
   }
     last if (/^u$/i);
     }
   }


@@ -1276,8 +1300,10 @@ if (! -e $sf_current)
 # was a request to create a saved file. First, create the munged file from any
 # data that does exist.
 
 # was a request to create a saved file. First, create the munged file from any
 # data that does exist.
 

-open(MUNGED, ">$mf") || tests_exit(-1, "Failed to open $mf: $!");
+open(MUNGED, '>', $mf) || tests_exit(-1, "Failed to open $mf: $!");

 my($truncated) = munge($rf, $extra) if -e $rf;
 my($truncated) = munge($rf, $extra) if -e $rf;

+
+# Append the raw server log, if it is non-empty

 if (defined $rsf && -e $rsf)
   {
   print MUNGED "\n******** SERVER ********\n";
 if (defined $rsf && -e $rsf)
   {
   print MUNGED "\n******** SERVER ********\n";


@@ -1307,7 +1333,7 @@ if (-e $sf_current)
     {
     my(@munged, @saved, $i, $j, $k);
 
     {
     my(@munged, @saved, $i, $j, $k);
 

-    open(MUNGED, "$mf") || tests_exit(-1, "Failed to open $mf: $!");
+    open(MUNGED, $mf) || tests_exit(-1, "Failed to open $mf: $!");

     @munged = <MUNGED>;
     close(MUNGED);
     open(SAVED, $sf_current) || tests_exit(-1, "Failed to open $sf_current: $!");
     @munged = <MUNGED>;
     close(MUNGED);
     open(SAVED, $sf_current) || tests_exit(-1, "Failed to open $sf_current: $!");


@@ -1332,7 +1358,7 @@ if (-e $sf_current)
         }
       }
 
         }
       }
 

-    open(MUNGED, ">$mf") || tests_exit(-1, "Failed to open $mf: $!");
+    open(MUNGED, '>', $mf) || tests_exit(-1, "Failed to open $mf: $!");

     for ($i = 0; $i < @munged; $i++)
       { print MUNGED $munged[$i]; }
     close(MUNGED);
     for ($i = 0; $i < @munged; $i++)
       { print MUNGED $munged[$i]; }
     close(MUNGED);


@@ -1344,7 +1370,7 @@ if (-e $sf_current)
     {
     my(@munged, $i, $j);
 
     {
     my(@munged, $i, $j);
 

-    open(MUNGED, "$mf") || tests_exit(-1, "Failed to open $mf: $!");
+    open(MUNGED, $mf) || tests_exit(-1, "Failed to open $mf: $!");

     @munged = <MUNGED>;
     close(MUNGED);
 
     @munged = <MUNGED>;
     close(MUNGED);
 


@@ -1386,9 +1412,12 @@ if (-e $sf_current)
        . ($sf_current ne $sf_flavour  ? "/Save for flavour '$flavour'" : '')
        . ' & retry, Quit? [Q] ', $force_update, $force_continue);
     tests_exit(1) if /^q?$/;
        . ($sf_current ne $sf_flavour  ? "/Save for flavour '$flavour'" : '')
        . ' & retry, Quit? [Q] ', $force_update, $force_continue);
     tests_exit(1) if /^q?$/;

-    log_failure($log_failed_filename, $testno, $sf_current) if (/^c$/i && $force_continue);
-    return 0 if /^c$/i;
-    return 1 if /^r$/i;
+    if (/^c$/ && $force_continue) {
+      log_failure($log_failed_filename, $testno, $sf_current);
+      log_test($log_summary_filename, $testno, 'F')
+    }
+    return 1 if /^c$/i;
+    return 2 if /^r$/i;

     last if (/^[us]$/i);
     }
   }
     last if (/^[us]$/i);
     }
   }


@@ -1397,23 +1426,23 @@ if (-e $sf_current)
 
 if (-s $mf)
   {
 
 if (-s $mf)
   {

-       my $sf = /^u/i ? $sf_current : $sf_flavour;
-               tests_exit(-1, "Failed to cp $mf $sf") if system("cp '$mf' '$sf'") != 0;
+    my $sf = /^u/i ? $sf_current : $sf_flavour;
+    tests_exit(-1, "Failed to cp $mf $sf") if system("cp '$mf' '$sf'") != 0;

   }
 else
   {
   }
 else
   {

-       # if we deal with a flavour file, we can't delete it, because next time the generic
-       # file would be used again
-       if ($sf_current eq $sf_flavour) {
-               open(FOO, ">$sf_current");
-               close(FOO);
-       }
-       else {
-               tests_exit(-1, "Failed to unlink $sf_current") if !unlink($sf_current);
-       }
+    # if we deal with a flavour file, we can't delete it, because next time the generic
+    # file would be used again
+    if ($sf_current eq $sf_flavour) {
+      open(FOO, ">$sf_current");
+      close(FOO);
+    }
+    else {
+      tests_exit(-1, "Failed to unlink $sf_current") if !unlink($sf_current);
+    }

   }
 
   }
 

-return 1;
+return 2;

 }
 
 
 }
 
 


@@ -1493,6 +1522,12 @@ $munges =
   };
 
 
   };
 
 

+sub max {
+  my ($a, $b) = @_;
+  return $a if ($a > $b);
+  return $b;
+}
+

 ##################################################
 #    Subroutine to check the output of a test    #
 ##################################################
 ##################################################
 #    Subroutine to check the output of a test    #
 ##################################################


@@ -1509,47 +1544,48 @@ $munges =
 #
 # Arguments: Optionally, name of a single custom munge to run.
 # Returns:   0 if the output compared equal
 #
 # Arguments: Optionally, name of a single custom munge to run.
 # Returns:   0 if the output compared equal

-#            1 if re-run needed (files may have been updated)
+#            1 if comparison failed; differences to be ignored
+#            2 if re-run needed (files may have been updated)

 
 sub check_output{
 my($mungename) = $_[0];
 my($yield) = 0;
 my($munge) = $munges->{$mungename} if defined $mungename;
 
 
 sub check_output{
 my($mungename) = $_[0];
 my($yield) = 0;
 my($munge) = $munges->{$mungename} if defined $mungename;
 

-$yield = 1 if check_file("spool/log/paniclog",
+$yield = max($yield,  check_file("spool/log/paniclog",

                        "spool/log/serverpaniclog",
                        "test-paniclog-munged",
                        "paniclog/$testno", 0,
                        "spool/log/serverpaniclog",
                        "test-paniclog-munged",
                        "paniclog/$testno", 0,

-                      $munge->{'paniclog'});
+                      $munge->{paniclog}));

 
 

-$yield = 1 if check_file("spool/log/rejectlog",
+$yield = max($yield,  check_file("spool/log/rejectlog",

                        "spool/log/serverrejectlog",
                        "test-rejectlog-munged",
                        "rejectlog/$testno", 0,
                        "spool/log/serverrejectlog",
                        "test-rejectlog-munged",
                        "rejectlog/$testno", 0,

-                      $munge->{'rejectlog'});
+                      $munge->{rejectlog}));

 
 

-$yield = 1 if check_file("spool/log/mainlog",
+$yield = max($yield,  check_file("spool/log/mainlog",

                        "spool/log/servermainlog",
                        "test-mainlog-munged",
                        "log/$testno", $sortlog,
                        "spool/log/servermainlog",
                        "test-mainlog-munged",
                        "log/$testno", $sortlog,

-                      $munge->{'mainlog'});
+                      $munge->{mainlog}));

 
 if (!$stdout_skip)
   {
 
 if (!$stdout_skip)
   {

-  $yield = 1 if check_file("test-stdout",
+  $yield = max($yield,  check_file("test-stdout",

                        "test-stdout-server",
                        "test-stdout-munged",
                        "stdout/$testno", 0,
                        "test-stdout-server",
                        "test-stdout-munged",
                        "stdout/$testno", 0,

-                      $munge->{'stdout'});
+                      $munge->{stdout}));

   }
 
 if (!$stderr_skip)
   {
   }
 
 if (!$stderr_skip)
   {

-  $yield = 1 if check_file("test-stderr",
+  $yield = max($yield,  check_file("test-stderr",

                        "test-stderr-server",
                        "test-stderr-munged",
                        "stderr/$testno", 0,
                        "test-stderr-server",
                        "test-stderr-munged",
                        "stderr/$testno", 0,

-                      $munge->{'stderr'});
+                      $munge->{stderr}));

   }
 
 # Compare any delivered messages, unless this test is skipped.
   }
 
 # Compare any delivered messages, unless this test is skipped.


@@ -1587,9 +1623,9 @@ if (! $message_skip)
       }
 
     print ">> COMPARE $mail mail/$testno.$saved_mail\n" if $debug;
       }
 
     print ">> COMPARE $mail mail/$testno.$saved_mail\n" if $debug;

-    $yield = 1 if check_file($mail, undef, "test-mail-munged",
+    $yield = max($yield,  check_file($mail, undef, "test-mail-munged",

       "mail/$testno.$saved_mail", 0,
       "mail/$testno.$saved_mail", 0,

-      $munge->{'mail'});
+      $munge->{mail}));

     delete $expected_mails{"mail/$testno.$saved_mail"};
     }
 
     delete $expected_mails{"mail/$testno.$saved_mail"};
     }
 


@@ -1604,7 +1640,10 @@ if (! $message_skip)
       {
       $_ = interact('Continue, Update & retry, or Quit? [Q] ', $force_update, $force_continue);
       tests_exit(1) if /^q?$/;
       {
       $_ = interact('Continue, Update & retry, or Quit? [Q] ', $force_update, $force_continue);
       tests_exit(1) if /^q?$/;

-      log_failure($log_failed_filename, $testno, "missing email") if (/^c$/ && $force_continue);
+      if (/^c$/ && $force_continue) {
+       log_failure($log_failed_filename, $testno, "missing email");
+       log_test($log_summary_filename, $testno, 'F')
+      }

       last if /^c$/;
 
       # For update, we not only have to unlink the file, but we must also
       last if /^c$/;
 
       # For update, we not only have to unlink the file, but we must also


@@ -1659,9 +1698,9 @@ if (! $msglog_skip)
       ($munged_msglog = $msglog) =~
         s/((?:[^\W_]{6}-){2}[^\W_]{2})
           /new_value($1, "10Hm%s-0005vi-00", \$next_msgid)/egx;
       ($munged_msglog = $msglog) =~
         s/((?:[^\W_]{6}-){2}[^\W_]{2})
           /new_value($1, "10Hm%s-0005vi-00", \$next_msgid)/egx;

-      $yield = 1 if check_file("spool/msglog/$msglog", undef,
+      $yield = max($yield,  check_file("spool/msglog/$msglog", undef,

         "test-msglog-munged", "msglog/$testno.$munged_msglog", 0,
         "test-msglog-munged", "msglog/$testno.$munged_msglog", 0,

-        $munge->{'msglog'});
+        $munge->{msglog}));

       delete $expected_msglogs{"$testno.$munged_msglog"};
       }
     }
       delete $expected_msglogs{"$testno.$munged_msglog"};
       }
     }


@@ -1688,7 +1727,10 @@ if (! $msglog_skip)
       {
       $_ = interact('Continue, Update, or Quit? [Q] ', $force_update, $force_continue);
       tests_exit(1) if /^q?$/;
       {
       $_ = interact('Continue, Update, or Quit? [Q] ', $force_update, $force_continue);
       tests_exit(1) if /^q?$/;

-      log_failure($log_failed_filename, $testno, "missing msglog") if (/^c$/ && $force_continue);
+      if (/^c$/ && $force_continue) {
+       log_failure($log_failed_filename, $testno, "missing msglog");
+       log_test($log_summary_filename, $testno, 'F')
+      }

       last if /^c$/;
       if (/^u$/)
         {
       last if /^c$/;
       if (/^u$/)
         {


@@ -1877,8 +1919,16 @@ if (/^dump\s+(\S+)/)
   }
 
 
   }
 
 

-# The "echo" command is a way of writing comments to the screen.
+# verbose comments start with ###
+if (/^###\s/) {
+  for my $file (qw(test-stdout test-stderr test-stderr-server test-stdout-server)) {
+    open my $fh, '>>', $file or die "Can't open >>$file: $!\n";
+    say {$fh} $_;
+  }
+  return 0;
+}

 
 

+# The "echo" command is a way of writing comments to the screen.

 if (/^echo\s+(.*)$/)
   {
   print "$1\n";
 if (/^echo\s+(.*)$/)
   {
   print "$1\n";


@@ -2115,7 +2165,7 @@ if (/^(cat)?write\s+(\S+)(?:\s+(.*))?\s*$/)
     while (scalar @sizes > 0)
       {
       ($count,$len,$leadin) = (shift @sizes) =~ /(\d+)x(\d+)(?:=(.*))?/;
     while (scalar @sizes > 0)
       {
       ($count,$len,$leadin) = (shift @sizes) =~ /(\d+)x(\d+)(?:=(.*))?/;

-      $leadin = "" if !defined $leadin;
+      $leadin = '' if !defined $leadin;

       $leadin =~ s/_/ /g;
       $len -= length($leadin) + 1;
       while ($count-- > 0)
       $leadin =~ s/_/ /g;
       $len -= length($leadin) + 1;
       while ($count-- > 0)


@@ -2174,9 +2224,9 @@ if (/^client/ || /^(sudo\s+)?perl\b/)
 elsif (/^((?i:[A-Z\d_]+=\S+\s+)+)?(\d+)?\s*(sudo(?:\s+-u\s+(\w+))?\s+)?exim(_\S+)?\s+(.*)$/)
   {
   $args = $6;
 elsif (/^((?i:[A-Z\d_]+=\S+\s+)+)?(\d+)?\s*(sudo(?:\s+-u\s+(\w+))?\s+)?exim(_\S+)?\s+(.*)$/)
   {
   $args = $6;

-  my($envset) = (defined $1)? $1      : "";
-  my($sudo)   = (defined $3)? "sudo " . (defined $4 ? "-u $4 ":"")  : "";
-  my($special)= (defined $5)? $5      : "";
+  my($envset) = (defined $1)? $1      : '';
+  my($sudo)   = (defined $3)? "sudo " . (defined $4 ? "-u $4 ":'')  : '';
+  my($special)= (defined $5)? $5      : '';

   $wait_time  = (defined $2)? $2      : 0;
 
   # Return 2 rather than 1 afterwards
   $wait_time  = (defined $2)? $2      : 0;
 
   # Return 2 rather than 1 afterwards


@@ -2231,7 +2281,7 @@ elsif (/^((?i:[A-Z\d_]+=\S+\s+)+)?(\d+)?\s*(sudo(?:\s+-u\s+(\w+))?\s+)?exim(_\S+
 
   $args =~ s/(?:^|\s)-d\S*// if $optargs =~ /(?:^|\s)-d/;
 
 
   $args =~ s/(?:^|\s)-d\S*// if $optargs =~ /(?:^|\s)-d/;
 

-  my $opt_valgrind = $valgrind ? "valgrind --leak-check=yes --suppressions=$parm_cwd/aux-fixed/valgrind.supp " : "";
+  my $opt_valgrind = $valgrind ? "valgrind --leak-check=yes --suppressions=$parm_cwd/aux-fixed/valgrind.supp " : '';

 
   $cmd = "$envset$sudo$opt_valgrind" .
          "$parm_cwd/eximdir/exim$special$optargs " .
 
   $cmd = "$envset$sudo$opt_valgrind" .
          "$parm_cwd/eximdir/exim$special$optargs " .


@@ -2359,7 +2409,7 @@ else { tests_exit(-1, "Command unrecognized in line $lineno: $_"); }
 # -DSERVER=server add "-server" to the command, where it will adjoin the name
 # for the stderr file. See comment above about the use of -DSERVER.
 
 # -DSERVER=server add "-server" to the command, where it will adjoin the name
 # for the stderr file. See comment above about the use of -DSERVER.
 

-$stderrsuffix = ($cmd =~ /\s-DSERVER=server\s/)? "-server" : "";
+$stderrsuffix = ($cmd =~ /\s-DSERVER=server\s/)? "-server" : '';

 print ">> |${cmd}${stderrsuffix}\n" if ($debug);
 open CMD, "|${cmd}${stderrsuffix}" || tests_exit(1, "Failed to run $cmd");
 
 print ">> |${cmd}${stderrsuffix}\n" if ($debug);
 open CMD, "|${cmd}${stderrsuffix}" || tests_exit(1, "Failed to run $cmd");
 


@@ -2456,7 +2506,7 @@ else
 # '/' but exists in the file system, it's assumed to be the Exim binary.
 
 ($parm_exim, @ARGV) = Exim::Runtest::exim_binary(@ARGV);
 # '/' but exists in the file system, it's assumed to be the Exim binary.
 
 ($parm_exim, @ARGV) = Exim::Runtest::exim_binary(@ARGV);

-print "Exim binary is $parm_exim\n" if $parm_exim ne "";
+print "Exim binary is $parm_exim\n" if $parm_exim ne '';

 
 
 
 
 
 


@@ -2471,7 +2521,7 @@ print "Exim binary is $parm_exim\n" if $parm_exim ne "";
 while (@ARGV > 0 && $ARGV[0] =~ /^-/)
   {
   my($arg) = shift @ARGV;
 while (@ARGV > 0 && $ARGV[0] =~ /^-/)
   {
   my($arg) = shift @ARGV;

-  if ($optargs eq "")
+  if ($optargs eq '')

     {
     if ($arg eq "-DEBUG")  { $debug = 1; $cr = "\n"; next; }
     if ($arg eq "-DIFF")   { $cf = "diff -u"; next; }
     {
     if ($arg eq "-DEBUG")  { $debug = 1; $cr = "\n"; next; }
     if ($arg eq "-DIFF")   { $cf = "diff -u"; next; }


@@ -2524,7 +2574,7 @@ $parm_cwd = Cwd::getcwd();
 
 # If $parm_exim is still empty, ask the caller
 
 
 # If $parm_exim is still empty, ask the caller
 

-if ($parm_exim eq "")
+if ($parm_exim eq '')

   {
   print "** Did not find an Exim binary to test\n";
   for ($i = 0; $i < 5; $i++)
   {
   print "** Did not find an Exim binary to test\n";
   for ($i = 0; $i < 5; $i++)


@@ -2542,7 +2592,7 @@ if ($parm_exim eq "")
       print "** $trybin does not exist\n";
       }
     }
       print "** $trybin does not exist\n";
       }
     }

-  die "** Too many tries\n" if $parm_exim eq "";
+  die "** Too many tries\n" if $parm_exim eq '';

   }
 
 
   }
 
 


@@ -2716,7 +2766,7 @@ while (<EXIMINFO>)
       if ($k =~ "/")
         {
         @temp = split /\//, $k;
       if ($k =~ "/")
         {
         @temp = split /\//, $k;

-        $parm_transports{"$temp[0]"} = " ";
+        $parm_transports{$temp[0]} = " ";

         for ($i = 1; $i < @temp; $i++)
           { $parm_transports{"$temp[0]/$temp[$i]"} = " "; }
         }
         for ($i = 1; $i < @temp; $i++)
           { $parm_transports{"$temp[0]/$temp[$i]"} = " "; }
         }


@@ -2735,7 +2785,7 @@ unlink("$parm_cwd/test-config");
 # These are crude tests. If they aren't good enough, we'll have to improve
 # them, for example by actually passing a message through spamc or clamscan.
 
 # These are crude tests. If they aren't good enough, we'll have to improve
 # them, for example by actually passing a message through spamc or clamscan.
 

-if (defined $parm_support{'Content_Scanning'})
+if (defined $parm_support{Content_Scanning})

   {
   my $sock = new FileHandle;
 
   {
   my $sock = new FileHandle;
 


@@ -2786,7 +2836,7 @@ if (defined $parm_support{'Content_Scanning'})
       }
     else
       {
       }
     else
       {

-      $parm_running{'SpamAssassin'} = ' ';
+      $parm_running{SpamAssassin} = ' ';

       print "  SpamAssassin (spamd) seems to be running\n";
       }
     }
       print "  SpamAssassin (spamd) seems to be running\n";
       }
     }


@@ -2805,11 +2855,11 @@ if (defined $parm_support{'Content_Scanning'})
     print "The clamscan command works";
 
     $test_prefix = $ENV{EXIM_TEST_PREFIX};
     print "The clamscan command works";
 
     $test_prefix = $ENV{EXIM_TEST_PREFIX};

-    $test_prefix = "" if !defined $test_prefix;
+    $test_prefix = '' if !defined $test_prefix;

 
     foreach $f ("$test_prefix/etc/clamd.conf",
                 "$test_prefix/usr/local/etc/clamd.conf",
 
     foreach $f ("$test_prefix/etc/clamd.conf",
                 "$test_prefix/usr/local/etc/clamd.conf",

-                "$test_prefix/etc/clamav/clamd.conf", "")
+                "$test_prefix/etc/clamav/clamd.conf", '')

       {
       if (-e $f)
         {
       {
       if (-e $f)
         {


@@ -2820,7 +2870,7 @@ if (defined $parm_support{'Content_Scanning'})
 
     # Read the ClamAV configuration file and find the socket interface.
 
 
     # Read the ClamAV configuration file and find the socket interface.
 

-    if ($clamconf ne "")
+    if ($clamconf ne '')

       {
       my $socket_domain;
       open(IN, "$clamconf") || die "\n** Unable to open $clamconf: $!\n";
       {
       my $socket_domain;
       open(IN, "$clamconf") || die "\n** Unable to open $clamconf: $!\n";


@@ -2907,7 +2957,7 @@ if (defined $parm_support{'Content_Scanning'})
           }
         else
           {
           }
         else
           {

-          $parm_running{'ClamAV'} = ' ';
+          $parm_running{ClamAV} = ' ';

           print "  ClamAV seems to be running\n";
           }
         }
           print "  ClamAV seems to be running\n";
           }
         }


@@ -2930,12 +2980,12 @@ if (defined $parm_support{'Content_Scanning'})
 ##################################################
 #       Check for redis                          #
 ##################################################
 ##################################################
 #       Check for redis                          #
 ##################################################

-if (defined $parm_lookups{'redis'})
+if (defined $parm_lookups{redis})

   {
   if (system("redis-server -v 2>/dev/null >/dev/null") == 0)
     {
     print "The redis-server command works\n";
   {
   if (system("redis-server -v 2>/dev/null >/dev/null") == 0)
     {
     print "The redis-server command works\n";

-    $parm_running{'redis'} = ' ';
+    $parm_running{redis} = ' ';

     }
   else
     {
     }
   else
     {


@@ -2950,21 +3000,21 @@ if (defined $parm_lookups{'redis'})
 # This test suite assumes that Exim has been built with at least the "usual"
 # set of routers, transports, and lookups. Ensure that this is so.
 
 # This test suite assumes that Exim has been built with at least the "usual"
 # set of routers, transports, and lookups. Ensure that this is so.
 

-$missing = "";
+$missing = '';

 
 

-$missing .= "     Lookup: lsearch\n" if (!defined $parm_lookups{'lsearch'});
+$missing .= "     Lookup: lsearch\n" if (!defined $parm_lookups{lsearch});

 
 

-$missing .= "     Router: accept\n" if (!defined $parm_routers{'accept'});
-$missing .= "     Router: dnslookup\n" if (!defined $parm_routers{'dnslookup'});
-$missing .= "     Router: manualroute\n" if (!defined $parm_routers{'manualroute'});
-$missing .= "     Router: redirect\n" if (!defined $parm_routers{'redirect'});
+$missing .= "     Router: accept\n" if (!defined $parm_routers{accept});
+$missing .= "     Router: dnslookup\n" if (!defined $parm_routers{dnslookup});
+$missing .= "     Router: manualroute\n" if (!defined $parm_routers{manualroute});
+$missing .= "     Router: redirect\n" if (!defined $parm_routers{redirect});

 
 

-$missing .= "     Transport: appendfile\n" if (!defined $parm_transports{'appendfile'});
-$missing .= "     Transport: autoreply\n" if (!defined $parm_transports{'autoreply'});
-$missing .= "     Transport: pipe\n" if (!defined $parm_transports{'pipe'});
-$missing .= "     Transport: smtp\n" if (!defined $parm_transports{'smtp'});
+$missing .= "     Transport: appendfile\n" if (!defined $parm_transports{appendfile});
+$missing .= "     Transport: autoreply\n" if (!defined $parm_transports{autoreply});
+$missing .= "     Transport: pipe\n" if (!defined $parm_transports{pipe});
+$missing .= "     Transport: smtp\n" if (!defined $parm_transports{smtp});

 
 

-if ($missing ne "")
+if ($missing ne '')

   {
   print "\n";
   print "** Many features can be included or excluded from Exim binaries.\n";
   {
   print "\n";
   print "** Many features can be included or excluded from Exim binaries.\n";


@@ -2986,8 +3036,8 @@ if ($missing ne "")
 for $prog ("cf", "checkaccess", "client", "client-ssl", "client-gnutls",
            "fakens", "iefbr14", "server")
   {
 for $prog ("cf", "checkaccess", "client", "client-ssl", "client-gnutls",
            "fakens", "iefbr14", "server")
   {

-  next if ($prog eq "client-ssl" && !defined $parm_support{'OpenSSL'});
-  next if ($prog eq "client-gnutls" && !defined $parm_support{'GnuTLS'});
+  next if ($prog eq "client-ssl" && !defined $parm_support{OpenSSL});
+  next if ($prog eq "client-gnutls" && !defined $parm_support{GnuTLS});

   if (!-e "bin/$prog")
     {
     print "\n";
   if (!-e "bin/$prog")
     {
     print "\n";


@@ -3001,9 +3051,9 @@ for $prog ("cf", "checkaccess", "client", "client-ssl", "client-gnutls",
 # have that functionality compiled, we needn't bother.
 
 $dlfunc_deleted = 0;
 # have that functionality compiled, we needn't bother.
 
 $dlfunc_deleted = 0;

-if (defined $parm_support{'Expand_dlfunc'} && !-e "bin/loaded")
+if (defined $parm_support{Expand_dlfunc} && !-e 'bin/loaded')

   {
   {

-  delete $parm_support{'Expand_dlfunc'};
+  delete $parm_support{Expand_dlfunc};

   $dlfunc_deleted = 1;
   }
 
   $dlfunc_deleted = 1;
   }
 


@@ -3088,7 +3138,7 @@ elsif ($have_ipv4 == 0)
   }
 else
   {
   }
 else
   {

-  $parm_running{"IPv4"} = " ";
+  $parm_running{IPv4} = " ";

   }
 
 if (not $parm_ipv6)
   }
 
 if (not $parm_ipv6)


@@ -3096,15 +3146,15 @@ if (not $parm_ipv6)
   $have_ipv6 = 0;
   $parm_ipv6 = "<no IPv6 address found>";
   $server_opts .= " -noipv6";
   $have_ipv6 = 0;
   $parm_ipv6 = "<no IPv6 address found>";
   $server_opts .= " -noipv6";

-  delete($parm_support{"IPv6"});
+  delete($parm_support{IPv6});

   }
 elsif ($have_ipv6 == 0)
   {
   $parm_ipv6 = "<IPv6 testing disabled>";
   $server_opts .= " -noipv6";
   }
 elsif ($have_ipv6 == 0)
   {
   $parm_ipv6 = "<IPv6 testing disabled>";
   $server_opts .= " -noipv6";

-  delete($parm_support{"IPv6"});
+  delete($parm_support{IPv6});

   }
   }

-elsif (!defined $parm_support{'IPv6'})
+elsif (!defined $parm_support{IPv6})

   {
   $have_ipv6 = 0;
   $parm_ipv6 = "<no IPv6 support in Exim binary>";
   {
   $have_ipv6 = 0;
   $parm_ipv6 = "<no IPv6 support in Exim binary>";


@@ -3112,7 +3162,7 @@ elsif (!defined $parm_support{'IPv6'})
   }
 else
   {
   }
 else
   {

-  $parm_running{"IPv6"} = " ";
+  $parm_running{IPv6} = " ";

   }
 
 print "IPv4 address is $parm_ipv4\n";
   }
 
 print "IPv4 address is $parm_ipv4\n";


@@ -3120,7 +3170,7 @@ print "IPv6 address is $parm_ipv6\n";
 
 # For munging test output, we need the reversed IP addresses.
 
 
 # For munging test output, we need the reversed IP addresses.
 

-$parm_ipv4r = ($parm_ipv4 !~ /^\d/)? "" :
+$parm_ipv4r = ($parm_ipv4 !~ /^\d/)? '' :

   join(".", reverse(split /\./, $parm_ipv4));
 
 $parm_ipv6r = $parm_ipv6;             # Appropriate if not in use
   join(".", reverse(split /\./, $parm_ipv4));
 
 $parm_ipv6r = $parm_ipv6;             # Appropriate if not in use


@@ -3203,8 +3253,8 @@ die "** Unable to make patched exim: $!\n"
 # tests_exit(), so that suitable cleaning up can be done when required.
 # Arrange to catch interrupting signals, to assist with this.
 
 # tests_exit(), so that suitable cleaning up can be done when required.
 # Arrange to catch interrupting signals, to assist with this.
 

-$SIG{'INT'} = \&inthandler;
-$SIG{'PIPE'} = \&pipehandler;
+$SIG{INT} = \&inthandler;
+$SIG{PIPE} = \&pipehandler;

 
 # For some tests, we need another copy of the binary that is setuid exim rather
 # than root.
 
 # For some tests, we need another copy of the binary that is setuid exim rather
 # than root.


@@ -3225,10 +3275,10 @@ system("sudo cp eximdir/exim eximdir/exim_exim;" .
 ($parm_exim_dir) = $parm_exim =~ m?^(.*)/exim?;
 
 $dbm_build_deleted = 0;
 ($parm_exim_dir) = $parm_exim =~ m?^(.*)/exim?;
 
 $dbm_build_deleted = 0;

-if (defined $parm_lookups{'dbm'} &&
+if (defined $parm_lookups{dbm} &&

     system("cp $parm_exim_dir/exim_dbmbuild eximdir") != 0)
   {
     system("cp $parm_exim_dir/exim_dbmbuild eximdir") != 0)
   {

-  delete $parm_lookups{'dbm'};
+  delete $parm_lookups{dbm};

   $dbm_build_deleted = 1;
   }
 
   $dbm_build_deleted = 1;
   }
 


@@ -3336,6 +3386,8 @@ for ($i = 0; $i < @test_dirs; $i++)
 
 # Scan for relevant tests
 
 
 # Scan for relevant tests
 

+tests_exit(-1, "Failed to unlink $log_summary_filename")
+  if (-e $log_summary_filename && !unlink($log_summary_filename));

 for ($i = 0; $i < @test_dirs; $i++)
   {
   my($testdir) = $test_dirs[$i];
 for ($i = 0; $i < @test_dirs; $i++)
   {
   my($testdir) = $test_dirs[$i];


@@ -3405,7 +3457,6 @@ for ($i = 0; $i < @test_dirs; $i++)
     {
     chomp;
     print "Omitting tests in $testdir (missing $_)\n";
     {
     chomp;
     print "Omitting tests in $testdir (missing $_)\n";

-    next;

     }
 
   # We want the tests from this subdirectory, provided they are in the
     }
 
   # We want the tests from this subdirectory, provided they are in the


@@ -3418,9 +3469,15 @@ for ($i = 0; $i < @test_dirs; $i++)
 
   foreach $test (@testlist)
     {
 
   foreach $test (@testlist)
     {

-    next if $test !~ /^\d{4}(?:\.\d+)?$/;
-    next if $test < $test_start || $test > $test_end;
-    push @test_list, "$testdir/$test";
+    next if ($test !~ /^\d{4}(?:\.\d+)?$/);
+    if (!$wantthis || $test < $test_start || $test > $test_end)
+      {
+      log_test($log_summary_filename, $test, '.');
+      }
+    else
+      {
+      push @test_list, "$testdir/$test";
+      }

     }
   }
 
     }
   }
 


@@ -3488,8 +3545,8 @@ foreach $basedir ("aux-var", "dnszones")
 
 # Set a user's shell, distinguishable from /bin/sh
 
 
 # Set a user's shell, distinguishable from /bin/sh
 

-symlink("/bin/sh","aux-var/sh");
-$ENV{'SHELL'} = $parm_shell = $parm_cwd . "/aux-var/sh";
+symlink('/bin/sh' => 'aux-var/sh');
+$ENV{SHELL} = $parm_shell = "$parm_cwd/aux-var/sh";

 
 ##################################################
 #     Create fake DNS zones for this host        #
 
 ##################################################
 #     Create fake DNS zones for this host        #


@@ -3542,7 +3599,7 @@ if ($have_ipv6 && $parm_ipv6 ne "::1")
   }
   my(@components) = split /:/, $exp_v6;
   my(@nibbles) = reverse (split /\s*/, shift @components);
   }
   my(@components) = split /:/, $exp_v6;
   my(@nibbles) = reverse (split /\s*/, shift @components);

-  my($sep) =  "";
+  my($sep) =  '';

 
   $" = ".";
   open(OUT, ">$parm_cwd/dnszones/db.ip6.@nibbles") ||
 
   $" = ".";
   open(OUT, ">$parm_cwd/dnszones/db.ip6.@nibbles") ||


@@ -3602,7 +3659,7 @@ print "\nPress RETURN to run the tests: ";
 $_ = $force_continue ? "c" : <T>;
 print "\n";
 
 $_ = $force_continue ? "c" : <T>;
 print "\n";
 

-$lasttestdir = "";
+$lasttestdir = '';

 
 foreach $test (@test_list)
   {
 
 foreach $test (@test_list)
   {


@@ -3623,7 +3680,7 @@ foreach $test (@test_list)
     $gnutls = 0;
     if (-s "scripts/$thistestdir/REQUIRES")
       {
     $gnutls = 0;
     if (-s "scripts/$thistestdir/REQUIRES")
       {

-      my($indent) = "";
+      my($indent) = '';

       print "\n>>> The following tests require: ";
       open(IN, "scripts/$thistestdir/REQUIRES") ||
         tests_exit(-1, "Failed to open scripts/$thistestdir/REQUIRES: $1");
       print "\n>>> The following tests require: ";
       open(IN, "scripts/$thistestdir/REQUIRES") ||
         tests_exit(-1, "Failed to open scripts/$thistestdir/REQUIRES: $1");


@@ -3667,7 +3724,7 @@ foreach $test (@test_list)
   $stdout_skip = 0;
   $rmfiltertest = 0;
   $is_ipv6test = 0;
   $stdout_skip = 0;
   $rmfiltertest = 0;
   $is_ipv6test = 0;

-  $TEST_STATE->{munge} = "";
+  $TEST_STATE->{munge} = '';

 
   # Remove the associative arrays used to hold checked mail files and msglogs
 
 
   # Remove the associative arrays used to hold checked mail files and msglogs
 


@@ -3754,7 +3811,7 @@ foreach $test (@test_list)
 
       if (/^need_move_frozen_messages/)
         {
 
       if (/^need_move_frozen_messages/)
         {

-        next if defined $parm_support{"move_frozen_messages"};
+        next if defined $parm_support{move_frozen_messages};

         print ">>> move frozen message support is needed for test $testno, " .
           "but is not\n>>> available: skipping\n";
         $docheck = 0;      # don't check output
         print ">>> move frozen message support is needed for test $testno, " .
           "but is not\n>>> available: skipping\n";
         $docheck = 0;      # don't check output


@@ -3762,7 +3819,7 @@ foreach $test (@test_list)
         last;
         }
 
         last;
         }
 

-      last unless /^(#|\s*$)/;
+      last unless /^(?:#(?!##\s)|\s*$)/;

       }
     last if !defined $_;  # Hit EOF
 
       }
     last if !defined $_;  # Hit EOF
 


@@ -3773,12 +3830,12 @@ foreach $test (@test_list)
     # command was run and waited for, and 3 if a command
     # was run and not waited for (usually a daemon or server startup).
 
     # command was run and waited for, and 3 if a command
     # was run and not waited for (usually a daemon or server startup).
 

-    my($commandname) = "";
+    my($commandname) = '';

     my($expectrc) = 0;
     my($rc, $run_extra) = run_command($testno, \$subtestno, \$expectrc, \$commandname, $TEST_STATE);
     my($cmdrc) = $?;
 
     my($expectrc) = 0;
     my($rc, $run_extra) = run_command($testno, \$subtestno, \$expectrc, \$commandname, $TEST_STATE);
     my($cmdrc) = $?;
 

-$0 = "[runtest $testno]";
+    $0 = "[runtest $testno]";

 
     if ($debug) {
       print ">> rc=$rc cmdrc=$cmdrc\n";
 
     if ($debug) {
       print ">> rc=$rc cmdrc=$cmdrc\n";


@@ -3832,7 +3889,10 @@ $0 = "[runtest $testno]";
         print "\nshow stdErr, show stdOut, Retry, Continue (without file comparison), or Quit? [Q] ";
         $_ = $force_continue ? "c" : <T>;
         tests_exit(1) if /^q?$/i;
         print "\nshow stdErr, show stdOut, Retry, Continue (without file comparison), or Quit? [Q] ";
         $_ = $force_continue ? "c" : <T>;
         tests_exit(1) if /^q?$/i;

-        log_failure($log_failed_filename, $testno, "exit code unexpected") if (/^c$/i && $force_continue);
+       if (/^c$/ && $force_continue) {
+         log_failure($log_failed_filename, $testno, "exit code unexpected");
+         log_test($log_summary_filename, $testno, 'F')
+       }

         if ($force_continue)
           {
           print "\nstderr tail:\n";
         if ($force_continue)
           {
           print "\nstderr tail:\n";


@@ -3879,7 +3939,10 @@ $0 = "[runtest $testno]";
           print "\nShow server stdout, Retry, Continue, or Quit? [Q] ";
           $_ = $force_continue ? "c" : <T>;
           tests_exit(1) if /^q?$/i;
           print "\nShow server stdout, Retry, Continue, or Quit? [Q] ";
           $_ = $force_continue ? "c" : <T>;
           tests_exit(1) if /^q?$/i;

-          log_failure($log_failed_filename, $testno, "exit code unexpected") if (/^c$/i && $force_continue);
+         if (/^c$/ && $force_continue) {
+           log_failure($log_failed_filename, $testno, "exit code unexpected");
+           log_test($log_summary_filename, $testno, 'F')
+         }

           print "... continue forced\n" if $force_continue;
           last if /^[rc]$/i;
 
           print "... continue forced\n" if $force_continue;
           last if /^[rc]$/i;
 


@@ -3899,9 +3962,9 @@ $0 = "[runtest $testno]";
   close SCRIPT;
 
   # The script has finished. Check the all the output that was generated. The
   close SCRIPT;
 
   # The script has finished. Check the all the output that was generated. The

-  # function returns 0 if all is well, 1 if we should rerun the test (the files
-  # function returns 0 if all is well, 1 if we should rerun the test (the files
-  # have been updated). It does not return if the user responds Q to a prompt.
+  # function returns 0 for a perfect pass, 1 if imperfect but ok, 2 if we should
+  # rerun the test (the files # have been updated).
+  # It does not return if the user responds Q to a prompt.

 
   if ($retry)
     {
 
   if ($retry)
     {


@@ -3912,14 +3975,16 @@ $0 = "[runtest $testno]";
 
   if ($docheck)
     {
 
   if ($docheck)
     {

-    if (check_output($TEST_STATE->{munge}) != 0)
+    my $rc = check_output($TEST_STATE->{munge});
+    log_test($log_summary_filename, $testno, 'P') if ($rc == 0);
+    if ($rc < 2)

       {
       {

-      print (("#" x 79) . "\n");
-      redo;
+      print ("  Script completed\n");

       }
     else
       {
       }
     else
       {

-      print ("  Script completed\n");
+      print (("#" x 79) . "\n");
+      redo;

       }
     }
   }
       }
     }
   }