X-Git-Url: https://git.exim.org/exim.git/blobdiff_plain/b402f29499e9790419ff4dc8bb3462552e98e827..9b25e4a922fe74c9e71fb5d07f37e576d484c098:/test/runtest?ds=sidebyside diff --git a/test/runtest b/test/runtest index ac840379c..1fe7636da 100755 --- a/test/runtest +++ b/test/runtest @@ -33,6 +33,9 @@ use Exim::Runtest; use if $ENV{DEBUG} && $ENV{DEBUG} =~ /\bruntest\b/ => ('Smart::Comments' => '####'); +use constant TEST_TOP => 8999; +use constant TEST_SPECIAL_TOP => 9999; + # Start by initializing some global variables @@ -61,6 +64,7 @@ my $more = 'less -XF'; my $optargs = ''; my $save_output = 0; my $server_opts = ''; +my $slow = 0; my $valgrind = 0; my $have_ipv4 = 1; @@ -68,10 +72,9 @@ 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_end = TEST_TOP; + my @test_list = (); -my @test_dirs = (); # Networks to use for DNS tests. We need to choose some networks that will @@ -800,7 +803,10 @@ RESET_AFTER_EXTRA_LINE_READ: # numbers, or handle specific bad conditions in different ways, leading to # different wording in the error messages, so we cannot compare them. - s/(TLS error on connection (?:from .* )?\(SSL_\w+\): error:)(.*)/$1 <>/; +#XXX This loses any trailing "deliving unencypted to" which is unfortunate +# but I can't work out how to deal with that. + s/(TLS session: \(SSL_\w+\): error:)(.*)(?!: delivering)/$1 <>/; + s/(TLS error on connection from .* \(SSL_\w+\): error:)(.*)/$1 <>/; next if /SSL verify error: depth=0 error=certificate not trusted/; # ======== Maildir things ======== @@ -1274,8 +1280,8 @@ if (! -e $sf_current) 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$/); + return 1 if /^c$/i && $rf !~ /paniclog/ && $rsf !~ /paniclog/; + last if (/^[sc]$/); } foreach $f ($rf, $rsf) @@ -2266,22 +2272,20 @@ elsif (/^((?i:[A-Z\d_]+=\S+\s+)+)?(\d+)?\s*(sudo(?:\s+-u\s+(\w+))?\s+)?exim(_\S+ 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 () { 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: --. 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 # ). Thanks to Kirill Miazine - @msglist = map { $_->[0] } - sort { $a->[1] cmp $b->[1] } - map { [$_, join '', (split '-', $_)[0,2]] } @msglist; + 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 @@ -2549,6 +2553,7 @@ while (@ARGV > 0 && $ARGV[0] =~ /^-/) if ($arg eq "-NOIPV4") { $have_ipv4 = 0; next; } if ($arg eq "-NOIPV6") { $have_ipv6 = 0; next; } if ($arg eq "-KEEP") { $save_output = 1; next; } + if ($arg eq "-SLOW") { $slow = 1; next; } if ($arg eq "-VALGRIND") { $valgrind = 1; next; } if ($arg =~ /^-FLAVOU?R$/) { $flavour = shift; next; } } @@ -2557,14 +2562,15 @@ while (@ARGV > 0 && $ARGV[0] =~ /^-/) # Any subsequent arguments are a range of test numbers. -if (@ARGV > 0) +if (@ARGV) { - $test_end = $test_start = $ARGV[0]; - $test_end = $ARGV[1] if (@ARGV > 1); - $test_end = ($test_start >= 9000)? $test_special_top : $test_top - if $test_end eq "+"; + $test_end = $test_start = shift; + $test_end = shift if @ARGV; + $test_end = ($test_start >= 9000)? TEST_SPECIAL_TOP : TEST_TOP + if $test_end eq '+'; die "** Test numbers out of order\n" if ($test_end < $test_start); } +my @test_range = $test_start..$test_end; ################################################## @@ -3369,6 +3375,8 @@ else print " OK\n"; } +tests_exit(-1, "Failed to unlink $log_summary_filename: $!") + if not unlink($log_summary_filename) and -e $log_summary_filename; ################################################## # Create a list of available tests # @@ -3388,27 +3396,13 @@ print "Omitting \${dlfunc expansion tests (loadable module not present)\n" print "Omitting dbm tests (unable to copy exim_dbmbuild)\n" if $dbm_build_deleted; -opendir(DIR, "scripts") || tests_exit(-1, "Failed to opendir(\"scripts\"): $!"); -@test_dirs = sort readdir(DIR); -closedir(DIR); - -# Remove . and .. and CVS from the list. -for ($i = 0; $i < @test_dirs; $i++) - { - my($d) = $test_dirs[$i]; - if ($d eq "." || $d eq ".." || $d eq "CVS") - { - splice @test_dirs, $i, 1; - $i--; - } - } +my @test_dirs = grep { not /^CVS$/ } map { basename $_ } glob 'scripts/*' + or die tests_exit(-1, "Failed to find test scripts in 'scripts/*`: $!"); # 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++) +DIR: for ($i = 0; $i < @test_dirs; $i++) { my($testdir) = $test_dirs[$i]; my($wantthis) = 1; @@ -3418,19 +3412,19 @@ for ($i = 0; $i < @test_dirs; $i++) # Skip this directory if the first test is equal or greater than the first # test in the next directory. - next if ($i < @test_dirs - 1) && + next DIR if ($i < @test_dirs - 1) && ($test_start >= substr($test_dirs[$i+1], 0, 4)); # No need to carry on if the end test is less than the first test in this # subdirectory. - last if $test_end < substr($testdir, 0, 4); + last DIR if $test_end < substr($testdir, 0, 4); # Check requirements, if any. - if (open(REQUIRES, "scripts/$testdir/REQUIRES")) + if (open(my $requires, "scripts/$testdir/REQUIRES")) { - while () + while (<$requires>) { next if /^\s*$/; s/\s+$//; @@ -3463,7 +3457,6 @@ for ($i = 0; $i < @test_dirs; $i++) tests_exit(-1, "Unknown line in \"scripts/$testdir/REQUIRES\": \"$_\""); } } - close(REQUIRES); } else { @@ -3482,10 +3475,9 @@ for ($i = 0; $i < @test_dirs; $i++) # We want the tests from this subdirectory, provided they are in the # range that was selected. - opendir(SUBDIR, "scripts/$testdir") || - tests_exit(-1, "Failed to opendir(\"scripts/$testdir\"): $!"); - @testlist = sort readdir(SUBDIR); - close(SUBDIR); + @testlist = map { basename $_ } glob "scripts/$testdir/*"; + tests_exit(-1, "Failed to read test scripts from `scripts/$testdir/*': $!") + if not @testlist; foreach $test (@testlist) { @@ -3671,27 +3663,31 @@ closedir(DIR); if (not $force_continue) { # runtest needs to interact if we're not in continue # mode. It does so by communicate to /dev/tty - open(T, "/dev/tty") or tests_exit(-1, "Failed to open /dev/tty: $!"); + open(T, '<', '/dev/tty') or tests_exit(-1, "Failed to open /dev/tty: $!"); + print "\nPress RETURN to run the tests: "; + ; } -print "\nPress RETURN to run the tests: "; -$_ = $force_continue ? "c" : ; -print "\n"; - -$lasttestdir = ''; - foreach $test (@test_list) { - local($lineno) = 0; - local($commandno) = 0; - local($subtestno) = 0; + state $lasttestdir = ''; + + local $lineno = 0; + local $commandno = 0; + local $subtestno = 0; + local $sortlog = 0; + (local $testno = $test) =~ s|.*/||; - local($sortlog) = 0; - my($gnutls) = 0; - my($docheck) = 1; - my($thistestdir) = substr($test, 0, -5); + # Leaving traces in the process table and in the environment + # gives us a chance to identify hanging processes (exim daemons) + local $0 = "[runtest $testno]"; + local $ENV{EXIM_TEST_NUMBER} = $testno; + + my $gnutls = 0; + my $docheck = 1; + my $thistestdir = substr($test, 0, -5); $dynamic_socket->close() if $dynamic_socket; @@ -3700,20 +3696,19 @@ 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"); - while () + open(my $requires, '<', "scripts/$thistestdir/REQUIRES") || + tests_exit(-1, "Failed to open scripts/$thistestdir/REQUIRES: $!"); + while (<$requires>) { $gnutls = 1 if /^support GnuTLS/; print $indent, $_; $indent = ">>> "; } - close(IN); } + $lasttestdir = $thistestdir; } - $lasttestdir = $thistestdir; # Remove any debris in the spool directory and the test-mail directory # and also the files for collecting stdout and stderr. Then put back @@ -3855,8 +3850,6 @@ foreach $test (@test_list) my($rc, $run_extra) = run_command($testno, \$subtestno, \$expectrc, \$commandname, $TEST_STATE); my($cmdrc) = $?; - $0 = "[runtest $testno]"; - if ($debug) { print ">> rc=$rc cmdrc=$cmdrc\n"; if (defined $run_extra) { @@ -3996,6 +3989,7 @@ foreach $test (@test_list) if ($docheck) { + sleep 1 if $slow; my $rc = check_output($TEST_STATE->{munge}); log_test($log_summary_filename, $testno, 'P') if ($rc == 0); if ($rc < 2) @@ -4015,7 +4009,7 @@ foreach $test (@test_list) # Exit from the test script # ################################################## -tests_exit(-1, "No runnable tests selected") if @test_list == 0; +tests_exit(-1, "No runnable tests selected") if not @test_list; tests_exit(0); # End of runtest script