use strict;
use warnings;
use 5.006;
use POSIX qw(strftime);
BEGIN {
if(!defined $ENV{'srcdir'}) {
use File::Basename;
$ENV{'srcdir'} = dirname(__FILE__);
}
push(@INC, $ENV{'srcdir'});
eval {
no warnings "all";
require Time::HiRes;
import Time::HiRes qw( time );
}
}
use Digest::MD5 qw(md5);
use List::Util 'sum';
use I18N::Langinfo qw(langinfo CODESET);
use serverhelp qw(
server_exe
);
use pathhelp qw(
exe_ext
sys_native_current_path
);
use processhelp qw(
portable_sleep
);
use appveyor;
use azure;
use getpart;
use servers;
use valgrind;
use globalconfig;
use runner;
use testutil;
my %custom_skip_reasons;
my $ACURL=$VCURL;
my $CURLCONFIG="../curl-config";
my $TESTCASES="all";
my $libtool;
my $repeat = 0;
my $retry = 0;
my $start;
my $args;
my $uname_release = `uname -r`;
my $is_wsl = $uname_release =~ /Microsoft$/;
my $http_ipv6;
my $http_unix;
my $ftp_ipv6;
my $resolver;
my %skipped;
my @teststat;
my %disabled_keywords;
my %ignored_keywords;
my %enabled_keywords;
my %disabled;
my %ignored;
my %ignoretestcodes;
my $passedign;
my $timestats;
my $fullstats;
my %timeprepini;
my %timesrvrini;
my %timesrvrend;
my %timetoolini;
my %timetoolend;
my %timesrvrlog;
my %timevrfyend;
my $globalabort;
use constant {
ST_INIT => 0,
ST_INITED => 2,
ST_PREPROCESS => 3,
ST_RUN => 4,
};
my %singletest_state;
my %singletest_logs;
my $singletest_bufferedrunner;
my %runnerids;
my @runnersidle;
my %countforrunner;
my %runnersrunning;
my $short;
my $no_debuginfod;
my $keepoutfiles;
my $postmortem;
my $run_disabled;
my $scrambleorder;
my $jobs = 0;
my $AZURE_RUN_ID = 0;
my $AZURE_RESULT_ID = 0;
sub logmsg {
if($singletest_bufferedrunner) {
return singletest_logmsg(@_);
}
for(@_) {
my $line = $_;
if(!$line) {
next;
}
if ($is_wsl) {
$line =~ s/\r?\n$/\r\n/g;
}
print "$line";
}
}
sub logmsg_bufferfortest {
my ($runnerid)=@_;
if($jobs) {
$singletest_bufferedrunner = $runnerid;
}
}
sub singletest_logmsg {
if(!exists $singletest_logs{$singletest_bufferedrunner}) {
$singletest_logs{$singletest_bufferedrunner} = [];
}
my $logsref = $singletest_logs{$singletest_bufferedrunner};
push @$logsref, @_;
}
sub singletest_unbufferlogs {
undef $singletest_bufferedrunner;
}
sub singletest_dumplogs {
if(!defined $singletest_bufferedrunner) {
return undef;
}
my $logsref = $singletest_logs{$singletest_bufferedrunner};
my $msg = join("", @$logsref);
delete $singletest_logs{$singletest_bufferedrunner};
singletest_unbufferlogs();
return $msg;
}
sub catch_zap {
my $signame = shift;
print "runtests.pl received SIG$signame, exiting\r\n";
$globalabort = 1;
}
$SIG{INT} = \&catch_zap;
$SIG{TERM} = \&catch_zap;
sub catch_usr1 {
print "runtests.pl internal state:\r\n";
print scalar(%runnersrunning) . " busy test runner(s) of " . scalar(keys %runnerids) . "\r\n";
foreach my $rid (sort(keys(%runnersrunning))) {
my $runnernum = "unknown";
foreach my $rnum (keys %runnerids) {
if($runnerids{$rnum} == $rid) {
$runnernum = $rnum;
last;
}
}
print "Runner $runnernum (id $rid) running test $runnersrunning{$rid} in state $singletest_state{$rid}\r\n";
}
}
eval {
$SIG{USR1} = \&catch_usr1;
};
$SIG{PIPE} = 'IGNORE';
foreach my $protocol (('ftp', 'http', 'ftps', 'https', 'no', 'all')) {
my $proxy = "${protocol}_proxy";
delete $ENV{$proxy} if($ENV{$proxy});
delete $ENV{uc($proxy)} if($ENV{uc($proxy)});
}
delete $ENV{'SSL_CERT_DIR'} if($ENV{'SSL_CERT_DIR'});
delete $ENV{'SSL_CERT_PATH'} if($ENV{'SSL_CERT_PATH'});
delete $ENV{'CURL_CA_BUNDLE'} if($ENV{'CURL_CA_BUNDLE'});
if (open(my $fd, "<", "config")) {
while(my $line = <$fd>) {
next if ($line =~ /^#/);
chomp $line;
my ($name, $val) = split(/\s*:\s*/, $line, 2);
$ENV{$name} = $val if(!$ENV{$name});
}
close($fd);
}
my $nghttpx_h3 = 0;
if (!$ENV{"NGHTTPX"}) {
$ENV{"NGHTTPX"} = checktestcmd("nghttpx");
}
if ($ENV{"NGHTTPX"}) {
my $cmd = "\"$ENV{'NGHTTPX'}\" -v 2>$dev_null";
my $nghttpx_version=join(' ', `$cmd`);
$nghttpx_h3 = $nghttpx_version =~ /nghttp3\//;
chomp $nghttpx_h3;
}
my $disttests = "";
sub get_disttests {
open(my $dh, "<", "$TESTDIR/Makefile.am") or return;
while(<$dh>) {
chomp $_;
if(($_ =~ /^#/) ||($_ !~ /test/)) {
next;
}
$disttests .= $_;
}
close($dh);
}
sub cleardir {
my $dir = $_[0];
my $done = 1;
my $file;
opendir(my $dh, $dir) ||
return 0;
while($file = readdir($dh)) {
if(($file !~ /^(\.|\.\.)\z/) &&
"$file" ne $PIDDIR && "$file" ne $LOCKDIR) {
if(-d "$dir/$file") {
if(!cleardir("$dir/$file")) {
$done = 0;
}
if(!rmdir("$dir/$file")) {
$done = 0;
}
}
else {
if(!unlink("$dir/$file") && "$file" !~ /_stunnel\.log$/) {
$done = 0;
}
}
}
}
closedir $dh;
return $done;
}
sub showdiff {
my ($logdir, $firstref, $secondref)=@_;
my $file1="$logdir/check-generated";
my $file2="$logdir/check-expected";
open(my $temp, ">", "$file1") || die "Failure writing diff file";
for(@$firstref) {
my $l = $_;
$l =~ s/\r/[CR]/g;
$l =~ s/\n/[LF]/g;
$l =~ s/([^\x20-\x7f])/sprintf "%%%02x", ord $1/eg;
print $temp $l;
print $temp "\n";
}
close($temp) || die "Failure writing diff file";
open($temp, ">", "$file2") || die "Failure writing diff file";
for(@$secondref) {
my $l = $_;
$l =~ s/\r/[CR]/g;
$l =~ s/\n/[LF]/g;
$l =~ s/([^\x20-\x7f])/sprintf "%%%02x", ord $1/eg;
print $temp $l;
print $temp "\n";
}
close($temp) || die "Failure writing diff file";
my @out = `diff -u $file2 $file1 2>$dev_null`;
if(!$out[0]) {
@out = `diff -c $file2 $file1 2>$dev_null`;
if(!$out[0]) {
logmsg "Failed to show diff. The diff tool may be missing.\n";
}
}
return @out;
}
sub compare {
my ($runnerid, $testnum, $testname, $subject, $firstref, $secondref)=@_;
my $result = compareparts($firstref, $secondref);
if($result) {
$timevrfyend{$testnum} = Time::HiRes::time();
if(!$short) {
logmsg "\n $testnum: $subject FAILED:\n";
my $logdir = getrunnerlogdir($runnerid);
logmsg showdiff($logdir, $firstref, $secondref);
}
elsif(!$automakestyle) {
logmsg "FAILED\n";
}
else {
logmsg "FAIL: $testnum - $testname - $subject\n";
}
}
return $result;
}
sub numsortwords {
my ($string)=@_;
return join(' ', sort { $a <=> $b } split(' ', $string));
}
sub parseprotocols {
my ($line)=@_;
@protocols = split(' ', lc($line));
push @protocols, map(("$_-ipv6", "$_-unix"), @protocols);
push @protocols, 'http-proxy';
push @protocols, 'https-mtls';
push @protocols, 'none';
}
sub checksystemfeatures {
my $proto;
my $feat;
my $curl;
my $libcurl;
my $versretval;
my $versnoexec;
my @version=();
my @disabled;
my $dis = "";
my $curlverout="$LOGDIR/curlverout.log";
my $curlvererr="$LOGDIR/curlvererr.log";
my $versioncmd=exerunner() . shell_quote($CURL) . " --version 1>$curlverout 2>$curlvererr";
unlink($curlverout);
unlink($curlvererr);
$versretval = runclient($versioncmd);
$versnoexec = $!;
my $current_time = int(time());
$ENV{'SOURCE_DATE_EPOCH'} = $current_time;
$DATE = strftime "%Y-%m-%d", gmtime($current_time);
open(my $versout, "<", "$curlverout");
@version = <$versout>;
close($versout);
open(my $disabledh, "-|", exerunner() . shell_quote($CURLINFO));
while(<$disabledh>) {
if($_ =~ /([^:]*): ([ONF]*)/) {
my ($val, $toggle) = ($1, $2);
push @disabled, $val if($toggle eq "OFF");
$feature{$val} = 1 if($toggle eq "ON");
}
}
close($disabledh);
if($disabled[0]) {
s/[\r\n]//g for @disabled;
$dis = join(", ", @disabled);
}
$resolver="stock";
for(@version) {
chomp;
if($_ =~ /^curl ([^ ]*)/) {
$curl = $_;
$CURLVERSION = $1;
$CURLVERNUM = $CURLVERSION;
$CURLVERNUM =~ s/^([0-9.]+)(.*)/$1/;
$curl =~ s/^(.*)(libcurl.*)/$1/g || die "Failure determining curl binary version";
$libcurl = $2;
if($curl =~ /linux|bsd|solaris/) {
$feature{"ld_preload"} = 1;
}
if($curl =~ /win32|Windows|windows|mingw(32|64)/) {
$pwd = sys_native_current_path();
$feature{"win32"} = 1;
}
if ($libcurl =~ /\sschannel\b/i) {
$feature{"Schannel"} = 1;
$feature{"SSLpinning"} = 1;
}
elsif ($libcurl =~ /\sopenssl\b/i) {
$feature{"OpenSSL"} = 1;
$feature{"SSLpinning"} = 1;
}
elsif ($libcurl =~ /\sgnutls\b/i) {
$feature{"GnuTLS"} = 1;
$feature{"SSLpinning"} = 1;
}
elsif ($libcurl =~ /\srustls-ffi\b/i) {
$feature{"rustls"} = 1;
}
elsif ($libcurl =~ /\swolfssl\b/i) {
$feature{"wolfssl"} = 1;
$feature{"SSLpinning"} = 1;
}
elsif ($libcurl =~ /\sbearssl\b/i) {
$feature{"bearssl"} = 1;
}
elsif ($libcurl =~ /\ssecuretransport\b/i) {
$feature{"sectransp"} = 1;
$feature{"SSLpinning"} = 1;
}
elsif ($libcurl =~ /\s(BoringSSL|AWS-LC)\b/i) {
$feature{"OpenSSL"} = 1;
$feature{"SSLpinning"} = 1;
}
elsif ($libcurl =~ /\slibressl\b/i) {
$feature{"OpenSSL"} = 1;
$feature{"SSLpinning"} = 1;
}
elsif ($libcurl =~ /\squictls\b/i) {
$feature{"OpenSSL"} = 1;
$feature{"SSLpinning"} = 1;
}
elsif ($libcurl =~ /\smbedTLS\b/i) {
$feature{"mbedtls"} = 1;
$feature{"SSLpinning"} = 1;
}
if ($libcurl =~ /ares/i) {
$feature{"c-ares"} = 1;
$resolver="c-ares";
}
if ($libcurl =~ /nghttp2/i) {
$feature{"h2c"} = 1;
}
if ($libcurl =~ /AppleIDN/) {
$feature{"AppleIDN"} = 1;
}
if ($libcurl =~ /WinIDN/) {
$feature{"WinIDN"} = 1;
}
if ($libcurl =~ /libidn2/) {
$feature{"libidn2"} = 1;
}
if ($libcurl =~ /libssh2/i) {
$feature{"libssh2"} = 1;
}
if ($libcurl =~ /libssh\/([0-9.]*)\//i) {
$feature{"libssh"} = 1;
if($1 =~ /(\d+)\.(\d+).(\d+)/) {
my $v = $1 * 100 + $2 * 10 + $3;
if($v < 94) {
$feature{"oldlibssh"} = 1;
}
}
}
if ($libcurl =~ /wolfssh/i) {
$feature{"wolfssh"} = 1;
}
}
elsif($_ =~ /^Protocols: (.*)/i) {
$proto = $1;
parseprotocols($proto);
}
elsif($_ =~ /^Features: (.*)/i) {
$feat = $1;
$feature{"TrackMemory"} = $feat =~ /TrackMemory/i;
$feature{"Debug"} = $feat =~ /Debug/i;
$feature{"SSL"} = $feat =~ /SSL/i;
$feature{"MultiSSL"} = $feat =~ /MultiSSL/i;
$feature{"Largefile"} = $feat =~ /Largefile/i;
$feature{"IDN"} = $feat =~ /IDN/i;
$feature{"IPv6"} = $feat =~ /IPv6/i;
$feature{"UnixSockets"} = $feat =~ /UnixSockets/i;
$feature{"libz"} = $feat =~ /libz/i;
$feature{"brotli"} = $feat =~ /brotli/i;
$feature{"zstd"} = $feat =~ /zstd/i;
$feature{"NTLM"} = $feat =~ /NTLM/i;
$feature{"NTLM_WB"} = $feat =~ /NTLM_WB/i;
$feature{"SSPI"} = $feat =~ /SSPI/i;
$feature{"GSS-API"} = $feat =~ /GSS-API/i;
$feature{"Kerberos"} = $feat =~ /Kerberos/i;
$feature{"SPNEGO"} = $feat =~ /SPNEGO/i;
$feature{"TLS-SRP"} = $feat =~ /TLS-SRP/i;
$feature{"PSL"} = $feat =~ /PSL/i;
$feature{"alt-svc"} = $feat =~ /alt-svc/i;
$feature{"HSTS"} = $feat =~ /HSTS/i;
$feature{"asyn-rr"} = $feat =~ /asyn-rr/;
if($feat =~ /AsynchDNS/i) {
if(!$feature{"c-ares"} || $feature{"asyn-rr"}) {
$feature{"threaded-resolver"} = 1;
$resolver="threaded";
$feature{"c-ares"} = 0;
}
}
$feature{"http/2"} = $feat =~ /HTTP2/;
if($feature{"http/2"}) {
push @protocols, 'http/2';
}
$feature{"http/3"} = $feat =~ /HTTP3/;
if($feature{"http/3"}) {
push @protocols, 'http/3';
}
$feature{"HTTPS-proxy"} = $feat =~ /HTTPS-proxy/;
if($feature{"HTTPS-proxy"}) {
push @protocols, 'https-proxy';
}
$feature{"Unicode"} = $feat =~ /Unicode/i;
$feature{"threadsafe"} = $feat =~ /threadsafe/i;
$feature{"HTTPSRR"} = $feat =~ /HTTPSRR/;
$feature{"ECH"} = $feat =~ /ECH/;
}
if($feature{"TLS-SRP"}) {
my $add_httptls;
for(@protocols) {
if($_ =~ /^https(-ipv6|)$/) {
$add_httptls=1;
last;
}
}
if($add_httptls && (! grep /^httptls$/, @protocols)) {
push @protocols, 'httptls';
push @protocols, 'httptls-ipv6';
}
}
}
if(!$curl) {
logmsg "unable to get curl's version, further details are:\n";
logmsg "issued command: \n";
logmsg "$versioncmd \n";
if ($versretval == -1) {
logmsg "command failed with: \n";
logmsg "$versnoexec \n";
}
elsif ($versretval & 127) {
logmsg sprintf("command died with signal %d, and %s coredump.\n",
($versretval & 127), ($versretval & 128)?"a":"no");
}
else {
logmsg sprintf("command exited with value %d \n", $versretval >> 8);
}
logmsg "contents of $curlverout: \n";
displaylogcontent("$curlverout");
logmsg "contents of $curlvererr: \n";
displaylogcontent("$curlvererr");
die "couldn't get curl's version";
}
if(-r "../lib/curl_config.h") {
open(my $conf, "<", "../lib/curl_config.h");
while(<$conf>) {
if($_ =~ /^\#define HAVE_GETRLIMIT/) {
$feature{"getrlimit"} = 1;
}
}
close($conf);
}
$feature{"ld_preload"} = $feature{"ld_preload"} && !$feature{"Debug"};
if($feature{"IPv6"}) {
my $cmd = server_exe('sws')." --version";
my @sws = `$cmd`;
if($sws[0] =~ /IPv6/) {
$http_ipv6 = 1;
}
$cmd = server_exe('sockfilt')." --version";
@sws = `$cmd`;
if($sws[0] =~ /IPv6/) {
$ftp_ipv6 = 1;
}
}
if($feature{"UnixSockets"}) {
my $cmd = server_exe('sws')." --version";
my @sws = `$cmd`;
$http_unix = 1 if($sws[0] =~ /unix/);
}
open(my $manh, "-|", shell_quote($CURL) . " -M 2>&1");
while(my $s = <$manh>) {
if($s =~ /built-in manual was disabled at build-time/) {
$feature{"manual"} = 0;
last;
}
$feature{"manual"} = 1;
last;
}
close($manh);
$feature{"unittest"} = 1;
$feature{"nghttpx"} = !!$ENV{'NGHTTPX'};
$feature{"nghttpx-h3"} = !!$nghttpx_h3;
$feature{"crypto"} = $feature{"NTLM"} || $feature{"Kerberos"} || $feature{"SPNEGO"};
$feature{"local-http"} = servers::localhttp();
$feature{"codeset-utf8"} = lc(langinfo(CODESET())) eq "utf-8";
for my $p (@protocols) {
$feature{$p} = 1;
}
$has_shared = `sh $CURLCONFIG --built-shared`;
chomp $has_shared;
$has_shared = $has_shared eq "yes";
if(!$feature{"TrackMemory"} && $torture) {
die "can't run torture tests since curl was built without ".
"TrackMemory feature (--enable-curldebug)";
}
my $hostname=join(' ', runclientoutput("hostname"));
chomp $hostname;
my $hosttype=join(' ', runclientoutput("uname -a"));
chomp $hosttype;
my $hostos=$^O;
my $havediff;
if(system("diff $TESTDIR/DISABLED $TESTDIR/DISABLED 2>$dev_null") == 0) {
$havediff = 'available';
}
else {
$havediff = 'missing';
}
logmsg ("********* System characteristics ******** \n",
"* $curl\n",
"* $libcurl\n",
"* Protocols: $proto\n",
"* Features: $feat\n",
"* Disabled: $dis\n",
"* Host: $hostname\n",
"* System: $hosttype\n",
"* OS: $hostos\n",
"* Perl: $^V ($^X)\n",
"* diff: $havediff\n",
"* Args: $args\n");
if($jobs) {
logmsg "* Jobs: $jobs\n";
}
if($feature{"TrackMemory"} && $feature{"threaded-resolver"}) {
logmsg("*\n",
"*** DISABLES TrackMemory (memory tracking) when using threaded resolver\n",
"*\n");
}
logmsg sprintf("* Env: %s%s%s%s%s", $valgrind?"Valgrind ":"",
$run_duphandle?"test-duphandle ":"",
$run_event_based?"event-based ":"",
$bundle?"bundle ":"",
$nghttpx_h3);
logmsg sprintf("%s\n", $libtool?"Libtool ":"");
logmsg ("* Seed: $randseed\n");
$feature{"TrackMemory"} = $feature{"TrackMemory"} && !$feature{"threaded-resolver"};
}
sub displayserverfeatures {
logmsg sprintf("* Servers: %s", $stunnel?"SSL ":"");
logmsg sprintf("%s", $http_ipv6?"HTTP-IPv6 ":"");
logmsg sprintf("%s", $http_unix?"HTTP-unix ":"");
logmsg sprintf("%s\n", $ftp_ipv6?"FTP-IPv6 ":"");
logmsg "***************************************** \n";
}
sub timestampskippedevents {
my $testnum = $_[0];
return if((not defined($testnum)) || ($testnum < 1));
if($timestats) {
if($timevrfyend{$testnum}) {
return;
}
elsif($timesrvrlog{$testnum}) {
$timevrfyend{$testnum} = $timesrvrlog{$testnum};
return;
}
elsif($timetoolend{$testnum}) {
$timevrfyend{$testnum} = $timetoolend{$testnum};
$timesrvrlog{$testnum} = $timetoolend{$testnum};
}
elsif($timetoolini{$testnum}) {
$timevrfyend{$testnum} = $timetoolini{$testnum};
$timesrvrlog{$testnum} = $timetoolini{$testnum};
$timetoolend{$testnum} = $timetoolini{$testnum};
}
elsif($timesrvrend{$testnum}) {
$timevrfyend{$testnum} = $timesrvrend{$testnum};
$timesrvrlog{$testnum} = $timesrvrend{$testnum};
$timetoolend{$testnum} = $timesrvrend{$testnum};
$timetoolini{$testnum} = $timesrvrend{$testnum};
}
elsif($timesrvrini{$testnum}) {
$timevrfyend{$testnum} = $timesrvrini{$testnum};
$timesrvrlog{$testnum} = $timesrvrini{$testnum};
$timetoolend{$testnum} = $timesrvrini{$testnum};
$timetoolini{$testnum} = $timesrvrini{$testnum};
$timesrvrend{$testnum} = $timesrvrini{$testnum};
}
elsif($timeprepini{$testnum}) {
$timevrfyend{$testnum} = $timeprepini{$testnum};
$timesrvrlog{$testnum} = $timeprepini{$testnum};
$timetoolend{$testnum} = $timeprepini{$testnum};
$timetoolini{$testnum} = $timeprepini{$testnum};
$timesrvrend{$testnum} = $timeprepini{$testnum};
$timesrvrini{$testnum} = $timeprepini{$testnum};
}
}
}
sub citest_starttestrun {
if(azure_check_environment()) {
$AZURE_RUN_ID = azure_create_test_run($ACURL);
logmsg "Azure Run ID: $AZURE_RUN_ID\n" if ($verbose);
}
}
sub citest_starttest {
my $testnum = $_[0];
my $testname= (getpart("client", "name"))[0];
chomp $testname;
if(azure_check_environment() && $AZURE_RUN_ID) {
$AZURE_RESULT_ID = azure_create_test_result($ACURL, $AZURE_RUN_ID, $testnum, $testname);
}
elsif(appveyor_check_environment()) {
appveyor_create_test_result($ACURL, $testnum, $testname);
}
}
sub citest_finishtest {
my ($testnum, $error) = @_;
if(azure_check_environment() && $AZURE_RUN_ID && $AZURE_RESULT_ID) {
$AZURE_RESULT_ID = azure_update_test_result($ACURL, $AZURE_RUN_ID, $AZURE_RESULT_ID, $testnum, $error,
$timeprepini{$testnum}, $timevrfyend{$testnum});
}
elsif(appveyor_check_environment()) {
appveyor_update_test_result($ACURL, $testnum, $error, $timeprepini{$testnum}, $timevrfyend{$testnum});
}
}
sub citest_finishtestrun {
if(azure_check_environment() && $AZURE_RUN_ID) {
$AZURE_RUN_ID = azure_update_test_run($ACURL, $AZURE_RUN_ID);
}
}
sub updatetesttimings {
my ($testnum, %testtimings)=@_;
if(defined $testtimings{"timeprepini"}) {
$timeprepini{$testnum} = $testtimings{"timeprepini"};
}
if(defined $testtimings{"timesrvrini"}) {
$timesrvrini{$testnum} = $testtimings{"timesrvrini"};
}
if(defined $testtimings{"timesrvrend"}) {
$timesrvrend{$testnum} = $testtimings{"timesrvrend"};
}
if(defined $testtimings{"timetoolini"}) {
$timetoolini{$testnum} = $testtimings{"timetoolini"};
}
if(defined $testtimings{"timetoolend"}) {
$timetoolend{$testnum} = $testtimings{"timetoolend"};
}
if(defined $testtimings{"timesrvrlog"}) {
$timesrvrlog{$testnum} = $testtimings{"timesrvrlog"};
}
}
sub getrunnernumlogdir {
my $runnernum = $_[0];
return $jobs > 1 ? "$LOGDIR/$runnernum" : $LOGDIR;
}
sub getrunnerlogdir {
my $runnerid = $_[0];
if($jobs <= 1) {
return $LOGDIR;
}
for my $runnernum (keys %runnerids) {
if($runnerid eq $runnerids{$runnernum}) {
return "$LOGDIR/$runnernum";
}
}
die "Internal error: runner ID $runnerid not found";
}
sub singletest_shouldrun {
my $testnum = $_[0];
my $why;
my $errorreturncode = 1;
my @what;
if($disttests !~ /test$testnum(\W|\z)/ ) {
logmsg "Warning: test$testnum not present in tests/data/Makefile.am\n";
}
if($disabled{$testnum}) {
if(!$run_disabled) {
$why = "listed in DISABLED";
}
else {
logmsg "Warning: test$testnum is explicitly disabled\n";
}
}
if($ignored{$testnum}) {
logmsg "Warning: test$testnum result is ignored\n";
$errorreturncode = 2;
}
if(loadtest("${TESTDIR}/test${testnum}")) {
if($verbose) {
logmsg "RUN: $testnum doesn't look like a test case\n";
}
$why = "no test";
}
else {
@what = getpart("client", "features");
}
for(@what) {
my $f = $_;
$f =~ s/\s//g;
if($f =~ /^([^!].*)$/) {
if($feature{$1}) {
next;
}
$why = "curl lacks $1 support";
last;
}
}
if(!$why) {
for(@what) {
my $f = $_;
$f =~ s/\s//g;
if($f =~ /^!(.*)$/) {
if(!$feature{$1}) {
next;
}
}
else {
next;
}
$why = "curl has $1 support";
last;
}
}
my @info_keywords;
if(!$why) {
@info_keywords = getpart("info", "keywords");
if(!$info_keywords[0]) {
$why = "missing the <keywords> section!";
}
else {
push @info_keywords, map { "feat:" . lc($_) } getpart("client", "features");
my $match;
for my $k (@info_keywords) {
chomp $k;
if ($disabled_keywords{lc($k)}) {
if ($k =~ /^feat:/) {
$why = "disabled by feature";
}
else {
$why = "disabled by keyword";
}
}
elsif ($enabled_keywords{lc($k)}) {
$match = 1;
}
if ($ignored_keywords{lc($k)}) {
logmsg "Warning: test$testnum result is ignored due to $k\n";
$errorreturncode = 2;
}
}
if(!$why && !$match && %enabled_keywords) {
if (grep { /^feat:/ } keys %enabled_keywords) {
$why = "disabled by missing feature";
}
else {
$why = "disabled by missing keyword";
}
}
}
}
if (!$why && defined $custom_skip_reasons{test}{$testnum}) {
$why = $custom_skip_reasons{test}{$testnum};
}
if (!$why && defined $custom_skip_reasons{tool}) {
foreach my $tool (getpart("client", "tool")) {
foreach my $tool_skip_pattern (keys %{$custom_skip_reasons{tool}}) {
if ($tool =~ /$tool_skip_pattern/i) {
$why = $custom_skip_reasons{tool}{$tool_skip_pattern};
}
}
}
}
if (!$why && defined $custom_skip_reasons{keyword}) {
foreach my $keyword (@info_keywords) {
foreach my $keyword_skip_pattern (keys %{$custom_skip_reasons{keyword}}) {
if ($keyword =~ /$keyword_skip_pattern/i) {
$why = $custom_skip_reasons{keyword}{$keyword_skip_pattern};
}
}
}
}
return ($why, $errorreturncode);
}
sub singletest_count {
my ($testnum, $why) = @_;
if($why && !$listonly) {
$skipped{$why}++;
$teststat[$testnum]=$why;
if(!$short) {
if($skipped{$why} <= 3) {
logmsg sprintf("test %04d SKIPPED: $why\n", $testnum);
}
}
timestampskippedevents($testnum);
return -1;
}
logmsg sprintf("test %04d...", $testnum) if(!$automakestyle);
my $testname= (getpart("client", "name"))[0];
chomp $testname;
logmsg "[$testname]\n" if(!$short);
if($listonly) {
timestampskippedevents($testnum);
}
return 0;
}
sub normalize_text {
my ($ref) = @_;
s/\r\n/\n/g for @$ref;
s/\n/\r\n/g for @$ref;
}
sub singletest_check {
my ($runnerid, $testnum, $cmdres, $CURLOUT, $tool, $usedvalgrind)=@_;
if ($torture) {
$timevrfyend{$testnum} = Time::HiRes::time();
return -2;
}
my $logdir = getrunnerlogdir($runnerid);
my @err = getpart("verify", "errorcode");
my $errorcode = $err[0] || "0";
my $ok="";
my $res;
chomp $errorcode;
my $testname= (getpart("client", "name"))[0];
chomp $testname;
my @stripfile = getpart("verify", "stripfile");
my @validstdout = getpart("verify", "stdout");
my %hash = getpartattr("verify", "stdout");
my $loadfile = $hash{'loadfile'};
if ($loadfile) {
open(my $tmp, "<", "$loadfile") || die "Cannot open file $loadfile: $!";
@validstdout = <$tmp>;
close($tmp);
s/\r\n/\n/g for @validstdout;
}
if (@validstdout) {
my @actual = loadarray(stdoutfilename($logdir, $testnum));
foreach my $strip (@stripfile) {
chomp $strip;
my @newgen;
for(@actual) {
eval $strip;
if($_) {
push @newgen, $_;
}
}
@actual = @newgen;
}
my $filemode=$hash{'mode'};
if($filemode && ($filemode eq "text")) {
normalize_text(\@validstdout);
normalize_text(\@actual);
}
if($hash{'nonewline'}) {
chomp($validstdout[-1]);
}
if($hash{'crlf'}) {
subnewlines(0, \$_) for @validstdout;
}
$res = compare($runnerid, $testnum, $testname, "stdout", \@actual, \@validstdout);
if($res) {
return -1;
}
$ok .= "s";
}
else {
$ok .= "-";
}
my @validstderr = getpart("verify", "stderr");
if (@validstderr) {
my @actual = loadarray(stderrfilename($logdir, $testnum));
foreach my $strip (@stripfile) {
chomp $strip;
my @newgen;
for(@actual) {
eval $strip;
if($_) {
push @newgen, $_;
}
}
@actual = @newgen;
}
my %hash = getpartattr("verify", "stderr");
my $filemode=$hash{'mode'};
if($filemode && ($filemode eq "text")) {
normalize_text(\@validstderr);
normalize_text(\@actual);
}
if($hash{'nonewline'}) {
chomp($validstderr[-1]);
}
if($hash{'crlf'}) {
subnewlines(0, \$_) for @validstderr;
}
$res = compare($runnerid, $testnum, $testname, "stderr", \@actual, \@validstderr);
if($res) {
return -1;
}
$ok .= "r";
}
else {
$ok .= "-";
}
my @strip = getpart("verify", "strip");
my @strippart = getpart("verify", "strippart");
my @protocol= getpart("verify", "protocol");
if(@protocol) {
my @out = loadarray("$logdir/$SERVERIN");
my %hash = getpartattr("verify", "protocol");
if($hash{'nonewline'}) {
chomp($protocol[-1]);
}
for(@strip) {
chomp $_;
@out = striparray( $_, \@out);
@protocol= striparray( $_, \@protocol);
}
for my $strip (@strippart) {
chomp $strip;
for(@out) {
eval $strip;
}
}
if($hash{'crlf'}) {
subnewlines(1, \$_) for @protocol;
}
if((!$out[0] || ($out[0] eq "")) && $protocol[0]) {
logmsg "\n $testnum: protocol FAILED!\n".
" There was no content at all in the file $logdir/$SERVERIN.\n".
" Server glitch? Total curl failure? Returned: $cmdres\n";
$timevrfyend{$testnum} = Time::HiRes::time();
return -1;
}
$res = compare($runnerid, $testnum, $testname, "protocol", \@out, \@protocol);
if($res) {
return -1;
}
$ok .= "p";
}
else {
$ok .= "-";
}
my %replyattr = getpartattr("reply", "data");
my @reply;
if (partexists("reply", "datacheck")) {
for my $partsuffix (('', '1', '2', '3', '4')) {
my @replycheckpart = getpart("reply", "datacheck".$partsuffix);
if(@replycheckpart) {
my %replycheckpartattr = getpartattr("reply", "datacheck".$partsuffix);
my $filemode=$replycheckpartattr{'mode'};
if($filemode && ($filemode eq "text")) {
normalize_text(\@replycheckpart);
}
if($replycheckpartattr{'nonewline'}) {
chomp($replycheckpart[-1]);
}
if($replycheckpartattr{'crlf'}) {
subnewlines(0, \$_) for @replycheckpart;
}
push(@reply, @replycheckpart);
}
}
}
else {
@reply = getpart("reply", "data");
if(@reply) {
if($replyattr{'nonewline'}) {
chomp($reply[-1]);
}
}
my $filemode=$replyattr{'mode'};
if($filemode && ($filemode eq "text")) {
normalize_text(\@reply);
}
if($replyattr{'crlf'}) {
subnewlines(0, \$_) for @reply;
}
}
if(!$replyattr{'nocheck'} && (@reply || $replyattr{'sendzero'})) {
my @out = loadarray($CURLOUT);
my $filemode=$replyattr{'mode'};
if($filemode && ($filemode eq "text")) {
normalize_text(\@out);
}
$res = compare($runnerid, $testnum, $testname, "data", \@out, \@reply);
if ($res) {
return -1;
}
$ok .= "d";
}
else {
$ok .= "-";
}
my @upload = getpart("verify", "upload");
if(@upload) {
my %hash = getpartattr("verify", "upload");
if($hash{'nonewline'}) {
chomp($upload[-1]);
}
for my $line (@upload) {
subbase64(\$line);
subsha256base64file(\$line);
substrippemfile(\$line);
}
my @out = loadarray("$logdir/upload.$testnum");
for my $strip (@strippart) {
chomp $strip;
for(@out) {
eval $strip;
}
}
if($hash{'crlf'}) {
subnewlines(1, \$_) for @upload;
}
if($hash{'nonewline'}) {
chomp($upload[-1]);
}
$res = compare($runnerid, $testnum, $testname, "upload", \@out, \@upload);
if ($res) {
return -1;
}
$ok .= "u";
}
else {
$ok .= "-";
}
my @proxyprot = getpart("verify", "proxy");
if(@proxyprot) {
my %hash = getpartattr("verify", "proxy");
if($hash{'nonewline'}) {
chomp($proxyprot[-1]);
}
my @out = loadarray("$logdir/$PROXYIN");
for(@strip) {
chomp $_;
@out = striparray( $_, \@out);
@proxyprot= striparray( $_, \@proxyprot);
}
for my $strip (@strippart) {
chomp $strip;
for(@out) {
eval $strip;
}
}
if($hash{'crlf'}) {
subnewlines(0, \$_) for @proxyprot;
}
$res = compare($runnerid, $testnum, $testname, "proxy", \@out, \@proxyprot);
if($res) {
return -1;
}
$ok .= "P";
}
else {
$ok .= "-";
}
my $outputok;
for my $partsuffix (('', '1', '2', '3', '4')) {
my @outfile=getpart("verify", "file".$partsuffix);
if(@outfile || partexists("verify", "file".$partsuffix) ) {
my %hash = getpartattr("verify", "file".$partsuffix);
my $filename=$hash{'name'};
if(!$filename) {
logmsg " $testnum: IGNORED: section verify=>file$partsuffix ".
"has no name attribute\n";
if (runnerac_stopservers($runnerid)) {
logmsg "ERROR: runner $runnerid seems to have died\n";
} else {
if($verbose) {
logmsg "WARNING: blocking call in async function\n";
}
my ($rid, $unexpected, $logs) = runnerar($runnerid);
if(!$rid) {
logmsg "ERROR: runner $runnerid seems to have died\n";
} else {
logmsg $logs;
}
}
$timevrfyend{$testnum} = Time::HiRes::time();
return -1;
}
my @generated=loadarray($filename);
my @stripfilepar = getpart("verify", "stripfile".$partsuffix);
my $filemode=$hash{'mode'};
if($filemode && ($filemode eq "text")) {
normalize_text(\@outfile);
normalize_text(\@generated);
}
if($hash{'crlf'}) {
subnewlines(0, \$_) for @outfile;
}
for my $strip (@stripfilepar) {
chomp $strip;
my @newgen;
for(@generated) {
eval $strip;
if($_) {
push @newgen, $_;
}
}
@generated = @newgen;
}
if($hash{'nonewline'}) {
chomp($outfile[-1]);
}
$res = compare($runnerid, $testnum, $testname, "output ($filename)",
\@generated, \@outfile);
if($res) {
return -1;
}
$outputok = 1;
}
}
$ok .= ($outputok) ? "o" : "-";
my @socksprot = getpart("verify", "socks");
if(@socksprot) {
my @out = loadarray("$logdir/$SOCKSIN");
$res = compare($runnerid, $testnum, $testname, "socks", \@out, \@socksprot);
if($res) {
return -1;
}
}
my @splerr = split(/ *, */, $errorcode);
my $errok;
foreach my $e (@splerr) {
if($e == $cmdres) {
$errok = 1;
last;
}
}
if($errok) {
$ok .= "e";
}
else {
if(!$short) {
logmsg sprintf("\n%s returned $cmdres, when expecting %s\n",
(!$tool)?"curl":$tool, $errorcode);
}
logmsg " $testnum: exit FAILED\n";
$timevrfyend{$testnum} = Time::HiRes::time();
return -1;
}
if($feature{"TrackMemory"}) {
if(! -f "$logdir/$MEMDUMP") {
my %cmdhash = getpartattr("client", "command");
my $cmdtype = $cmdhash{'type'} || "default";
logmsg "\n** ALERT! memory tracking with no output file?\n"
if($cmdtype ne "perl");
$ok .= "-";
}
else {
my @memdata=`$memanalyze "$logdir/$MEMDUMP"`;
my $leak=0;
for(@memdata) {
if($_ ne "") {
$leak=1;
}
}
if($leak) {
logmsg "\n** MEMORY FAILURE\n";
logmsg @memdata;
$timevrfyend{$testnum} = Time::HiRes::time();
return -1;
}
else {
$ok .= "m";
}
}
}
else {
$ok .= "-";
}
my @notexists = getpart("verify", "notexists");
if(@notexists) {
my $err;
while (@notexists) {
my $fname = shift @notexists;
chomp $fname;
if (-e $fname) {
logmsg "Found '$fname' when not supposed to exist.\n";
$err++;
}
elsif($verbose) {
logmsg "Found '$fname' confirmed to not exist.\n";
}
}
if($err) {
return -1;
}
}
if($valgrind) {
if($usedvalgrind) {
if(!opendir(DIR, "$logdir")) {
logmsg "ERROR: unable to read $logdir\n";
$timevrfyend{$testnum} = Time::HiRes::time();
return -1;
}
my @files = readdir(DIR);
closedir(DIR);
my $vgfile;
foreach my $file (@files) {
if($file =~ /^valgrind$testnum(\..*|)$/) {
$vgfile = $file;
last;
}
}
if(!$vgfile) {
logmsg "ERROR: valgrind log file missing for test $testnum\n";
$timevrfyend{$testnum} = Time::HiRes::time();
return -1;
}
my @e = valgrindparse("$logdir/$vgfile");
if(@e && $e[0]) {
if($automakestyle) {
logmsg "FAIL: $testnum - $testname - valgrind\n";
}
else {
logmsg " valgrind ERROR ";
logmsg @e;
}
$timevrfyend{$testnum} = Time::HiRes::time();
return -1;
}
$ok .= "v";
}
else {
if($verbose) {
logmsg " valgrind SKIPPED\n";
}
$ok .= "-";
}
}
else {
$ok .= "-";
}
$ok .= $run_event_based ? "E" : "-";
logmsg "$ok " if(!$short);
$timevrfyend{$testnum} = Time::HiRes::time();
return 0;
}
sub singletest_success {
my ($testnum, $count, $total, $errorreturncode)=@_;
my $sofar= time()-$start;
my $esttotal = $sofar/$count * $total;
my $estleft = $esttotal - $sofar;
my $timeleft=sprintf("remaining: %02d:%02d",
$estleft/60,
$estleft%60);
my $took = $timevrfyend{$testnum} - $timeprepini{$testnum};
my $duration = sprintf("duration: %02d:%02d",
$sofar/60, $sofar%60);
if(!$automakestyle) {
logmsg sprintf("OK (%-3d out of %-3d, %s, took %.3fs, %s)\n",
$count, $total, $timeleft, $took, $duration);
}
else {
my $testname= (getpart("client", "name"))[0];
chomp $testname;
logmsg "PASS: $testnum - $testname\n";
}
if($errorreturncode==2) {
$passedign .= "$testnum ";
logmsg "Warning: test$testnum result is ignored, but passed!\n";
}
}
sub singletest {
my ($runnerid, $testnum, $count, $total)=@_;
logmsg_bufferfortest($runnerid);
if(!exists $singletest_state{$runnerid}) {
$singletest_state{$runnerid} = ST_INIT;
}
if($singletest_state{$runnerid} == ST_INIT) {
my $logdir = getrunnerlogdir($runnerid);
if(!cleardir($logdir)) {
logmsg "Warning: $runnerid: cleardir($logdir) failed\n";
}
if(!cleardir("$logdir/$LOCKDIR")) {
logmsg "Warning: $runnerid: cleardir($logdir/$LOCKDIR) failed\n";
}
$singletest_state{$runnerid} = ST_INITED;
return singletest(@_);
} elsif($singletest_state{$runnerid} == ST_INITED) {
loadtest("${TESTDIR}/test${testnum}");
citest_starttest($testnum);
if(runnerac_test_preprocess($runnerid, $testnum)) {
logmsg "ERROR: runner $runnerid seems to have died\n";
$singletest_state{$runnerid} = ST_INIT;
return (-1, 0);
}
$singletest_state{$runnerid} = ST_PREPROCESS;
} elsif($singletest_state{$runnerid} == ST_PREPROCESS) {
my ($rid, $why, $error, $logs, $testtimings) = runnerar($runnerid);
if(!$rid) {
logmsg "ERROR: runner $runnerid seems to have died\n";
$singletest_state{$runnerid} = ST_INIT;
return (-1, 0);
}
logmsg $logs;
updatetesttimings($testnum, %$testtimings);
if($error == -2) {
if($postmortem) {
displaylogs($rid, $testnum);
}
}
my $logdir = getrunnerlogdir($runnerid);
loadtest("${logdir}/test${testnum}");
$error = singletest_count($testnum, $why);
if($error) {
citest_finishtest($testnum, $error);
$singletest_state{$runnerid} = ST_INIT;
logmsg singletest_dumplogs();
return ($error, 0);
}
my $cmdres;
my $CURLOUT;
my $tool;
my $usedvalgrind;
if(runnerac_test_run($runnerid, $testnum)) {
logmsg "ERROR: runner $runnerid seems to have died\n";
$singletest_state{$runnerid} = ST_INIT;
return (-1, 0);
}
$singletest_state{$runnerid} = ST_RUN;
} elsif($singletest_state{$runnerid} == ST_RUN) {
my ($rid, $error, $logs, $testtimings, $cmdres, $CURLOUT, $tool, $usedvalgrind) = runnerar($runnerid);
if(!$rid) {
logmsg "ERROR: runner $runnerid seems to have died\n";
$singletest_state{$runnerid} = ST_INIT;
return (-1, 0);
}
logmsg $logs;
updatetesttimings($testnum, %$testtimings);
if($error == -1) {
$timevrfyend{$testnum} = Time::HiRes::time();
my $err = ignoreresultcode($testnum);
citest_finishtest($testnum, $err);
$singletest_state{$runnerid} = ST_INIT;
logmsg singletest_dumplogs();
return ($err, 0);
}
elsif($error == -2) {
timestampskippedevents($testnum);
citest_finishtest($testnum, $error);
$singletest_state{$runnerid} = ST_INIT;
logmsg singletest_dumplogs();
return ($error, 0);
}
elsif($error > 0) {
$timevrfyend{$testnum} = Time::HiRes::time();
citest_finishtest($testnum, $error);
$singletest_state{$runnerid} = ST_INIT;
logmsg singletest_dumplogs();
return ($error, 0);
}
my $logdir = getrunnerlogdir($runnerid);
loadtest("${logdir}/test${testnum}");
readtestkeywords();
$error = singletest_check($runnerid, $testnum, $cmdres, $CURLOUT, $tool, $usedvalgrind);
if($error == -1) {
my $err = ignoreresultcode($testnum);
citest_finishtest($testnum, $err);
$singletest_state{$runnerid} = ST_INIT;
logmsg singletest_dumplogs();
return ($err, 0);
}
elsif($error == -2) {
citest_finishtest($testnum, $cmdres);
$singletest_state{$runnerid} = ST_INIT;
logmsg singletest_dumplogs();
return ($cmdres, 0);
}
singletest_success($testnum, $count, $total, ignoreresultcode($testnum));
citest_finishtest($testnum, 0);
$singletest_state{$runnerid} = ST_INIT;
logmsg singletest_dumplogs();
return (0, 0);
}
singletest_unbufferlogs();
return (0, 1);
}
sub runtimestats {
my $lasttest = $_[0];
return if(not $timestats);
logmsg "::group::Run Time Stats\n";
logmsg "\nTest suite total running time breakdown per task...\n\n";
my @timesrvr;
my @timeprep;
my @timetool;
my @timelock;
my @timevrfy;
my @timetest;
my $timesrvrtot = 0.0;
my $timepreptot = 0.0;
my $timetooltot = 0.0;
my $timelocktot = 0.0;
my $timevrfytot = 0.0;
my $timetesttot = 0.0;
my $counter;
for my $testnum (1 .. $lasttest) {
if($timesrvrini{$testnum}) {
$timesrvrtot += $timesrvrend{$testnum} - $timesrvrini{$testnum};
$timepreptot +=
(($timetoolini{$testnum} - $timeprepini{$testnum}) -
($timesrvrend{$testnum} - $timesrvrini{$testnum}));
$timetooltot += $timetoolend{$testnum} - $timetoolini{$testnum};
$timelocktot += $timesrvrlog{$testnum} - $timetoolend{$testnum};
$timevrfytot += $timevrfyend{$testnum} - $timesrvrlog{$testnum};
$timetesttot += $timevrfyend{$testnum} - $timeprepini{$testnum};
push @timesrvr, sprintf("%06.3f %04d",
$timesrvrend{$testnum} - $timesrvrini{$testnum}, $testnum);
push @timeprep, sprintf("%06.3f %04d",
($timetoolini{$testnum} - $timeprepini{$testnum}) -
($timesrvrend{$testnum} - $timesrvrini{$testnum}), $testnum);
push @timetool, sprintf("%06.3f %04d",
$timetoolend{$testnum} - $timetoolini{$testnum}, $testnum);
push @timelock, sprintf("%06.3f %04d",
$timesrvrlog{$testnum} - $timetoolend{$testnum}, $testnum);
push @timevrfy, sprintf("%06.3f %04d",
$timevrfyend{$testnum} - $timesrvrlog{$testnum}, $testnum);
push @timetest, sprintf("%06.3f %04d",
$timevrfyend{$testnum} - $timeprepini{$testnum}, $testnum);
}
}
{
no warnings 'numeric';
@timesrvr = sort { $b <=> $a } @timesrvr;
@timeprep = sort { $b <=> $a } @timeprep;
@timetool = sort { $b <=> $a } @timetool;
@timelock = sort { $b <=> $a } @timelock;
@timevrfy = sort { $b <=> $a } @timevrfy;
@timetest = sort { $b <=> $a } @timetest;
}
logmsg "Spent ". sprintf("%08.3f ", $timesrvrtot) .
"seconds starting and verifying test harness servers.\n";
logmsg "Spent ". sprintf("%08.3f ", $timepreptot) .
"seconds reading definitions and doing test preparations.\n";
logmsg "Spent ". sprintf("%08.3f ", $timetooltot) .
"seconds actually running test tools.\n";
logmsg "Spent ". sprintf("%08.3f ", $timelocktot) .
"seconds awaiting server logs lock removal.\n";
logmsg "Spent ". sprintf("%08.3f ", $timevrfytot) .
"seconds verifying test results.\n";
logmsg "Spent ". sprintf("%08.3f ", $timetesttot) .
"seconds doing all of the above.\n";
$counter = 25;
logmsg "\nTest server starting and verification time per test ".
sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
logmsg "-time- test\n";
logmsg "------ ----\n";
foreach my $txt (@timesrvr) {
last if((not $fullstats) && (not $counter--));
logmsg "$txt\n";
}
$counter = 10;
logmsg "\nTest definition reading and preparation time per test ".
sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
logmsg "-time- test\n";
logmsg "------ ----\n";
foreach my $txt (@timeprep) {
last if((not $fullstats) && (not $counter--));
logmsg "$txt\n";
}
$counter = 25;
logmsg "\nTest tool execution time per test ".
sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
logmsg "-time- test\n";
logmsg "------ ----\n";
foreach my $txt (@timetool) {
last if((not $fullstats) && (not $counter--));
logmsg "$txt\n";
}
$counter = 15;
logmsg "\nTest server logs lock removal time per test ".
sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
logmsg "-time- test\n";
logmsg "------ ----\n";
foreach my $txt (@timelock) {
last if((not $fullstats) && (not $counter--));
logmsg "$txt\n";
}
$counter = 10;
logmsg "\nTest results verification time per test ".
sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
logmsg "-time- test\n";
logmsg "------ ----\n";
foreach my $txt (@timevrfy) {
last if((not $fullstats) && (not $counter--));
logmsg "$txt\n";
}
$counter = 50;
logmsg "\nTotal time per test ".
sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
logmsg "-time- test\n";
logmsg "------ ----\n";
foreach my $txt (@timetest) {
last if((not $fullstats) && (not $counter--));
logmsg "$txt\n";
}
logmsg "\n";
logmsg "::endgroup::\n";
}
sub ignoreresultcode {
my ($testnum)=@_;
if(defined $ignoretestcodes{$testnum}) {
return $ignoretestcodes{$testnum};
}
return 0;
}
sub runnerready {
my ($runnerid)=@_;
push @runnersidle, $runnerid;
}
sub createrunners {
my ($numrunners)=@_;
if(! $numrunners) {
$numrunners++;
}
for my $runnernum (1..$numrunners) {
my $dir = getrunnernumlogdir($runnernum);
cleardir($dir);
mkdir($dir, 0777);
$runnerids{$runnernum} = runner_init($dir, $jobs);
runnerready($runnerids{$runnernum});
}
}
sub pickrunner {
my ($testnum)=@_;
scalar(@runnersidle) || die "No runners available";
return pop @runnersidle;
}
if(@ARGV && $ARGV[-1] eq '$TFLAGS') {
pop @ARGV;
push(@ARGV, split(' ', $ENV{'TFLAGS'})) if defined($ENV{'TFLAGS'});
}
$args = join(' ', @ARGV);
$valgrind = checktestcmd("valgrind");
my $number=0;
my $fromnum=-1;
my @testthis;
while(@ARGV) {
if ($ARGV[0] eq "-v") {
$verbose=1;
}
elsif ($ARGV[0] eq "-c") {
$DBGCURL=$CURL=$ARGV[1];
shift @ARGV;
}
elsif ($ARGV[0] eq "-vc") {
$VCURL=shell_quote($ARGV[1]);
shift @ARGV;
}
elsif ($ARGV[0] eq "-ac") {
$ACURL=shell_quote($ARGV[1]);
shift @ARGV;
}
elsif ($ARGV[0] eq "-d") {
$debugprotocol=1;
}
elsif(($ARGV[0] eq "-e") || ($ARGV[0] eq "--test-event")) {
$run_event_based=1;
}
elsif($ARGV[0] eq "--test-duphandle") {
$run_duphandle=1;
}
elsif($ARGV[0] eq "-f") {
$run_disabled=1;
}
elsif($ARGV[0] eq "-E") {
shift @ARGV;
my $exclude_file = $ARGV[0];
open(my $fd, "<", $exclude_file) or die "Couldn't open '$exclude_file': $!";
while(my $line = <$fd>) {
next if ($line =~ /^#/);
chomp $line;
my ($type, $patterns, $skip_reason) = split(/\s*:\s*/, $line, 3);
die "Unsupported type: $type\n" if($type !~ /^keyword|test|tool$/);
foreach my $pattern (split(/,/, $patterns)) {
if($type eq "test") {
$pattern = int($pattern);
}
$custom_skip_reasons{$type}{$pattern} = $skip_reason;
}
}
close($fd);
}
elsif ($ARGV[0] eq "-g") {
$gdbthis=1;
}
elsif ($ARGV[0] eq "-gl") {
$gdbthis=2;
}
elsif ($ARGV[0] eq "-gw") {
$gdbthis=1;
$gdbxwin=1;
}
elsif($ARGV[0] eq "-s") {
$short=1;
}
elsif($ARGV[0] eq "-am") {
$short=1;
$automakestyle=1;
}
elsif($ARGV[0] eq "-n") {
undef $valgrind;
}
elsif($ARGV[0] eq "--no-debuginfod") {
$no_debuginfod = 1;
}
elsif ($ARGV[0] eq "-R") {
$scrambleorder=1;
}
elsif($ARGV[0] =~ /^-t(.*)/) {
$torture=1;
my $xtra = $1;
if($xtra =~ s/(\d+)$//) {
$tortalloc = $1;
}
}
elsif($ARGV[0] =~ /--shallow=(\d+)/) {
my ($num)=($1);
$shallow=$num;
}
elsif($ARGV[0] =~ /--repeat=(\d+)/) {
$repeat = $1;
}
elsif($ARGV[0] =~ /--retry=(\d+)/) {
$retry = $1;
}
elsif($ARGV[0] =~ /--seed=(\d+)/) {
$randseed = $1;
}
elsif($ARGV[0] eq "-a") {
$anyway=1;
}
elsif($ARGV[0] eq "-o") {
shift @ARGV;
if ($ARGV[0] =~ /^(\w+)=([\w.:\/\[\]-]+)$/) {
my ($variable, $value) = ($1, $2);
eval "\$$variable='$value'" or die "Failed to set \$$variable to $value: $@";
} else {
die "Failed to parse '-o $ARGV[0]'. May contain unexpected characters.\n";
}
}
elsif($ARGV[0] eq "-p") {
$postmortem=1;
}
elsif($ARGV[0] eq "-P") {
shift @ARGV;
$proxy_address=$ARGV[0];
}
elsif($ARGV[0] eq "-L") {
shift @ARGV;
require $ARGV[0];
}
elsif($ARGV[0] eq "-l") {
$listonly=1;
}
elsif($ARGV[0] =~ /^-j(.*)/) {
$jobs=1;
my $xtra = $1;
if($xtra =~ s/(\d+)$//) {
$jobs = $1;
}
}
elsif($ARGV[0] eq "-k") {
$keepoutfiles=1;
}
elsif($ARGV[0] eq "-r") {
if($Time::HiRes::VERSION) {
keys(%timeprepini) = 2000;
keys(%timesrvrini) = 2000;
keys(%timesrvrend) = 2000;
keys(%timetoolini) = 2000;
keys(%timetoolend) = 2000;
keys(%timesrvrlog) = 2000;
keys(%timevrfyend) = 2000;
$timestats=1;
$fullstats=0;
}
}
elsif($ARGV[0] eq "-rf") {
if($Time::HiRes::VERSION) {
keys(%timeprepini) = 2000;
keys(%timesrvrini) = 2000;
keys(%timesrvrend) = 2000;
keys(%timetoolini) = 2000;
keys(%timetoolend) = 2000;
keys(%timesrvrlog) = 2000;
keys(%timevrfyend) = 2000;
$timestats=1;
$fullstats=1;
}
}
elsif($ARGV[0] eq "-u") {
$err_unexpected=1;
}
elsif(($ARGV[0] eq "-h") || ($ARGV[0] eq "--help")) {
print <<"EOHELP"
Usage: runtests.pl [options] [test selection(s)]
-a continue even if a test fails
-ac path use this curl only to talk to APIs (currently only CI test APIs)
-am automake style output PASS/FAIL: [number] [name]
-c path use this curl executable
-d display server debug info
-e, --test-event event-based execution
--test-duphandle duplicate handles before use
-E file load the specified file to exclude certain tests
-f forcibly run even if disabled
-g run the test case with gdb
-gw run the test case with gdb as a windowed application
-h this help text
-j[N] spawn this number of processes to run tests (default 0)
-k keep stdout and stderr files present after tests
-L path require an additional perl library file to replace certain functions
-l list all test case names/descriptions
-n no valgrind
--no-debuginfod disable the valgrind debuginfod functionality
-o variable=value set internal variable to the specified value
-P proxy use the specified proxy
-p print log file contents when a test fails
-R scrambled order (uses the random seed, see --seed)
-r run time statistics
-rf full run time statistics
--repeat=[num] run the given tests this many times
--retry=[num] number of attempts for the whole test run to retry failed tests
-s short output
--seed=[num] set the random seed to a fixed number
--shallow=[num] randomly makes the torture tests "thinner"
-t[N] torture (simulate function failures); N means fail Nth function
-u error instead of warning on server unexpectedly alive
-v verbose output
-vc path use this curl only to verify the existing servers
[num] like "5 6 9" or " 5 to 22 " to run those tests only
[!num] like "!5 !6 !9" to disable those tests
[~num] like "~5 ~6 ~9" to ignore the result of those tests
[keyword] like "IPv6" to select only tests containing the key word
[!keyword] like "!cookies" to disable any tests containing the key word
[~keyword] like "~cookies" to ignore results of tests containing key word
EOHELP
;
exit;
}
elsif($ARGV[0] =~ /^(\d+)/) {
$number = $1;
if($fromnum >= 0) {
for my $n ($fromnum .. $number) {
push @testthis, $n;
}
$fromnum = -1;
}
else {
push @testthis, $1;
}
}
elsif($ARGV[0] =~ /^to$/i) {
$fromnum = $number+1;
}
elsif($ARGV[0] =~ /^!(\d+)/) {
$fromnum = -1;
$disabled{$1}=$1;
}
elsif($ARGV[0] =~ /^~(\d+)/) {
$fromnum = -1;
$ignored{$1}=$1;
}
elsif($ARGV[0] =~ /^!(.+)/) {
$disabled_keywords{lc($1)}=$1;
}
elsif($ARGV[0] =~ /^~(.+)/) {
$ignored_keywords{lc($1)}=$1;
}
elsif($ARGV[0] =~ /^([-[{a-zA-Z].*)/) {
$enabled_keywords{lc($1)}=$1;
}
else {
print "Unknown option: $ARGV[0]\n";
exit;
}
shift @ARGV;
}
if(-e $LIBDIR . "libtests" . exe_ext('TOOL') &&
-e $SRVDIR . "servers" . exe_ext('SRV')) {
$bundle=1;
$ENV{'CURL_TEST_BUNDLES'} = 1;
}
delete $ENV{'DEBUGINFOD_URLS'} if($ENV{'DEBUGINFOD_URLS'} && $no_debuginfod);
if(!$randseed) {
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
localtime(time);
$randseed = ($year+1900)*100 + $mon+1;
print "Using curl: $CURL\n";
open(my $curlvh, "-|", exerunner() . shell_quote($CURL) . " --version 2>$dev_null") ||
die "could not get curl version!";
my @c = <$curlvh>;
close($curlvh) || die "could not get curl version!";
my $str = md5($c[0]);
$randseed += unpack('S', $str);
}
srand $randseed;
if(@testthis && ($testthis[0] ne "")) {
$TESTCASES=join(" ", @testthis);
}
if($valgrind) {
my $code = runclient("valgrind >$dev_null 2>&1");
if(($code>>8) != 1) {
undef $valgrind;
} else {
runclient("valgrind --help 2>&1 | grep -- --tool >$dev_null 2>&1");
if (($? >> 8)) {
$valgrind_tool="";
}
open(my $curlh, "<", "$CURL");
my $l = <$curlh>;
if($l =~ /^\#\!/) {
$valgrind="../libtool --mode=execute $valgrind";
}
close($curlh);
my $ver=join(' ', runclientoutput("valgrind --version"));
$ver =~ s/[^0-9.]//g;
if($ver =~ /^(\d+)/) {
$ver = $1;
if($ver < 3) {
$valgrind_logfile="--logfile";
}
}
}
}
if ($gdbthis) {
open(my $check, "<", "$CURL");
my $c;
sysread $check, $c, 4;
close($check);
if($c eq "#! /") {
$libtool = 1;
$gdb = "../libtool --mode=execute gdb";
}
}
cleardir($LOGDIR);
mkdir($LOGDIR, 0777);
mkdir("$LOGDIR/$LOCKDIR", 0777);
get_disttests();
if(!$jobs) {
setlogfunc(\&logmsg);
}
if(!$listonly) {
checksystemfeatures();
}
if(!$listonly) {
if(open(my $fd, "<", "../buildinfo.txt")) {
while(my $line = <$fd>) {
chomp $line;
if($line && $line !~ /^#/) {
logmsg("* $line\n");
}
}
close($fd);
}
}
initserverconfig();
if(!$listonly) {
displayserverfeatures();
disabledtests("$TESTDIR/DISABLED");
}
sub disabledtests {
my ($file) = @_;
my @input;
if(open(my $disabledh, "<", "$file")) {
while(<$disabledh>) {
if(/^ *\
next;
}
push @input, $_;
}
close($disabledh);
my @pp = prepro(0, @input);
for my $t (@pp) {
if($t =~ /(\d+)/) {
my ($n) = $1;
$disabled{$n}=$n;
if(! -f "$srcdir/data/test$n") {
print STDERR "WARNING! Non-existing test $n in $file!\n";
exit 1;
}
logmsg "DISABLED: test $n\n" if ($verbose);
}
else {
print STDERR "$file: rubbish content: $t\n";
exit 2;
}
}
}
else {
print STDERR "Cannot open $file, exiting\n";
exit 3;
}
}
if ( $TESTCASES eq "all") {
opendir(DIR, $TESTDIR) || die "can't opendir $TESTDIR: $!";
my @cmds = grep { /^test([0-9]+)$/ && -f "$TESTDIR/$_" } readdir(DIR);
closedir(DIR);
$TESTCASES="";
for(@cmds) {
$_ =~ s/[a-z\/\.]*//g;
}
foreach my $n (sort { $a <=> $b } @cmds) {
if($disabled{$n}) {
my $why = "configured as DISABLED";
$skipped{$why}++;
$teststat[$n]=$why;
next;
}
$TESTCASES .= " $n";
}
}
else {
my $verified="";
for(split(" ", $TESTCASES)) {
if (-e "$TESTDIR/test$_") {
$verified.="$_ ";
}
}
if($verified eq "") {
print "No existing test cases were specified\n";
exit;
}
$TESTCASES = $verified;
}
if($repeat) {
my $s;
for(1 .. $repeat) {
$s .= $TESTCASES;
}
$TESTCASES = $s;
}
if($scrambleorder) {
my @rand;
while($TESTCASES) {
my @all = split(/ +/, $TESTCASES);
if(!$all[0]) {
shift @all;
}
my $r = rand @all;
push @rand, $all[$r];
$all[$r]="";
$TESTCASES = join(" ", @all);
}
$TESTCASES = join(" ", @rand);
}
sub displaylogcontent {
my ($file)=@_;
if(open(my $single, "<", "$file")) {
my $linecount = 0;
my $truncate;
my @tail;
while(my $string = <$single>) {
$string =~ s/\r\n/\n/g;
$string =~ s/[\r\f\032]/\n/g;
$string .= "\n" unless ($string =~ /\n$/);
$string =~ tr/\n//;
for my $line (split(m/\n/, $string)) {
$line =~ s/\s*\!$//;
if ($truncate) {
push @tail, " $line\n";
} else {
logmsg " $line\n";
}
$linecount++;
$truncate = $linecount > 1200;
}
}
close($single);
if(@tail) {
my $tailshow = 200;
my $tailskip = 0;
my $tailtotal = scalar @tail;
if($tailtotal > $tailshow) {
$tailskip = $tailtotal - $tailshow;
logmsg "=== File too long: $tailskip lines omitted here\n";
}
for($tailskip .. $tailtotal-1) {
logmsg "$tail[$_]";
}
}
}
}
sub displaylogs {
my ($runnerid, $testnum)=@_;
my $logdir = getrunnerlogdir($runnerid);
opendir(DIR, "$logdir") ||
die "can't open dir: $!";
my @logs = readdir(DIR);
closedir(DIR);
logmsg "== Contents of files in the $logdir/ dir after test $testnum\n";
foreach my $log (sort @logs) {
if($log =~ /\.(\.|)$/) {
next;
}
if($log =~ /^\.nfs/) {
next;
}
if(($log eq "memdump") || ($log eq "core")) {
next;
}
if((-d "$logdir/$log") || (! -s "$logdir/$log")) {
next;
}
if(($log =~ /^stdout\d+/) && ($log !~ /^stdout$testnum/)) {
next;
}
if(($log =~ /^stderr\d+/) && ($log !~ /^stderr$testnum/)) {
next;
}
if(($log =~ /^upload\d+/) && ($log !~ /^upload$testnum/)) {
next;
}
if(($log =~ /^curl\d+\.out/) && ($log !~ /^curl$testnum\.out/)) {
next;
}
if(($log =~ /^test\d+\.txt/) && ($log !~ /^test$testnum\.txt/)) {
next;
}
if(($log =~ /^file\d+\.txt/) && ($log !~ /^file$testnum\.txt/)) {
next;
}
if(($log =~ /^netrc\d+/) && ($log !~ /^netrc$testnum/)) {
next;
}
if(($log =~ /^trace\d+/) && ($log !~ /^trace$testnum/)) {
next;
}
if(($log =~ /^valgrind\d+/) && ($log !~ /^valgrind$testnum(?:\..*)?$/)) {
next;
}
if(($log =~ /^test$testnum$/)) {
next;
}
logmsg "=== Start of file $log\n";
displaylogcontent("$logdir/$log");
logmsg "=== End of file $log\n";
}
}
my $failed;
my $failedign;
my $failedre;
my $ok=0;
my $ign=0;
my $total=0;
my $executed=0;
my $retry_done=0;
my $lasttest=0;
my @at = split(" ", $TESTCASES);
my $count=0;
my $endwaitcnt=0;
$start = time();
my @runtests;
foreach my $testnum (@at) {
$lasttest = $testnum if($testnum > $lasttest);
my ($why, $errorreturncode) = singletest_shouldrun($testnum);
if($why || $listonly) {
my $error = singletest_count($testnum, $why);
next;
}
$ignoretestcodes{$testnum} = $errorreturncode;
push(@runtests, $testnum);
}
my $totaltests = scalar(@runtests);
if($listonly) {
exit(0);
}
citest_starttestrun();
my $numrunners = $jobs < scalar(@runtests) ? $jobs : scalar(@runtests);
createrunners($numrunners);
my $runner_wait_cnt = 0;
my $retry_left;
if($torture) {
$retry_left = 0;
}
else {
$retry_left = $retry;
}
while () {
if($globalabort) {
logmsg singletest_dumplogs();
logmsg "Aborting tests\n";
logmsg "Waiting for " . scalar((keys %runnersrunning)) . " outstanding test(s) to finish...\n";
foreach my $rid (keys %runnersrunning) {
runnerar($rid);
delete $runnersrunning{$rid};
logmsg ".";
$| = 1;
}
logmsg "\n";
last;
}
if(scalar(@runnersidle) && scalar(@runtests)) {
$count++;
my $testnum = shift(@runtests);
my $runnerid = pickrunner($testnum);
$countforrunner{$runnerid} = $count;
my ($error, $again) = singletest($runnerid, $testnum, $countforrunner{$runnerid}, $totaltests);
if($again) {
$runnersrunning{$runnerid} = $testnum;
} else {
runnerready($runnerid);
if($error >= 0) {
die "Internal error: test must not complete on first call";
}
}
}
if(!scalar(%runnersrunning)) {
scalar(@runtests) && die 'Internal error: still have tests to run';
last;
}
my $runnerwait = scalar(@runnersidle) && scalar(@runtests) ? 0 : 1.0;
my (@ridsready, $riderror) = runnerar_ready($runnerwait);
if(@ridsready) {
for my $ridready (@ridsready) {
if($ridready && ! defined $runnersrunning{$ridready}) {
logmsg "ERROR: Runner $ridready is unexpectedly ready; is probably actually dead\n";
$riderror = $ridready;
undef $ridready;
}
if($ridready) {
my $testnum = $runnersrunning{$ridready};
defined $testnum || die "Internal error: test for runner $ridready unknown";
delete $runnersrunning{$ridready};
my ($error, $again) = singletest($ridready, $testnum, $countforrunner{$ridready}, $totaltests);
if($again) {
$runnersrunning{$ridready} = $testnum;
} else {
$runner_wait_cnt = 0;
runnerready($ridready);
if($error < 0) {
next;
}
$total++;
$executed++;
if($error>0) {
if($error==2) {
$failedign .= "$testnum ";
}
else {
if($retry_left > 0) {
$retry_left--;
$retry_done++;
$total--;
push(@runtests, $testnum);
$failedre .= "$testnum ";
}
else {
$failed.= "$testnum ";
}
}
if($postmortem) {
displaylogs($ridready, $testnum);
}
if($error==2) {
$ign++;
}
elsif(!$anyway) {
logmsg "\n - abort tests\n";
undef @runtests;
}
}
elsif(!$error) {
$ok++;
}
}
}
}
}
if(!@ridsready && $runnerwait && !$torture && scalar(%runnersrunning)) {
$runner_wait_cnt++;
if($runner_wait_cnt >= 5) {
my $msg = "waiting for " . scalar(%runnersrunning) . " results:";
my $sep = " ";
foreach my $rid (keys %runnersrunning) {
$msg .= $sep . $runnersrunning{$rid} . "[$rid]";
$sep = ", "
}
logmsg "$msg\n";
}
if($runner_wait_cnt >= 10) {
$runner_wait_cnt = 0;
foreach my $rid (keys %runnersrunning) {
my $testnum = $runnersrunning{$rid};
logmsg "current state of test $testnum in [$rid]:\n";
displaylogs($rid, $testnum);
}
}
}
if($riderror) {
logmsg "ERROR: runner $riderror is dead! aborting test run\n";
delete $runnersrunning{$riderror} if(defined $runnersrunning{$riderror});
$globalabort = 1;
}
if(!scalar(@runtests) && ++$endwaitcnt == (240 + $jobs)) {
logmsg "Hmmm, the tests are taking a while to finish. Here is the status:\n";
catch_usr1();
}
}
my $sofar = time() - $start;
citest_finishtestrun();
foreach my $runnerid (values %runnerids) {
runnerac_stopservers($runnerid);
}
my $unexpected;
foreach my $runnerid (values %runnerids) {
my ($rid, $unexpect, $logs) = runnerar($runnerid);
$unexpected ||= $unexpect;
logmsg $logs;
}
foreach my $runnerid (values %runnerids) {
runnerac_shutdown($runnerid);
sleep 0;
}
my $numskipped = %skipped ? sum values %skipped : 0;
my $all = $total + $numskipped;
runtimestats($lasttest);
if($all) {
logmsg "TESTDONE: $all tests were considered during ".
sprintf("%.0f", $sofar) ." seconds.\n";
}
if(%skipped && !$short) {
my $s=0;
my %restraints;
logmsg "TESTINFO: $numskipped tests were skipped due to these restraints:\n";
for(keys %skipped) {
my $r = $_;
my $skip_count = $skipped{$r};
my $log_line = sprintf("TESTINFO: \"%s\" %d time%s (", $r, $skip_count,
($skip_count == 1) ? "" : "s");
my $c=0;
my $max = 9;
for(0 .. scalar @teststat) {
my $t = $_;
if($teststat[$t] && ($teststat[$t] eq $r)) {
if($c < $max) {
$log_line .= ", " if($c);
$log_line .= $t;
}
$c++;
}
}
if($c > $max) {
$log_line .= " and ".($c-$max)." more";
}
$log_line .= ")\n";
$restraints{$log_line} = $skip_count;
}
foreach my $log_line (sort {$restraints{$b} <=> $restraints{$a} || uc($a) cmp uc($b)} keys %restraints) {
logmsg $log_line;
}
}
sub testnumdetails {
my ($desc, $numlist) = @_;
foreach my $testnum (split(' ', $numlist)) {
if(!loadtest("${TESTDIR}/test${testnum}")) {
my @info_keywords = getpart("info", "keywords");
my $testname = (getpart("client", "name"))[0];
chomp $testname;
logmsg "$desc $testnum: '$testname'";
my $first = 1;
for my $k (@info_keywords) {
chomp $k;
my $sep = ($first == 1) ? " " : ", ";
logmsg "$sep$k";
$first = 0;
}
logmsg "\n";
}
}
}
if($executed) {
if($failedre) {
my $sorted = numsortwords($failedre);
logmsg "::group::Failed Retried Test details\n";
testnumdetails("FAIL-RETRIED", $sorted);
logmsg "RETRIED: failed tests: $sorted\n";
logmsg "::endgroup::\n";
}
if($passedign) {
my $sorted = numsortwords($passedign);
logmsg "::group::Passed Ignored Test details\n";
testnumdetails("PASSED-IGNORED", $sorted);
logmsg "IGNORED: passed tests: $sorted\n";
logmsg "::endgroup::\n";
}
if($failedign) {
my $sorted = numsortwords($failedign);
testnumdetails("FAIL-IGNORED", $sorted);
logmsg "IGNORED: failed tests: $sorted\n";
}
logmsg sprintf("TESTDONE: $ok tests out of $total reported OK: %d%%\n",
$ok/$total*100);
if($failed && ($ok != $total)) {
my $failedsorted = numsortwords($failed);
logmsg "\n";
testnumdetails("FAIL", $failedsorted);
logmsg "\nTESTFAIL: These test cases failed: $failedsorted\n\n";
}
}
else {
logmsg "\nTESTFAIL: No tests were performed\n\n";
if(scalar(keys %enabled_keywords)) {
logmsg "TESTFAIL: Nothing matched these keywords: ";
for(keys %enabled_keywords) {
logmsg "$_ ";
}
logmsg "\n";
}
}
if(($total && (($ok+$ign) != $total)) || !$total || $unexpected) {
exit 1;
}