X-Git-Url: https://git.exim.org/users/jgh/exim.git/blobdiff_plain/4cc77633080ef8d2a1f722782eb985530ccfdf1c..109ad60f4d0f4cf43d9dec72fc6eeb3c20d0f062:/test/runtest diff --git a/test/runtest b/test/runtest index 865e50752..d9500cb5f 100755 --- a/test/runtest +++ b/test/runtest @@ -26,9 +26,9 @@ use Socket; 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' => '####'); @@ -36,7 +36,7 @@ use if $ENV{DEBUG} && $ENV{DEBUG} =~ /\bruntest\b/ => ('Smart::Comments' => '### # Start by initializing some global variables -$testversion = "4.80 (08-May-12)"; +chomp(my $testversion = `git describe --always --dirty 2>&1` || ''); # 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,33 +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 -$gnutls_dh_bits_normal = 2236; +my $gnutls_dh_bits_normal = 2236; -$cf = "bin/cf -exact"; -$cr = "\r"; -$debug = 0; -$flavour = do { +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'; }; -$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 $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 @@ -83,17 +84,17 @@ $test_special_top = 9999; # 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 -$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 @@ -103,10 +104,8 @@ my $parm_mailgroup = Exim::Runtest::mailgroup('mail'); # 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); @@ -461,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); - $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 @@ -1082,6 +1081,8 @@ RESET_AFTER_EXTRA_LINE_READ: { $_ .= ; 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$/; @@ -1204,6 +1205,15 @@ sub log_failure { . "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"; +} + ################################################## @@ -1221,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 # -# 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. @@ -1250,8 +1261,11 @@ if (! -e $sf_current) { $_ = 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$/); } @@ -1271,8 +1285,11 @@ if (! -e $sf_current) { $_ = 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); } } @@ -1395,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?$/; - 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); } } @@ -1406,23 +1426,23 @@ if (-e $sf_current) 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 { - # 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; } @@ -1502,6 +1522,12 @@ $munges = }; +sub max { + my ($a, $b) = @_; + return $a if ($a > $b); + return $b; +} + ################################################## # Subroutine to check the output of a test # ################################################## @@ -1518,47 +1544,48 @@ $munges = # # 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; -$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, - $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, - $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, - $munge->{'mainlog'}); + $munge->{mainlog})); 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, - $munge->{'stdout'}); + $munge->{stdout})); } 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, - $munge->{'stderr'}); + $munge->{stderr})); } # Compare any delivered messages, unless this test is skipped. @@ -1596,9 +1623,9 @@ if (! $message_skip) } 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, - $munge->{'mail'}); + $munge->{mail})); delete $expected_mails{"mail/$testno.$saved_mail"}; } @@ -1613,7 +1640,10 @@ if (! $message_skip) { $_ = 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 @@ -1668,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; - $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, - $munge->{'msglog'}); + $munge->{msglog})); delete $expected_msglogs{"$testno.$munged_msglog"}; } } @@ -1697,7 +1727,10 @@ if (! $msglog_skip) { $_ = 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$/) { @@ -2132,7 +2165,7 @@ if (/^(cat)?write\s+(\S+)(?:\s+(.*))?\s*$/) 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) @@ -2191,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; - 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 @@ -2248,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/; - 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 " . @@ -2376,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. -$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"); @@ -2473,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); -print "Exim binary is $parm_exim\n" if $parm_exim ne ""; +print "Exim binary is $parm_exim\n" if $parm_exim ne ''; @@ -2488,7 +2521,7 @@ print "Exim binary is $parm_exim\n" if $parm_exim ne ""; 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; } @@ -2541,7 +2574,7 @@ $parm_cwd = Cwd::getcwd(); # 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++) @@ -2559,7 +2592,7 @@ if ($parm_exim eq "") print "** $trybin does not exist\n"; } } - die "** Too many tries\n" if $parm_exim eq ""; + die "** Too many tries\n" if $parm_exim eq ''; } @@ -2579,10 +2612,10 @@ close(IN); 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() +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: got $? from $eximinfo\n" if $?; +foreach (@eximinfo) { if (my ($version) = /^Exim version (\S+)/) { my $git = `git describe --dirty=-XX --match 'exim-4*'`; @@ -2608,21 +2641,21 @@ ___ if /^Configure owner:\s*(\d+):(\d+)/; 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 <) 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]"} = " "; } } @@ -2752,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. -if (defined $parm_support{'Content_Scanning'}) +if (defined $parm_support{Content_Scanning}) { my $sock = new FileHandle; @@ -2803,7 +2836,7 @@ if (defined $parm_support{'Content_Scanning'}) } else { - $parm_running{'SpamAssassin'} = ' '; + $parm_running{SpamAssassin} = ' '; print " SpamAssassin (spamd) seems to be running\n"; } } @@ -2822,11 +2855,11 @@ if (defined $parm_support{'Content_Scanning'}) 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", - "$test_prefix/etc/clamav/clamd.conf", "") + "$test_prefix/etc/clamav/clamd.conf", '') { if (-e $f) { @@ -2837,7 +2870,7 @@ if (defined $parm_support{'Content_Scanning'}) # 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"; @@ -2924,7 +2957,7 @@ if (defined $parm_support{'Content_Scanning'}) } else { - $parm_running{'ClamAV'} = ' '; + $parm_running{ClamAV} = ' '; print " ClamAV seems to be running\n"; } } @@ -2947,12 +2980,12 @@ if (defined $parm_support{'Content_Scanning'}) ################################################## # 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"; - $parm_running{'redis'} = ' '; + $parm_running{redis} = ' '; } else { @@ -2967,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. -$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"; @@ -3003,8 +3036,8 @@ if ($missing ne "") 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"; @@ -3018,9 +3051,9 @@ for $prog ("cf", "checkaccess", "client", "client-ssl", "client-gnutls", # 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; } @@ -3105,7 +3138,7 @@ elsif ($have_ipv4 == 0) } else { - $parm_running{"IPv4"} = " "; + $parm_running{IPv4} = " "; } if (not $parm_ipv6) @@ -3113,15 +3146,15 @@ if (not $parm_ipv6) $have_ipv6 = 0; $parm_ipv6 = ""; $server_opts .= " -noipv6"; - delete($parm_support{"IPv6"}); + delete($parm_support{IPv6}); } elsif ($have_ipv6 == 0) { $parm_ipv6 = ""; $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 = ""; @@ -3129,7 +3162,7 @@ elsif (!defined $parm_support{'IPv6'}) } else { - $parm_running{"IPv6"} = " "; + $parm_running{IPv6} = " "; } print "IPv4 address is $parm_ipv4\n"; @@ -3137,7 +3170,7 @@ print "IPv6 address is $parm_ipv6\n"; # 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 @@ -3220,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. -$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. @@ -3242,10 +3275,10 @@ system("sudo cp eximdir/exim eximdir/exim_exim;" . ($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) { - delete $parm_lookups{'dbm'}; + delete $parm_lookups{dbm}; $dbm_build_deleted = 1; } @@ -3353,6 +3386,8 @@ for ($i = 0; $i < @test_dirs; $i++) # 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]; @@ -3422,7 +3457,6 @@ for ($i = 0; $i < @test_dirs; $i++) { chomp; print "Omitting tests in $testdir (missing $_)\n"; - next; } # We want the tests from this subdirectory, provided they are in the @@ -3435,9 +3469,15 @@ for ($i = 0; $i < @test_dirs; $i++) 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"; + } } } @@ -3505,8 +3545,8 @@ foreach $basedir ("aux-var", "dnszones") # 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 # @@ -3559,7 +3599,7 @@ if ($have_ipv6 && $parm_ipv6 ne "::1") } my(@components) = split /:/, $exp_v6; my(@nibbles) = reverse (split /\s*/, shift @components); - my($sep) = ""; + my($sep) = ''; $" = "."; open(OUT, ">$parm_cwd/dnszones/db.ip6.@nibbles") || @@ -3619,7 +3659,7 @@ print "\nPress RETURN to run the tests: "; $_ = $force_continue ? "c" : ; print "\n"; -$lasttestdir = ""; +$lasttestdir = ''; foreach $test (@test_list) { @@ -3640,7 +3680,7 @@ foreach $test (@test_list) $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"); @@ -3684,7 +3724,7 @@ foreach $test (@test_list) $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 @@ -3790,7 +3830,7 @@ 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). - my($commandname) = ""; + my($commandname) = ''; my($expectrc) = 0; my($rc, $run_extra) = run_command($testno, \$subtestno, \$expectrc, \$commandname, $TEST_STATE); my($cmdrc) = $?; @@ -3849,7 +3889,10 @@ foreach $test (@test_list) print "\nshow stdErr, show stdOut, Retry, Continue (without file comparison), or Quit? [Q] "; $_ = $force_continue ? "c" : ; 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"; @@ -3896,7 +3939,10 @@ foreach $test (@test_list) print "\nShow server stdout, Retry, Continue, or Quit? [Q] "; $_ = $force_continue ? "c" : ; 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; @@ -3916,9 +3962,9 @@ foreach $test (@test_list) 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) { @@ -3929,14 +3975,16 @@ foreach $test (@test_list) 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 { - print (" Script completed\n"); + print (("#" x 79) . "\n"); + redo; } } }