Memory management: when running under the testsuite, check every string variable...

[exim.git] / test / runtest

diff --git a/test/runtest b/test/runtest
index 8b735c1ffbb9d54ff64c1e8ac4b06365d7d08c13..b2f5d077573e6c0f9c60ad82e95cdfbc48bd7b10 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);


@@ -356,6 +358,7 @@ open(IN, "$file") || tests_exit(-1, "Failed to open $file: $!");
 my($is_log) = $file =~ /log/;
 my($is_stdout) = $file =~ /stdout/;
 my($is_stderr) = $file =~ /stderr/;
 my($is_log) = $file =~ /log/;
 my($is_stdout) = $file =~ /stdout/;
 my($is_stderr) = $file =~ /stderr/;

+my($is_mail) = $file =~ /mail/;

 
 # Date pattern
 
 
 # Date pattern
 


@@ -418,12 +421,6 @@ RESET_AFTER_EXTRA_LINE_READ:
   s?prvs=([^/]+)/[\da-f]{10}@?prvs=$1/xxxxxxxxxx@?g;    # Old form
   s?prvs=[\da-f]{10}=([^@]+)@?prvs=xxxxxxxxxx=$1@?g;    # New form
 
   s?prvs=([^/]+)/[\da-f]{10}@?prvs=$1/xxxxxxxxxx@?g;    # Old form
   s?prvs=[\da-f]{10}=([^@]+)@?prvs=xxxxxxxxxx=$1@?g;    # New form
 

-  # Error lines on stdout from SSL contain process id values and file names.
-  # They also contain a source file name and line number, which may vary from
-  # release to release.
-  s/^\d+:error:/pppp:error:/;
-  s/:(?:\/[^\s:]+\/)?([^\/\s]+\.c):\d+:/:$1:dddd:/;
-

   # There are differences in error messages between OpenSSL versions
   s/SSL_CTX_set_cipher_list/SSL_connect/;
 
   # There are differences in error messages between OpenSSL versions
   s/SSL_CTX_set_cipher_list/SSL_connect/;
 


@@ -458,7 +455,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 +547,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


@@ -883,15 +884,25 @@ RESET_AFTER_EXTRA_LINE_READ:
         }
       }
 
         }
       }
 

+    # remote IPv6 addrs vary
+    s/^(Connection request from) \[.*:.*:.*\]$/$1 \[ipv6\]/;
+

     # openssl version variances
     # openssl version variances

-    next if /^SSL info: unknown state/;
-    next if /^SSL info: SSLv2\/v3 write client hello A/;
-    next if /^SSL info: SSLv3 read server key exchange A/;
+  # Error lines on stdout from SSL contain process id values and file names.
+  # They also contain a source file name and line number, which may vary from
+  # release to release.
+
+    next if /^SSL info:/;

     next if /SSL verify error: depth=0 error=certificate not trusted/;
     next if /SSL verify error: depth=0 error=certificate not trusted/;

-    s/SSL3_READ_BYTES/ssl3_read_bytes/;
+    s/SSL3_READ_BYTES/ssl3_read_bytes/i;
+    s/^\d+:error:\d+(:SSL routines:ssl3_read_bytes:[^:]+:).*(:SSL alert number \d\d)$/pppp:error:dddddddd$1\[...\]$2/;

 
     # gnutls version variances
     next if /^Error in the pull function./;
 
     # gnutls version variances
     next if /^Error in the pull function./;

+
+    # optional IDN2 variant conversions.  Accept either IDN1 or IDN2
+    s/conversion  strasse.de/conversion  xn--strae-oqa.de/;
+    s/conversion: german.xn--strae-oqa.de/conversion: german.straße.de/;

     }
 
   # ======== stderr ========
     }
 
   # ======== stderr ========


@@ -957,7 +968,7 @@ RESET_AFTER_EXTRA_LINE_READ:
     }
     next if /^tls_validate_require_cipher child \d+ ended: status=0x0/;
 
     }
     next if /^tls_validate_require_cipher child \d+ ended: status=0x0/;
 

-    # We invoke Exim with -D, so we hit this new messag as of Exim 4.73:
+    # We invoke Exim with -D, so we hit this new message as of Exim 4.73:

     next if /^macros_trusted overridden to true by whitelisting/;
 
     # We have to omit the localhost ::1 address so that all is well in
     next if /^macros_trusted overridden to true by whitelisting/;
 
     # We have to omit the localhost ::1 address so that all is well in


@@ -1070,11 +1081,17 @@ RESET_AFTER_EXTRA_LINE_READ:
     # Not all platforms build with DKIM enabled
     next if /^PDKIM >> Body data for hash, canonicalized/;
 
     # Not all platforms build with DKIM enabled
     next if /^PDKIM >> Body data for hash, canonicalized/;
 

+    #  Parts of DKIM-specific debug output depend on the time/date
+    next if /^date:\w+,\{SP\}/;
+    next if /^PDKIM \[[^[]+\] (Header hash|b) computed:/;
+

     # Not all platforms support TCP Fast Open, and the compile omits the check
     if (s/\S+ in hosts_try_fastopen\? no \(option unset\)\n$//)
       {
       $_ .= <IN>;
       s/ \.\.\. >>> / ... /;
     # Not all platforms support TCP Fast Open, and the compile omits the check
     if (s/\S+ in hosts_try_fastopen\? no \(option unset\)\n$//)
       {
       $_ .= <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$/;


@@ -1153,11 +1170,22 @@ return $yield;
 #            [2] if there is a C in the prompt and $force_continue is true
 # Returns:   returns the answer
 
 #            [2] if there is a C in the prompt and $force_continue is true
 # Returns:   returns the answer
 

-sub interact{
-print $_[0];
-if ($_[1]) { $_ = "u"; print "... update forced\n"; }
-  elsif ($_[2]) { $_ = "c"; print "... continue forced\n"; }
-  else { $_ = <T>; }
+sub interact {
+  my ($prompt, $have_u, $have_c) = @_;
+
+  print $prompt;
+
+  if ($have_u) {
+    print "... update forced\n";
+    return 'u';
+  }
+
+  if ($have_c) {
+    print "... continue forced\n";
+    return 'c';
+  }
+
+  return lc <T>;

 }
 
 
 }
 
 


@@ -1177,13 +1205,22 @@ if ($_[1]) { $_ = "u"; print "... update forced\n"; }
 
 
 sub log_failure {
 
 
 sub log_failure {

-  my $logfile = shift();
-  my $testno  = shift();
-  my $detail  = shift() || '';
-  if ( open(my $fh, ">>", $logfile) ) {
-    print $fh "Test $testno $detail failed\n";
-    close $fh;
-  }
+  my ($logfile, $testno, $detail) = @_;
+
+  open(my $fh, '>>', $logfile) or return;
+
+  print $fh "Test $testno "
+        . (defined $detail ? "$detail " : '')
+        . "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";

 }
 
 
 }
 
 


@@ -1203,8 +1240,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.
 


@@ -1230,11 +1268,13 @@ if (! -e $sf_current)
 
   for (;;)
     {
 
   for (;;)
     {

-    print "Continue, Show, or Quit? [Q] ";
-    $_ = $force_continue ? "c" : <T>;
-    tests_exit(1) if /^q?$/i;
-    log_failure($log_failed_filename, $testno, $rf) if (/^c$/i && $force_continue);
-    return 0 if /^c$/i;
+    $_ = interact('Continue, Show, or Quit? [Q] ', undef, $force_continue);
+    tests_exit(1) if /^q?$/;
+    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$/);
     }
 


@@ -1252,10 +1292,13 @@ if (! -e $sf_current)
   print "\n";
   for (;;)
     {
   print "\n";
   for (;;)
     {

-    interact("Continue, Update & retry, Quit? [Q] ", $force_update, $force_continue);
-    tests_exit(1) if /^q?$/i;
-    log_failure($log_failed_filename, $testno, $rsf) if (/^c$/i && $force_continue);
-    return 0 if /^c$/i;
+    $_ = interact('Continue, Update & retry, Quit? [Q] ', $force_update, $force_continue);
+    tests_exit(1) if /^q?$/;
+    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);
     }
   }


@@ -1266,8 +1309,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";


@@ -1297,7 +1342,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: $!");


@@ -1322,7 +1367,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);


@@ -1334,7 +1379,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);
 


@@ -1372,13 +1417,16 @@ if (-e $sf_current)
   print "\n";
   for (;;)
     {
   print "\n";
   for (;;)
     {

-    interact("Continue, Retry, Update current"
-       . ($sf_current ne $sf_flavour  ? "/Save for flavour '$flavour'" : "")
-       . " & retry, Quit? [Q] ", $force_update, $force_continue);
-    tests_exit(1) if /^q?$/i;
-    log_failure($log_failed_filename, $testno, $sf_current) if (/^c$/i && $force_continue);
-    return 0 if /^c$/i;
-    return 1 if /^r$/i;
+    $_ = interact('Continue, Retry, Update current'
+       . ($sf_current ne $sf_flavour  ? "/Save for flavour '$flavour'" : '')
+       . ' & retry, Quit? [Q] ', $force_update, $force_continue);
+    tests_exit(1) if /^q?$/;
+    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);
     }
   }


@@ -1387,23 +1435,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;

 }
 
 
 }
 
 


@@ -1467,7 +1515,7 @@ $munges =
                   )($|[ ]=)/x' },
 
     'sys_bindir' =>
                   )($|[ ]=)/x' },
 
     'sys_bindir' =>

-    { 'mainlog' => 's%/(usr/)?bin/%SYSBINDIR/%' },
+    { 'mainlog' => 's%/(usr/(local/)?)?bin/%SYSBINDIR/%' },

 
     'sync_check_data' =>
     { 'mainlog'   => 's/^(.* SMTP protocol synchronization error .* next input=.{8}).*$/$1<suppressed>/',
 
     'sync_check_data' =>
     { 'mainlog'   => 's/^(.* SMTP protocol synchronization error .* next input=.{8}).*$/$1<suppressed>/',


@@ -1483,6 +1531,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    #
 ##################################################


@@ -1499,47 +1553,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.


@@ -1577,9 +1632,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"};
     }
 


@@ -1592,16 +1647,19 @@ if (! $message_skip)
 
     for (;;)
       {
 
     for (;;)
       {

-      interact("Continue, Update & retry, or Quit? [Q] ", $force_update, $force_continue);
-      tests_exit(1) if /^q?$/i;
-      log_failure($log_failed_filename, $testno, "missing email") if (/^c$/i && $force_continue);
-      last if /^c$/i;
+      $_ = interact('Continue, Update & retry, or Quit? [Q] ', $force_update, $force_continue);
+      tests_exit(1) if /^q?$/;
+      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
       # remove it from the @oldmails vector, as otherwise it will still be
       # checked for when we re-run the test.
 
 
       # For update, we not only have to unlink the file, but we must also
       # remove it from the @oldmails vector, as otherwise it will still be
       # checked for when we re-run the test.
 

-      if (/^u$/i)
+      if (/^u$/)

         {
         foreach $key (keys %expected_mails)
           {
         {
         foreach $key (keys %expected_mails)
           {


@@ -1649,9 +1707,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"};
       }
     }


@@ -1676,11 +1734,14 @@ if (! $msglog_skip)
 
     for (;;)
       {
 
     for (;;)
       {

-      interact("Continue, Update, or Quit? [Q] ", $force_update, $force_continue);
-      tests_exit(1) if /^q?$/i;
-      log_failure($log_failed_filename, $testno, "missing msglog") if (/^c$/i && $force_continue);
-      last if /^c$/i;
-      if (/^u$/i)
+      $_ = interact('Continue, Update, or Quit? [Q] ', $force_update, $force_continue);
+      tests_exit(1) if /^q?$/;
+      if (/^c$/ && $force_continue) {
+       log_failure($log_failed_filename, $testno, "missing msglog");
+       log_test($log_summary_filename, $testno, 'F')
+      }
+      last if /^c$/;
+      if (/^u$/)

         {
         foreach $key (keys %expected_msglogs)
           {
         {
         foreach $key (keys %expected_msglogs)
           {


@@ -1728,7 +1789,7 @@ system("$cmd");
 # The <SCRIPT> file is open for us to read an optional return code line,
 # followed by the command line and any following data lines for stdin. The
 # command line can be continued by the use of \. Data lines are not continued
 # The <SCRIPT> file is open for us to read an optional return code line,
 # followed by the command line and any following data lines for stdin. The
 # command line can be continued by the use of \. Data lines are not continued

-# in this way. In all lines, the following substutions are made:
+# in this way. In all lines, the following substitutions are made:

 #
 # DIR    => the current directory
 # CALLER => the caller of this script
 #
 # DIR    => the current directory
 # CALLER => the caller of this script


@@ -1737,14 +1798,14 @@ system("$cmd");
 #            reference to the subtest number, holding previous value
 #            reference to the expected return code value
 #            reference to where to put the command name (for messages)
 #            reference to the subtest number, holding previous value
 #            reference to the expected return code value
 #            reference to where to put the command name (for messages)

-#            auxilliary information returned from a previous run
+#            auxiliary information returned from a previous run

 #
 #

-# Returns:   0 the commmand was executed inline, no subprocess was run
+# Returns:   0 the command was executed inline, no subprocess was run

 #            1 a non-exim command was run and waited for
 #            2 an exim command was run and waited for
 #            3 a command was run and not waited for (daemon, server, exim_lock)
 #            4 EOF was encountered after an initial return code line
 #            1 a non-exim command was run and waited for
 #            2 an exim command was run and waited for
 #            3 a command was run and not waited for (daemon, server, exim_lock)
 #            4 EOF was encountered after an initial return code line

-# Optionally alse a second parameter, a hash-ref, with auxilliary information:
+# Optionally also a second parameter, a hash-ref, with auxiliary information:

 #            exim_pid: pid of a run process
 #            munge: name of a post-script results munger
 
 #            exim_pid: pid of a run process
 #            munge: name of a post-script results munger
 


@@ -1867,8 +1928,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";


@@ -2105,7 +2174,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)


@@ -2164,9 +2233,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


@@ -2197,14 +2266,20 @@ elsif (/^((?i:[A-Z\d_]+=\S+\s+)+)?(\d+)?\s*(sudo(?:\s+-u\s+(\w+))?\s+)?exim(_\S+
 
   if ($args =~ /\$msg/)
     {
 
   if ($args =~ /\$msg/)
     {

-    my($listcmd) = "$parm_cwd/eximdir/exim -bp " .
-                   "-DEXIM_PATH=$parm_cwd/eximdir/exim " .
-                   "-C $parm_cwd/test-config |";
-    print ">> Getting queue list from:\n>>    $listcmd\n" if ($debug);
-    open (QLIST, $listcmd) || tests_exit(-1, "Couldn't run \"exim -bp\": $!\n");
-    my(@msglist) = ();
-    while (<QLIST>) { push (@msglist, $1) if /^\s*\d+[smhdw]\s+\S+\s+(\S+)/; }
-    close(QLIST);
+    my @listcmd  = ("$parm_cwd/eximdir/exim", '-bp',
+                   "-DEXIM_PATH=$parm_cwd/eximdir/exim",
+                   -C => "$parm_cwd/test-config");
+    print ">> Getting queue list from:\n>>    @listcmd\n" if $debug;
+    # We need the message ids sorted in ascending order.
+    # Message id is: <timestamp>-<pid>-<fractional-time>. On some systems (*BSD) the
+    # PIDs are randomized, so sorting just the whole PID doesn't work.
+    # We do the Schartz' transformation here (sort on
+    # <timestamp><fractional-time>). Thanks to Kirill Miazine
+    my @msglist =
+      map { $_->[1] }                                   # extract the values
+      sort { $a->[0] cmp $b->[0] }                      # sort by key
+      map { [join('.' => (split /-/, $_)[0,2]) => $_] } # key (timestamp.fractional-time) => value(message_id)
+      map { /^\s*\d+[smhdw]\s+\S+\s+(\S+)/ } `@listcmd` or tests_exit(-1, "No output from `exim -bp` (@listcmd)\n");

 
     # Done backwards just in case there are more than 9
 
 
     # Done backwards just in case there are more than 9
 


@@ -2221,7 +2296,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 " .


@@ -2349,7 +2424,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");
 


@@ -2446,7 +2521,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 '';

 
 
 
 
 
 


@@ -2461,7 +2536,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; }


@@ -2514,7 +2589,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++)


@@ -2532,7 +2607,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 '';

   }
 
 
   }
 
 


@@ -2552,10 +2627,13 @@ close(IN);
 close(OUT);
 
 print("Probing with config file: $parm_cwd/test-config\n");
 close(OUT);
 
 print("Probing with config file: $parm_cwd/test-config\n");

-open(EXIMINFO, "$parm_exim -d -C $parm_cwd/test-config -DDIR=$parm_cwd " .
-               "-bP exim_user exim_group 2>&1|") ||
-  die "** Cannot run $parm_exim: $!\n";
-while(<EXIMINFO>)
+
+my $eximinfo = "$parm_exim -d -C $parm_cwd/test-config -DDIR=$parm_cwd -bP exim_user exim_group";
+chomp(my @eximinfo = `$eximinfo 2>&1`);
+die "$0: Can't run $eximinfo\n" if $? == -1;
+
+warn 'Got ' . $?>>8 . " from $eximinfo\n" if $?;
+foreach (@eximinfo)

   {
   if (my ($version) = /^Exim version (\S+)/) {
     my $git = `git describe --dirty=-XX --match 'exim-4*'`;
   {
   if (my ($version) = /^Exim version (\S+)/) {
     my $git = `git describe --dirty=-XX --match 'exim-4*'`;


@@ -2579,23 +2657,23 @@ ___
   $parm_trusted_config_list = $1 if /^TRUSTED_CONFIG_LIST:.*?"(.*?)"$/;
   ($parm_configure_owner, $parm_configure_group) = ($1, $2)
        if /^Configure owner:\s*(\d+):(\d+)/;
   $parm_trusted_config_list = $1 if /^TRUSTED_CONFIG_LIST:.*?"(.*?)"$/;
   ($parm_configure_owner, $parm_configure_group) = ($1, $2)
        if /^Configure owner:\s*(\d+):(\d+)/;

-  print "$_" if /wrong owner/;
+  print if /wrong owner/;

   }
   }

-close(EXIMINFO);

 
 

-if (defined $parm_eximuser)
-  {
-  if ($parm_eximuser =~ /^\d+$/) { $parm_exim_uid = $parm_eximuser; }
-    else { $parm_exim_uid = getpwnam($parm_eximuser); }
-  }
-else
-  {
-  print "Unable to extract exim_user from binary.\n";
-  print "Check if Exim refused to run; if so, consider:\n";
-  print "  TRUSTED_CONFIG_LIST ALT_CONFIG_PREFIX WHITELIST_D_MACROS\n";
-  print "If debug permission denied, are you in the exim group?\n";
-  die "Failing to get information from binary.\n";
-  }
+if (not defined $parm_eximuser) {
+  die <<XXX, map { "|$_\n" } @eximinfo;
+Unable to extract exim_user from binary.
+Check if Exim refused to run; if so, consider:
+  TRUSTED_CONFIG_LIST ALT_CONFIG_PREFIX WHITELIST_D_MACROS
+If debug permission denied, are you in the exim group?
+Failing to get information from binary.
+Output from $eximinfo:
+XXX
+
+}
+
+if ($parm_eximuser =~ /^\d+$/) { $parm_exim_uid = $parm_eximuser; }
+else { $parm_exim_uid = getpwnam($parm_eximuser); }

 
 if (defined $parm_eximgroup)
   {
 
 if (defined $parm_eximgroup)
   {


@@ -2706,7 +2784,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]"} = " "; }
         }


@@ -2725,7 +2803,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;
 


@@ -2736,7 +2814,7 @@ if (defined $parm_support{'Content_Scanning'})
     # This test for an active SpamAssassin is courtesy of John Jetmore.
     # The tests are hard coded to localhost:783, so no point in making
     # this test flexible like the clamav test until the test scripts are
     # This test for an active SpamAssassin is courtesy of John Jetmore.
     # The tests are hard coded to localhost:783, so no point in making
     # this test flexible like the clamav test until the test scripts are

-    # changed.  spamd doesn't have the nice PING/PONG protoccol that
+    # changed.  spamd doesn't have the nice PING/PONG protocol that

     # clamd does, but it does respond to errors in an informative manner,
     # so use that.
 
     # clamd does, but it does respond to errors in an informative manner,
     # so use that.
 


@@ -2776,7 +2854,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";
       }
     }


@@ -2795,11 +2873,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)
         {


@@ -2810,7 +2888,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";


@@ -2897,7 +2975,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";
           }
         }


@@ -2920,12 +2998,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
     {


@@ -2940,21 +3018,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";


@@ -2976,8 +3054,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";


@@ -2991,9 +3069,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;
   }
 


@@ -3078,7 +3156,7 @@ elsif ($have_ipv4 == 0)
   }
 else
   {
   }
 else
   {

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

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


@@ -3086,15 +3164,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>";


@@ -3102,7 +3180,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";


@@ -3110,7 +3188,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


@@ -3193,8 +3271,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.


@@ -3215,10 +3293,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;
   }
 


@@ -3326,6 +3404,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];


@@ -3395,7 +3475,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


@@ -3408,9 +3487,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";
+      }

     }
   }
 
     }
   }
 


@@ -3478,8 +3563,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        #


@@ -3532,7 +3617,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") ||


@@ -3592,7 +3677,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)
   {


@@ -3613,7 +3698,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");


@@ -3657,7 +3742,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
 


@@ -3744,7 +3829,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


@@ -3752,7 +3837,7 @@ foreach $test (@test_list)
         last;
         }
 
         last;
         }
 

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

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


@@ -3763,12 +3848,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";


@@ -3822,7 +3907,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";


@@ -3858,7 +3946,8 @@ $0 = "[runtest $testno]";
       if ($? != 0)
         {
         if (($? & 0xff) == 0)
       if ($? != 0)
         {
         if (($? & 0xff) == 0)

-          { printf("Server return code %d", $?/256); }
+          { printf("Server return code %d for test %d starting line %d", $?/256,
+               $testno, $subtest_startline); }

         elsif (($? & 0xff00) == 0)
           { printf("Server killed by signal %d", $? & 255); }
         else
         elsif (($? & 0xff00) == 0)
           { printf("Server killed by signal %d", $? & 255); }
         else


@@ -3869,7 +3958,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;
 


@@ -3889,9 +3981,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)
     {


@@ -3902,14 +3994,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;

       }
     }
   }
       }
     }
   }