#!/usr/bin/env perl
#***************************************************************************
#                                  _   _ ____  _
#  Project                     ___| | | |  _ \| |
#                             / __| | | | |_) | |
#                            | (__| |_| |  _ <| |___
#                             \___|\___/|_| \_\_____|
#
# Copyright (C) Daniel Stenberg, <daniel@haxx.se>, et al.
#
# This software is licensed as described in the file COPYING, which
# you should have received as part of this distribution. The terms
# are also available at https://curl.se/docs/copyright.html.
#
# You may opt to use, copy, modify, merge, publish, distribute and/or sell
# copies of the Software, and permit persons to whom the Software is
# furnished to do so, under the terms of the COPYING file.
#
# This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
# KIND, either express or implied.
#
# SPDX-License-Identifier: curl
#
###########################################################################

# For documentation, see docs/runtests.md and README.md.

# Experimental hooks are available to run tests remotely on machines that
# are able to run curl but are unable to run the test harness.
# The following sections need to be modified:
#
#  $HOSTIP, $HOST6IP - Set to the address of the host running the test suite
#  $CLIENTIP, $CLIENT6IP - Set to the address of the host running curl
#  runclient, runclientoutput - Modify to copy all the files in the log/
#    directory to the system running curl, run the given command remotely
#    and save the return code or returned stdout (respectively), then
#    copy all the files from the remote system's log/ directory back to
#    the host running the test suite.  This can be done a few ways, such
#    as using scp & ssh, rsync & telnet, or using a NFS shared directory
#    and ssh.
#
# 'make && make test' needs to be done on both machines before making the
# above changes and running runtests.pl manually.  In the shared NFS case,
# the contents of the tests/server/ directory must be from the host
# running the test suite, while the rest must be from the host running curl.
#
# Note that even with these changes a number of tests still fail (mainly
# to do with cookies, those that set environment variables, or those that
# do more than touch the file system in a <precheck> or <postcheck>
# section). These can be added to the $TESTCASES line below,
# e.g. $TESTCASES="!8 !31 !63 !cookies..."
#
# Finally, to properly support -g and -n, checktestcmd needs to change
# to check the remote system's PATH, and the places in the code where
# the curl binary is read directly to determine its type also need to be
# fixed. As long as the -g option is never given, and the -n is always
# given, this is not a problem.

use strict;
use warnings;
use 5.006;
use POSIX qw(strftime);

# These should be the only variables that might be needed to get edited:

BEGIN {
    # Define srcdir to the location of the tests source directory. This is
    # usually set by the Makefile, but for out-of-tree builds with direct
    # invocation of runtests.pl, it may not be set.
    if(!defined $ENV{'srcdir'}) {
        use File::Basename;
        $ENV{'srcdir'} = dirname(__FILE__);
    }
    push(@INC, $ENV{'srcdir'});
    # run time statistics needs Time::HiRes
    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 POSIX qw(setlocale LC_ALL);

use serverhelp qw(
    server_exe
    );
use pathhelp qw(
    exe_ext
    sys_native_current_path
    shell_quote
    );

use appveyor;
use azure;
use getpart;   # array functions
use servers;
use valgrind;  # valgrind report parser
use globalconfig;
use runner;
use testutil;
use memanalyzer;

my %custom_skip_reasons;

my $ACURL = $VCURL;  # what curl binary to use to talk to APIs (relevant for CI)
                     # ACURL is handy to set to the system one for reliability
my $CURLCONFIG = "../curl-config"; # curl-config from current build

# Normally, all test cases should be run, but at times it is handy to
# run a particular one:
my $TESTCASES = "all";

# To run specific test cases, set them like:
# $TESTCASES = "1 2 3 7 8";

#######################################################################
# No variables below this point should need to be modified
#

my $libtool;
my $repeat = 0;
my $retry = 0;

my $start;          # time at which testing started
my $args;           # command-line arguments

my $uname_release = qx(uname -r);
my $is_wsl = $uname_release =~ /Microsoft$/;

my $http_ipv6;      # set if HTTP server has IPv6 support
my $http_unix;      # set if HTTP server has Unix sockets support
my $ftp_ipv6;       # set if FTP server has IPv6 support

my $resolver;       # name of the resolver backend (for human presentation)

my %skipped;    # skipped{reason}=counter, reasons for skip
my @teststat;   # teststat[testnum]=reason, reasons for skip
my %disabled_keywords;  # key words of tests to skip
my %ignored_keywords;   # key words of tests to ignore results
my %enabled_keywords;   # key words of tests to run
my %disabled;           # disabled test cases
my %ignored;            # ignored results of test cases
my %ignoretestcodes;    # if test results are to be ignored

my @global_strip_stderr;  # global patterns added to stripfile before stderr check
my @global_strip_file;    # global patterns added to stripfile before file check

my $passedign;   # tests passed with results ignored

my $timestats;   # time stamping and stats generation
my $fullstats;   # show time stats for every single test
my %timeprepini; # timestamp for each test preparation start
my %timesrvrini; # timestamp for each test required servers verification start
my %timesrvrend; # timestamp for each test required servers verification end
my %timetoolini; # timestamp for each test command run starting
my %timetoolend; # timestamp for each test command run stopping
my %timesrvrlog; # timestamp for each test server logs lock removal
my %timevrfyend; # timestamp for each test result verification end
my $globalabort; # flag signalling program abort

# values for $singletest_state
use constant {
    ST_INIT => 0,
    ST_INITED => 2,
    ST_PREPROCESS => 3,
    ST_RUN => 4,
};
my %singletest_state;  # current state of singletest() by runner ID
my %singletest_logs;   # log messages while in singletest array ref by runner
my $singletest_bufferedrunner; # runner ID which is buffering logs
my %runnerids;         # runner IDs by number
my @runnersidle;       # runner IDs idle and ready to execute a test
my %countforrunner;    # test count by runner ID
my %runnersrunning;    # tests currently running by runner ID

#######################################################################
# variables that command line options may set
#
my $short;
my $no_debuginfod;
my $postmortem;   # display detailed info about failed tests
my $run_disabled; # run the specific tests even if listed in DISABLED
my $scrambleorder;
my $jobs = 0;

# Azure Pipelines specific variables
my $AZURE_RUN_ID = 0;
my $AZURE_RESULT_ID = 0;

#######################################################################
# logmsg is our general message logging subroutine.
#
sub logmsg {
    if($singletest_bufferedrunner) {
        # Logs are currently being buffered
        return singletest_logmsg(@_);
    }
    for(@_) {
        my $line = $_;
        if(!$line) {
            next;
        }
        if($is_wsl) {
            # use \r\n for WSL shell
            $line =~ s/\r?\n$/\r\n/g;
        }
        print $line;
    }
}

#######################################################################
# enable logmsg buffering for the given runner ID
#
sub logmsg_bufferfortest {
    my ($runnerid) = @_;
    if($jobs) {
        # Only enable buffering in multiprocess mode
        $singletest_bufferedrunner = $runnerid;
    }
}

#######################################################################
# Store a log message in a buffer for this test
# The messages can then be displayed all at once at the end of the test
# which prevents messages from different tests from being interleaved.
sub singletest_logmsg {
    if(!exists $singletest_logs{$singletest_bufferedrunner}) {
        # initialize to a reference to an empty anonymous array
        $singletest_logs{$singletest_bufferedrunner} = [];
    }
    my $logsref = $singletest_logs{$singletest_bufferedrunner};
    push @$logsref, @_;
}

#######################################################################
# Stop buffering log messages, but do not touch them
sub singletest_unbufferlogs {
    undef $singletest_bufferedrunner;
}

#######################################################################
# Clear the buffered log messages & stop buffering after returning them
sub singletest_dumplogs {
    if(!defined $singletest_bufferedrunner) {
        # probably not multiprocess mode and logs were not buffered
        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 {
    # some msys2 perl versions do not define SIGUSR1
    $SIG{USR1} = \&catch_usr1;
};
$SIG{PIPE} = 'IGNORE';  # these errors are captured in the read/write calls

##########################################################################
# Clear all possible '*_proxy' environment variables for various protocols
# to prevent them to interfere with our testing!

foreach my $protocol (('ftp', 'http', 'ftps', 'https', 'no', 'all')) {
    my $proxy = "${protocol}_proxy";
    # clear lowercase version
    delete $ENV{$proxy} if($ENV{$proxy});
    # clear uppercase version
    delete $ENV{uc($proxy)} if($ENV{uc($proxy)});
}

# make sure we do not get affected by other variables that control our
# behavior

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'});

# provide defaults from our config file for ENV vars not explicitly
# set by the caller
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);
}

# Check if we have nghttpx available and if it talks http/3
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(' ', qx($cmd));
    $nghttpx_h3 = $nghttpx_version =~ /nghttp3\//;
    chomp $nghttpx_h3;
}

#######################################################################
# Get the list of tests that the tests/data/Makefile.am knows about!
#
my $disttests = "";
sub get_disttests {
    # If a non-default $TESTDIR is being used there may not be any
    # Makefile.am in which case there is nothing to do.
    open(my $dh, "<", "$TESTDIR/Makefile.am") or return;
    while(<$dh>) {
        chomp $_;
        if(($_ =~ /^#/) ||($_ !~ /test/)) {
            next;
        }
        $disttests .= $_;
    }
    close($dh);
}

#######################################################################
# Remove all files in the specified directory
#
sub cleardir {
    my $dir = $_[0];
    my $done = 1;  # success
    my $file;

    # Get all files
    opendir(my $dh, $dir) or return 0; # cannot open dir
    while($file = readdir($dh)) {
        # Do not clear the $PIDDIR or $LOCKDIR since those need to live beyond
        # one test
        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 {
                # Ignore stunnel since we cannot do anything about its locks
                if(!unlink("$dir/$file") && $file !~ /_stunnel\.log$/) {
                    $done = 0;
                }
            }
        }
    }
    closedir $dh;
    return $done;
}

#######################################################################
# Given two array references, this function stores them in two temporary
# files, run 'diff' on them, store the result and return the diff output!
sub showdiff {
    my ($logdir, $firstref, $secondref) = @_;

    my $file1 = "$logdir/check-generated";
    my $file2 = "$logdir/check-expected";

    open(my $temp, ">", $file1) or 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) or die "Failure writing diff file";

    open($temp, ">", $file2) or 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) or die "Failure writing diff file";
    my @out = qx(diff -u $file2 $file1 2>$dev_null);

    if(!$out[0]) {
        @out = qx(diff -c $file2 $file1 2>$dev_null);
        if(!$out[0]) {
            logmsg "Failed to show diff. The diff tool may be missing.\n";
        }
    }

    return @out;
}

#######################################################################
# compare test results with the expected output, we might filter off
# some pattern that is allowed to differ, output test results
#
sub compare {
    my ($runnerid, $testnum, $testname, $subject, $firstref, $secondref) = @_;

    my $result = compareparts($firstref, $secondref);

    if($result) {
        # timestamp test result verification end
        $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 {
            # automakestyle
            logmsg "FAIL: $testnum - $testname - $subject\n";
        }
    }
    return $result;
}

#######################################################################
# Numeric-sort words in a string
sub numsortwords {
    my ($string) = @_;
    return join(' ', sort { $a <=> $b } split(' ', $string));
}

#######################################################################
# Parse and store the protocols in curl's Protocols: line
sub parseprotocols {
    my ($line) = @_;

    @protocols = split(' ', lc($line));

    # Generate a "proto-ipv6" version of each protocol to match the
    # IPv6 <server> name and a "proto-unix" to match the variant which
    # uses Unix domain sockets. This works even if support is not
    # compiled in because the <features> test fails.
    push @protocols, map(("$_-ipv6", "$_-unix"), @protocols);

    # 'http-proxy' is used in test cases to do CONNECT through
    push @protocols, 'http-proxy';

    # 'https-mtls' is used for client certificate auth testing
    push @protocols, 'https-mtls';

    # 'none' is used in test cases to mean no server
    push @protocols, 'none';
}

#######################################################################
# Check if the operating environment supports UTF-8.
sub is_utf8_supported {
    my $result;
    my $old_LC_ALL;
    my $was_defined = defined $ENV{'LC_ALL'};
    if($was_defined) {
        $old_LC_ALL = $ENV{'LC_ALL'};
    }
    setlocale(LC_ALL, $ENV{'LC_ALL'} = "C.UTF-8");
    $result = lc(langinfo(CODESET())) eq "utf-8";
    if($was_defined) {
        $ENV{'LC_ALL'} = $old_LC_ALL;
    }
    else {
        delete $ENV{'LC_ALL'};
    }
    return $result;
}

#######################################################################
# Check & display information about curl and the host the test suite runs on.
# Information to do with servers is displayed in displayserverfeatures, after
# the server initialization is performed.
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/; # leading digits and dots
            $curl =~ s/^(.*)(libcurl.*)/$1/g or die "Failure determining curl binary version";

            $libcurl = $2;
            if($curl =~ /win32|Windows|windows|mingw(32|64)/) {
                # This is a Windows MinGW build or native build, we need to use
                # Windows-style path.
                $pwd = sys_native_current_path();
                $feature{"win32"} = 1;
            }
            if($curl =~ /cygwin|msys/i) {
                $feature{"cygwin"} = 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 =~ /\s(AWS-LC|BoringSSL)\b/i) {
                # OpenSSL compatible API
                $feature{"OpenSSL"} = 1;
                $feature{"SSLpinning"} = 1;
            }
            elsif($libcurl =~ /\slibressl\b/i) {
                # OpenSSL compatible API
                $feature{"OpenSSL"} = 1;
                $feature{"SSLpinning"} = 1;
            }
            elsif($libcurl =~ /\squictls\b/i) {
                # OpenSSL compatible API
                $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) {
                # nghttp2 supports h2c
                $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;
                $feature{"sshkeyalgo"} = ($ENV{'CURL_TEST_SSH_KEYALGO'} and
                    $ENV{'CURL_TEST_SSH_KEYALGO'} =~ /^(?:rsa|ecdsa|ed25519)$/) ? $ENV{'CURL_TEST_SSH_KEYALGO'} : 'rsa';
            }
            if($libcurl =~ /libssh\/([0-9.]*)\//i) {
                $feature{"libssh"} = 1;
                $feature{"sshkeyalgo"} = ($ENV{'CURL_TEST_SSH_KEYALGO'} and
                    $ENV{'CURL_TEST_SSH_KEYALGO'} =~ /^(?:rsa|ecdsa|ed25519)$/) ? $ENV{'CURL_TEST_SSH_KEYALGO'} : 'rsa';
                # Detect simple cases of default libssh configuration files ending up
                # setting 'StrictHostKeyChecking no'. include files, quoted values,
                # '=value' format not implemented.
                $feature{"badlibssh"} = 0;
                foreach my $libssh_configfile (('/etc/ssh/ssh_config', $ENV{'HOME'} . '/.ssh/config')) {
                    if(open(my $fd, '<', $libssh_configfile)) {
                        while(my $line = <$fd>) {
                            chomp $line;
                            if($line =~ /^\s*StrictHostKeyChecking\s+(yes|no)\s*$/) {
                                $feature{"badlibssh"} = ($1 eq 'no' ? 1 : 0);
                                last;  # Do as openssh and libssh
                            }
                        }
                        close($fd);
                    }
                }
            }
        }
        elsif($_ =~ /^Protocols: (.*)/i) {
            $proto = $1;
            # these are the protocols compiled in to this libcurl
            parseprotocols($proto);
        }
        elsif($_ =~ /^Features: (.*)/i) {
            $feat = $1;

            # built with memory tracking support (--enable-debug); may be disabled later
            $feature{"TrackMemory"} = $feat =~ /\bDebug/;
            # curl was built with --enable-debug
            $feature{"Debug"} = $feat =~ /\bDebug/;
            # SSL enabled
            $feature{"SSL"} = $feat =~ /SSL/i;
            # multiple SSL backends available.
            $feature{"MultiSSL"} = $feat =~ /MultiSSL/i;
            # embedded CA certificate bundle
            $feature{"CAcert"} = $feat =~ /CAcert/i;
            # large file support
            $feature{"Largefile"} = $feat =~ /Largefile/i;
            # IDN support
            $feature{"IDN"} = $feat =~ /IDN/i;
            # IPv6 support
            $feature{"IPv6"} = $feat =~ /IPv6/i;
            # Unix sockets support
            $feature{"UnixSockets"} = $feat =~ /UnixSockets/i;
            # libz compression
            $feature{"libz"} = $feat =~ /libz/i;
            # Brotli compression
            $feature{"brotli"} = $feat =~ /brotli/i;
            # Zstd compression
            $feature{"zstd"} = $feat =~ /zstd/i;
            # NTLM enabled
            $feature{"NTLM"} = $feat =~ /NTLM/i;
            # NTLM delegation to winbind daemon ntlm_auth helper enabled
            $feature{"NTLM_WB"} = $feat =~ /NTLM_WB/i;
            # SSPI enabled
            $feature{"SSPI"} = $feat =~ /SSPI/i;
            # GSS-API enabled
            $feature{"GSS-API"} = $feat =~ /GSS-API/i;
            # Kerberos enabled
            $feature{"Kerberos"} = $feat =~ /Kerberos/i;
            # SPNEGO enabled
            $feature{"SPNEGO"} = $feat =~ /SPNEGO/i;
            # TLS-SRP enabled
            $feature{"TLS-SRP"} = $feat =~ /TLS-SRP/i;
            # PSL enabled
            $feature{"PSL"} = $feat =~ /PSL/i;
            # alt-svc enabled
            $feature{"alt-svc"} = $feat =~ /alt-svc/i;
            # HSTS support
            $feature{"HSTS"} = $feat =~ /HSTS/i;
            $feature{"asyn-rr"} = $feat =~ /asyn-rr/;
            if($feat =~ /AsynchDNS/i) {
                if(!$feature{"c-ares"} || $feature{"asyn-rr"}) {
                    # this means threaded resolver
                    $feature{"threaded-resolver"} = 1;
                    $resolver = "threaded";

                    # does not count as "real" c-ares
                    $feature{"c-ares"} = 0;
                }
            }
            # http2 enabled
            $feature{"http/2"} = $feat =~ /HTTP2/;
            if($feature{"http/2"}) {
                push @protocols, 'http/2';
            }
            # http3 enabled
            $feature{"http/3"} = $feat =~ /HTTP3/;
            if($feature{"http/3"}) {
                push @protocols, 'http/3';
            }
            # https proxy support
            $feature{"HTTPS-proxy"} = $feat =~ /HTTPS-proxy/;
            if($feature{"HTTPS-proxy"}) {
                # 'https-proxy' is used as "server" so consider it a protocol
                push @protocols, 'https-proxy';
            }
            # Unicode support
            $feature{"Unicode"} = $feat =~ /Unicode/i;
            # Thread-safe init
            $feature{"threadsafe"} = $feat =~ /threadsafe/i;
            $feature{"HTTPSRR"} = $feat =~ /HTTPSRR/;
            $feature{"ECH"} = $feat =~ /ECH/;
        }
        #
        # Test harness currently uses a non-stunnel server in order to
        # run HTTP TLS-SRP tests required when curl is built with https
        # protocol support and TLS-SRP feature enabled. For convenience
        # 'httptls' may be included in the test harness protocols array
        # to differentiate this from classic stunnel based 'https' test
        # harness server.
        #
        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($torture) {
        $feature{"torture"} = 1;
    }

    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 "Could not get curl's version";
    }

    if(-r "../lib/curl_config.h") {
        open(my $conf, "<", "../lib/curl_config.h");
        while(<$conf>) {
            if($_ =~ /^\#define HAVE_GETRLIMIT/) {
                # set if system has getrlimit()
                $feature{"getrlimit"} = 1;
            }
        }
        close($conf);
    }

    if($feature{"IPv6"}) {
        # client has IPv6 support

        # check if the HTTP server has it!
        my $cmd = server_exe('sws')." --version";
        my @sws = qx($cmd);
        if($sws[0] =~ /IPv6/) {
            # HTTP server has IPv6 support!
            $http_ipv6 = 1;
        }

        # check if the FTP server has it!
        $cmd = server_exe('sockfilt')." --version";
        @sws = qx($cmd);
        if($sws[0] =~ /IPv6/) {
            # FTP server has IPv6 support!
            $ftp_ipv6 = 1;
        }
    }

    if($feature{"UnixSockets"}) {
        # client has Unix sockets support, check whether the HTTP server has it
        my $cmd = server_exe('sws')." --version";
        my @sws = qx($cmd);
        $http_unix = 1 if($sws[0] =~ /unix/);
    }

    # strip line from stderr and file output to not confuse tests
    if($feature{"CAcert"}) {
        my $strip_cacert = 's/^Note: Using embedded CA bundle.*\n//';
        push @global_strip_stderr, $strip_cacert;
        push @global_strip_file, $strip_cacert;
    }

    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;

    # Use this as a proxy for any cryptographic authentication
    $feature{"crypto"} = $feature{"NTLM"} || $feature{"Kerberos"} || $feature{"SPNEGO"};
    $feature{"local-http"} = servers::localhttp();
    $feature{"codeset-utf8"} = is_utf8_supported();
    if($feature{"codeset-utf8"}) {
        $ENV{'CURL_TEST_HAVE_CODESET_UTF8'} = 1;
    }

    # make each protocol an enabled "feature"
    for my $p (@protocols) {
        $feature{$p} = 1;
    }
    # 'socks' was once here but is now removed

    if($torture && !$feature{"TrackMemory"}) {
        die "cannot run torture tests since curl was built without ".
            "TrackMemory feature (--enable-debug)";
    }

    my $hostname = join(' ', runclientoutput("hostname"));
    chomp $hostname;
    my $hosttype = join(' ', runclientoutput("uname -a"));
    chomp $hosttype;
    my $hostos = $^O;

    # display summary information about curl and the test host
    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",
           "* Args: $args\n");
    if($jobs) {
        # Only show if not the default for now
        logmsg "* Jobs: $jobs\n";
    }

    my $env = sprintf("%s%s%s%s%s",
                      $valgrind ? "Valgrind " : "",
                      $run_duphandle ? "test-duphandle " : "",
                      $run_event_based ? "event-based " : "",
                      $nghttpx_h3 ? "nghttpx-h3 " : "",
                      $libtool ? "Libtool " : "");
    if($env) {
        logmsg "* Env: $env\n";
    }
    logmsg "* Seed: $randseed\n";
    if(system("diff $TESTDIR/DISABLED $TESTDIR/DISABLED 2>$dev_null") != 0) {
        logmsg "* diff: missing\n";
    }
    if($mintotal) {
        logmsg "* Min tests: $mintotal\n";
    }
}

#######################################################################
# display information about server features
#
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";
}

#######################################################################
# Provide time stamps for single test skipped events
#
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};
        }
    }
}

# Setup CI Test Run
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);
    }
    # Appveyor does not require anything here
}

# Register the test case with the CI runner
sub citest_starttest {
    my $testnum = $_[0];

    # get the name of the test early
    my $testname = (getpart("client", "name"))[0];
    chomp $testname;

    # create test result in CI services
    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);
    }
}

# Submit the test case result with the CI runner
sub citest_finishtest {
    my ($testnum, $error) = @_;
    # update test result in CI services
    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});
    }
}

# Complete CI test run
sub citest_finishtestrun {
    if(azure_check_environment() && $AZURE_RUN_ID) {
        $AZURE_RUN_ID = azure_update_test_run($ACURL, $AZURE_RUN_ID);
    }
    # Appveyor does not require anything here
}

# add one set of test timings from the runner to global set
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"};
    }
}

#######################################################################
# Return the log directory for the given test runner
sub getrunnernumlogdir {
    my $runnernum = $_[0];
    return $jobs > 1 ? "$LOGDIR/$runnernum" : $LOGDIR;
}

#######################################################################
# Return the log directory for the given test runner ID
sub getrunnerlogdir {
    my $runnerid = $_[0];
    if($jobs <= 1) {
        return $LOGDIR;
    }
    # TODO: speed up this O(n) operation
    for my $runnernum (keys %runnerids) {
        if($runnerid eq $runnerids{$runnernum}) {
            return "$LOGDIR/$runnernum";
        }
    }
    die "Internal error: runner ID $runnerid not found";
}

#######################################################################
# Verify that this test case should be run
sub singletest_shouldrun {
    my $testnum = $_[0];
    my $why;   # why the test is not run
    my $errorreturncode = 1; # 1 means normal error, 2 means ignored error
    my @what;  # what features are needed

    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}", 1)) {
        if($verbose) {
            # this is not a test
            logmsg "RUN: $testnum does not look like a test case\n";
        }
        $why = "no test";
    }
    else {
        @what = getpart("client", "features");
    }

    # We require a feature to be present
    for(@what) {
        my $f = $_;
        $f =~ s/\s//g;

        if($f =~ /^([^!].*)$/) {
            if($feature{$1}) {
                next;
            }

            $why = "curl lacks $1 support";
            last;
        }
    }

    # We require a feature to not be present
    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!";
        }
        # Only evaluate keywords if the section is present.
        else {
            # Prefix features with "feat:" and add to keywords list.
            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};
                }
            }
        }
    }

    if($why && checktest("${TESTDIR}/test${testnum}")) {
        logmsg "Warning: issue(s) found in test data: ${TESTDIR}/test${testnum}\n";
    }

    return ($why, $errorreturncode);
}

my %allnames;

#######################################################################
# Print the test name and count tests
sub singletest_count {
    my ($testnum, $why) = @_;

    if($why && !$listonly) {
        # there is a problem, count it as "skipped"
        $skipped{$why}++;
        $teststat[$testnum] = $why; # store reason for this test case

        if(!$short) {
            if($skipped{$why} <= 3) {
                # show only the first three skips for each reason
                logmsg sprintf("test %04d SKIPPED: $why\n", $testnum);
            }
        }

        timestampskippedevents($testnum);
        return -1;
    }

    # At this point we have committed to run this test
    logmsg sprintf("test %04d...", $testnum) if(!$automakestyle);

    # name of the test
    my $testname = (getpart("client", "name"))[0];
    chomp $testname;
    logmsg "[$testname]\n" if(!$short);

    if($listonly) {
        timestampskippedevents($testnum);
    }
    else {
        if(exists $allnames{$testname} &&
           ($allnames{$testname} != $testnum)) {
            logmsg sprintf("ERROR: test %d has duplicate test name: \"%s\". ".
                           "The same as test %d\n", $testnum,
                           $testname, $allnames{$testname});
            exit 1;
        }
        # store which test that uses this name
        $allnames{$testname} = $testnum;
    }
    return 0;
}

# Make sure all line endings in the array are the same: CRLF
sub normalize_text {
    my ($ref) = @_;
    s/\r\n/\n/g for @$ref;
    s/\n/\r\n/g for @$ref;
}

#######################################################################
# Verify test succeeded
sub singletest_check {
    my ($runnerid, $testnum, $cmdres, $CURLOUT, $tool, $usedvalgrind) = @_;

    # Skip all the verification on torture tests
    if($torture) {
        # timestamp test result verification end
        $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;

    # what parts to cut off from stdout/stderr
    my @stripfile = getpart("verify", "stripfile");

    my @validstdout = getpart("verify", "stdout");
    # get all attributes
    my %hash = getpartattr("verify", "stdout");

    my $loadfile = $hash{'loadfile'};
    if($loadfile) {
        open(my $tmp, "<", $loadfile) or die "Cannot open file $loadfile: $!";
        @validstdout = <$tmp>;
        close($tmp);

        # Enforce LF newlines on load
        s/\r\n/\n/g for @validstdout;
    }

    if(@validstdout) {
        $validstdout[0] =~ s/^%EMPTY[\r\n]*//;

        # verify redirected stdout
        my @actual = loadarray(stdoutfilename($logdir, $testnum));

        foreach my $strip (@stripfile) {
            chomp $strip;
            my @newgen;
            for(@actual) {
                eval $strip;
                if($_) {
                    push @newgen, $_;
                }
            }
            # this is to get rid of array entries that vanished (zero
            # length) because of replacements
            @actual = @newgen;
        }

        # get the mode attribute
        my $filemode = $hash{'mode'};
        if($filemode && ($filemode eq "text")) {
            normalize_text(\@validstdout);
            normalize_text(\@actual);
        }

        if($hash{'nonewline'}) {
            # Yes, we must cut off the final newline from the final line
            # of the protocol data
            chomp($validstdout[-1]);
        }

        if($hash{'crlf'}) {
            if($hash{'crlf'} eq "headers") {
                subnewlines(0, \$_) for @validstdout;
            }
            else {
                subnewlines(1, \$_) for @validstdout;
            }
        }

        $res = compare($runnerid, $testnum, $testname, "stdout", \@actual, \@validstdout);
        if($res) {
            return -1;
        }
        $ok .= "s";
    }
    else {
        $ok .= "-"; # stdout not checked
    }

    my @validstderr = getpart("verify", "stderr");
    if(@validstderr) {
        # verify redirected stderr
        my @actual = loadarray(stderrfilename($logdir, $testnum));

        foreach my $strip (@global_strip_stderr, @stripfile) {
            chomp $strip;
            my @newgen;
            for(@actual) {
                eval $strip;
                if($_) {
                    push @newgen, $_;
                }
            }
            # this is to get rid of array entries that vanished (zero
            # length) because of replacements
            @actual = @newgen;
        }

        # get all attributes
        my %hash = getpartattr("verify", "stderr");

        # get the mode attribute
        my $filemode = $hash{'mode'};
        if($filemode && ($filemode eq "text")) {
            normalize_text(\@validstderr);
            normalize_text(\@actual);
        }
        if($filemode && ($filemode eq "warn")) {
            for(@validstderr) {
                s/Warning: //;
                s/\r//;
                s/\n/ /;
            }
            for(@actual) {
                s/Warning: //;
                s/\r//;
                s/\n/ /;
            }
            my $v = join(@validstderr, "");
            my $a = join(@actual, "");
            @validstderr = $v;
            @actual = $a;
        }

        if($hash{'nonewline'}) {
            # Yes, we must cut off the final newline from the final line
            # of the protocol data
            chomp($validstderr[-1]);
        }

        if($hash{'crlf'}) {
            if($hash{'crlf'} eq "headers") {
                subnewlines(0, \$_) for @validstderr;
            }
            else {
                subnewlines(1, \$_) for @validstderr;
            }
        }

        $res = compare($runnerid, $testnum, $testname, "stderr", \@actual, \@validstderr);
        if($res) {
            return -1;
        }
        $ok .= "r";
    }
    else {
        $ok .= "-"; # stderr not checked
    }

    # what to cut off from the live protocol sent by curl
    my @strip = getpart("verify", "strip");

    # what parts to cut off from the protocol & upload
    my @strippart = getpart("verify", "strippart");

    # this is the valid protocol blurb curl should generate
    my @protocol = getpart("verify", "protocol");
    if(@protocol) {
        # Verify the sent request
        my @out = loadarray("$logdir/$SERVERIN");

        # check if there is any attributes on the verify/protocol section
        my %hash = getpartattr("verify", "protocol");

        if($hash{'nonewline'}) {
            # Yes, we must cut off the final newline from the final line
            # of the protocol data
            chomp($protocol[-1]);
        }

        for(@strip) {
            # strip off all lines that match the patterns from both arrays
            chomp $_;
            @out = striparray( $_, \@out);
            @protocol = striparray( $_, \@protocol);
        }

        for my $strip (@strippart) {
            chomp $strip;
            for(@out) {
                eval $strip;
            }
        }

        if($hash{'crlf'}) {
            if($hash{'crlf'} eq "headers") {
                subnewlines(0, \$_) for @protocol;
            }
            else {
                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";
            # timestamp test result verification end
            $timevrfyend{$testnum} = Time::HiRes::time();
            return -1;
        }

        $res = compare($runnerid, $testnum, $testname, "protocol", \@out, \@protocol);
        if($res) {
            return -1;
        }

        $ok .= "p";
    }
    else {
        $ok .= "-"; # protocol not checked
    }

    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);
                # get the mode attribute
                my $filemode = $replycheckpartattr{'mode'};
                if($filemode && ($filemode eq "text")) {
                    normalize_text(\@replycheckpart);
                }
                if($replycheckpartattr{'nonewline'}) {
                    # Yes, we must cut off the final newline from the final line
                    # of the datacheck
                    chomp($replycheckpart[-1]);
                }
                if($replycheckpartattr{'crlf'}) {
                    if($replycheckpartattr{'crlf'} eq "headers") {
                        subnewlines(0, \$_) for @replycheckpart;
                    }
                    else {
                        subnewlines(1, \$_) for @replycheckpart;
                    }
                }
                push(@reply, @replycheckpart);
            }
        }
    }
    else {
        # check against the data section
        @reply = getpart("reply", "data");
        if(@reply) {
            if($replyattr{'nonewline'}) {
                # cut off the final newline from the final line of the data
                chomp($reply[-1]);
            }
        }
        # get the mode attribute
        my $filemode = $replyattr{'mode'};
        if($filemode && ($filemode eq "text")) {
            normalize_text(\@reply);
        }
        if($replyattr{'crlf'}) {
            if($replyattr{'crlf'} eq "headers") {
                subnewlines(0, \$_) for @reply;
            }
            else {
                subnewlines(1, \$_) for @reply;
            }
        }
    }

    if(!$replyattr{'nocheck'} && (@reply || $replyattr{'sendzero'})) {
        # verify the received data
        my @out = loadarray($CURLOUT);

        # get the mode attribute
        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 .= "-"; # data not checked
    }

    # if this section exists, we verify upload
    my @upload = getpart("verify", "upload");
    if(@upload) {
        my %hash = getpartattr("verify", "upload");
        if($hash{'nonewline'}) {
            # cut off the final newline from the final line of the upload data
            chomp($upload[-1]);
        }
        for my $line (@upload) {
            subbase64(\$line);
            subsha256base64file(\$line);
            substrippemfile(\$line);
        }

        # verify uploaded data
        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'}) {
            # Yes, we must cut off the final newline from the final line
            # of the upload data
            chomp($upload[-1]);
        }

        $res = compare($runnerid, $testnum, $testname, "upload", \@out, \@upload);
        if($res) {
            return -1;
        }
        $ok .= "u";
    }
    else {
        $ok .= "-"; # upload not checked
    }

    # this is the valid protocol blurb curl should generate to a proxy
    my @proxyprot = getpart("verify", "proxy");
    if(@proxyprot) {
        # Verify the sent proxy request
        # check if there is any attributes on the verify/protocol section
        my %hash = getpartattr("verify", "proxy");

        if($hash{'nonewline'}) {
            # Yes, we must cut off the final newline from the final line
            # of the protocol data
            chomp($proxyprot[-1]);
        }

        my @out = loadarray("$logdir/$PROXYIN");
        for(@strip) {
            # strip off all lines that match the patterns from both arrays
            chomp $_;
            @out = striparray( $_, \@out);
            @proxyprot = striparray( $_, \@proxyprot);
        }

        for my $strip (@strippart) {
            chomp $strip;
            for(@out) {
                eval $strip;
            }
        }

        if($hash{'crlf'}) {
            if($hash{'crlf'} eq "headers") {
                subnewlines(0, \$_) for @proxyprot;
            }
            else {
                subnewlines(1, \$_) for @proxyprot;
            }
        }

        $res = compare($runnerid, $testnum, $testname, "proxy", \@out, \@proxyprot);
        if($res) {
            return -1;
        }

        $ok .= "P";
    }
    else {
        $ok .= "-"; # proxy not checked
    }

    my $outputok;
    for my $partsuffix (('', '1', '2', '3', '4')) {
        my @outfile = getpart("verify", "file".$partsuffix);
        if(@outfile || partexists("verify", "file".$partsuffix) ) {
            # we are supposed to verify a dynamically generated file!
            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 {

                    # TODO: this is a blocking call that stalls the controller,
                    if($verbose) {
                        logmsg "WARNING: blocking call in async function\n";
                    }
                    # but this error condition should never happen except during
                    # development.
                    my ($rid, $unexpected, $logs) = runnerar($runnerid);
                    if(!$rid) {
                        logmsg "ERROR: runner $runnerid seems to have died\n";
                    } else {
                        logmsg $logs;
                    }
                }
                # timestamp test result verification end
                $timevrfyend{$testnum} = Time::HiRes::time();
                return -1;
            }
            my @generated = loadarray($filename);

            # what parts to cut off from the file
            my @stripfilepar = getpart("verify", "stripfile".$partsuffix);

            my $filemode = $hash{'mode'};
            if($filemode && ($filemode eq "text")) {
                normalize_text(\@outfile);
                normalize_text(\@generated);
            }
            if($hash{'crlf'}) {
                if($hash{'crlf'} eq "headers") {
                    subnewlines(0, \$_) for @outfile;
                }
                else {
                    subnewlines(1, \$_) for @outfile;
                }
            }

            for my $strip (@global_strip_file, @stripfilepar) {
                chomp $strip;
                my @newgen;
                for(@generated) {
                    eval $strip;
                    if($_) {
                        push @newgen, $_;
                    }
                }
                # this is to get rid of array entries that vanished (zero
                # length) because of replacements
                @generated = @newgen;
            }

            if($hash{'nonewline'}) {
                # cut off the final newline from the final line of the
                # output data
                chomp($outfile[-1]);
            }

            $res = compare($runnerid, $testnum, $testname, "output ($filename)",
                           \@generated, \@outfile);
            if($res) {
                return -1;
            }

            $outputok = 1; # output checked
        }
    }
    $ok .= ($outputok) ? "o" : "-"; # output checked or not

    # verify SOCKS proxy details
    my @socksprot = getpart("verify", "socks");
    if(@socksprot) {
        # Verify the sent SOCKS proxy details
        my @out = loadarray("$logdir/$SOCKSIN");
        $res = compare($runnerid, $testnum, $testname, "socks", \@out, \@socksprot);
        if($res) {
            return -1;
        }
    }

    my @dnsd = getpart("verify", "dns");
    if(@dnsd) {
        # we are supposed to verify a dynamically generated file!
        my %hash = getpartattr("verify", "dns");
        my $hostname = $hash{'host'};

        # Verify the sent DNS requests
        my @out = loadarray("$logdir/dnsd.input");
        my @sverify = sort @dnsd;
        my @sout = sort @out;

        if($hostname) {
            # when a hostname is set, we filter out requests to this pattern
            @sout = grep {/$hostname/} @sout;
        }

        $res = compare($runnerid, $testnum, $testname, "DNS", \@sout, \@sverify);
        if($res) {
            return -1;
        }
    }

    # accept multiple comma-separated error codes
    my @splerr = split(/ *, */, $errorcode);
    my $errok;
    foreach my $e (@splerr) {
        if($e == $cmdres) {
            # a fine error code
            $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";
        # timestamp test result verification end
        $timevrfyend{$testnum} = Time::HiRes::time();
        return -1;
    }

    if($feature{"TrackMemory"}) {
        if(! -f "$logdir/$MEMDUMP") {
            my %cmdhash = getpartattr("client", "command");
            my $cmdtype = $cmdhash{'type'} || "default";
            if($cmdhash{'option'} && $cmdhash{'option'} !~ /no-memdebug/) {
                logmsg "\n** ALERT! memory tracking with no output file?\n"
                    if($cmdtype ne "perl");
            }
            $ok .= "-"; # problem with memory checking
        }
        else {
            my @memdata = memanalyze("$logdir/$MEMDUMP", 0, 0, 0);
            my $leak = 0;
            for(@memdata) {
                if($_ ne "") {
                    # well it could be other memory problems as well, but
                    # we call it leak for short here
                    $leak = 1;
                }
            }
            if($leak) {
                logmsg "\n** MEMORY FAILURE\n";
                logmsg @memdata;
                logmsg " $testnum: memory FAILED\n";
                # timestamp test result verification end
                $timevrfyend{$testnum} = Time::HiRes::time();
                return -1;
            }
            else {
                $ok .= "m";
            }
            my @more = memanalyze("$logdir/$MEMDUMP", 1, 0, 0);
            my $allocs = 0;
            my $max = 0;
            for(@more) {
                if(/^Allocations: (\d+)/) {
                    $allocs = $1;
                }
                elsif(/^Maximum allocated: (\d+)/) {
                    $max = $1;
                }
            }
            my @limits = getpart("verify", "limits");
            my $lim_allocs = 1000; # high default values
            my $lim_max = 1000000;
            for(@limits) {
                if(/^Allocations: (\d+)/i) {
                    $lim_allocs = $1;
                }
                elsif(/^Maximum allocated: (\d+)/i) {
                    $lim_max = $1;
                }
            }
            logmsg "did $allocs allocations, $lim_allocs allowed\n"
                if($verbose);

            logmsg "allocated $max maximum, $lim_max allowed\n"
                if($verbose);

            if($allocs > $lim_allocs) {
                logmsg "\n** TOO MANY ALLOCS\n";
                logmsg "$lim_allocs allocations allowed, did $allocs\n";
                logmsg " $testnum: allocs FAILED\n";
                # timestamp test result verification end
                $timevrfyend{$testnum} = Time::HiRes::time();
                return -1;
            }
            if($max > $lim_max) {
                logmsg "\n** TOO MUCH TOTAL ALLOCATION\n";
                logmsg "$lim_max maximum allocation allowed, did $max\n";
                logmsg " $testnum: allocsize FAILED\n";
                # timestamp test result verification end
                $timevrfyend{$testnum} = Time::HiRes::time();
                return -1;
            }
        }
    }
    else {
        $ok .= "-"; # memory not checked
    }

    my @notexists = getpart("verify", "notexists");
    if(@notexists) {
        # a list of directory entries that must not exist
        my $err;
        while(@notexists) {
            my $fname = shift @notexists;
            chomp $fname;
            if(-e $fname) {
                logmsg "ERROR: 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";
                # timestamp test result verification end
                $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";
                # timestamp test result verification end
                $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;
                }
                # timestamp test result verification end
                $timevrfyend{$testnum} = Time::HiRes::time();
                return -1;
            }
            $ok .= "v";
        }
        else {
            if($verbose) {
                logmsg " valgrind SKIPPED\n";
            }
            $ok .= "-"; # skipped
        }
    }
    else {
        $ok .= "-"; # valgrind not checked
    }
    # add 'E' for event-based
    $ok .= $run_event_based ? "E" : "-";

    logmsg "$ok " if(!$short);

    # timestamp test result verification end
    $timevrfyend{$testnum} = Time::HiRes::time();

    return 0;
}

#######################################################################
# Report a successful test
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) {
        # ignored test success
        $passedign .= "$testnum ";
        logmsg "Warning: test$testnum result is ignored, but passed!\n";
    }
}

#######################################################################
# Run a single specified test case
# This is structured as a state machine which changes state after an
# asynchronous call is made that awaits a response. The function returns with
# an error code and a flag that indicates if the state machine has completed,
# which means (if not) the function must be called again once the response has
# arrived.
#
sub singletest {
    my ($runnerid, $testnum, $count, $total) = @_;

    # start buffering logmsg; stop it on return
    logmsg_bufferfortest($runnerid);
    if(!exists $singletest_state{$runnerid}) {
        # First time in singletest() for this test
        $singletest_state{$runnerid} = ST_INIT;
    }

    if($singletest_state{$runnerid} == ST_INIT) {
        my $logdir = getrunnerlogdir($runnerid);
        # first, remove all lingering log & lock files
        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;
        # Recursively call the state machine again because there is no
        # event expected that would otherwise trigger a new call.
        return singletest(@_);

    } elsif($singletest_state{$runnerid} == ST_INITED) {
        ###################################################################
        # Restore environment variables that were modified in a previous run.
        # Test definition may instruct to (un)set environment vars.
        # This is done this early so that leftover variables do not affect
        # starting servers or CI registration.
        # restore_test_env(1);

        ###################################################################
        # Load test file so CI registration can get the right data before the
        # runner is called
        loadtest("${TESTDIR}/test${testnum}", 1);

        ###################################################################
        # Register the test case with the CI environment
        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) {
                # Error indicates an actual problem starting the server, so
                # display the server logs
                displaylogs($rid, $testnum);
            }
        }

        #######################################################################
        # Load test file for this test number
        my $logdir = getrunnerlogdir($runnerid);
        loadtest("${logdir}/test${testnum}");

        #######################################################################
        # Print the test name and count tests
        $error = singletest_count($testnum, $why);
        if($error) {
            # Submit the test case result with the CI environment
            citest_finishtest($testnum, $error);
            $singletest_state{$runnerid} = ST_INIT;
            logmsg singletest_dumplogs();
            return ($error, 0);
        }

        #######################################################################
        # Execute this test number
        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) {
            # no further verification occurs
            $timevrfyend{$testnum} = Time::HiRes::time();
            my $err = ignoreresultcode($testnum);
            # Submit the test case result with the CI environment
            citest_finishtest($testnum, $err);
            $singletest_state{$runnerid} = ST_INIT;
            logmsg singletest_dumplogs();
            # return a test failure, either to be reported or to be ignored
            return ($err, 0);
        }
        elsif($error == -2) {
            # fill in the missing timings on error
            timestampskippedevents($testnum);
            # Submit the test case result with the CI environment
            citest_finishtest($testnum, $error);
            $singletest_state{$runnerid} = ST_INIT;
            logmsg singletest_dumplogs();
            return ($error, 0);
        }
        elsif($error > 0) {
            # no further verification occurs
            $timevrfyend{$testnum} = Time::HiRes::time();
            # Submit the test case result with the CI environment
            citest_finishtest($testnum, $error);
            $singletest_state{$runnerid} = ST_INIT;
            logmsg singletest_dumplogs();
            return ($error, 0);
        }

        #######################################################################
        # Verify that the test succeeded
        #
        # Load test file for this test number
        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);
            # Submit the test case result with the CI environment
            citest_finishtest($testnum, $err);
            $singletest_state{$runnerid} = ST_INIT;
            logmsg singletest_dumplogs();
            # return a test failure, either to be reported or to be ignored
            return ($err, 0);
        }
        elsif($error == -2) {
            # torture test; there is no verification, so the run result holds the
            # test success code
            # Submit the test case result with the CI environment
            citest_finishtest($testnum, $cmdres);
            $singletest_state{$runnerid} = ST_INIT;
            logmsg singletest_dumplogs();
            return ($cmdres, 0);
        }

        #######################################################################
        # Report a successful test
        singletest_success($testnum, $count, $total, ignoreresultcode($testnum));

        # Submit the test case result with the CI environment
        citest_finishtest($testnum, 0);
        $singletest_state{$runnerid} = ST_INIT;

        logmsg singletest_dumplogs();
        return (0, 0);  # state machine is finished
    }
    singletest_unbufferlogs();
    return (0, 1);  # state machine must be called again on event
}

#######################################################################
# runtimestats displays test-suite run time statistics
#
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";
}

#######################################################################
# returns code indicating why a test was skipped
# 0=unknown test, 1=use test result, 2=ignore test result
#
sub ignoreresultcode {
    my ($testnum) = @_;
    if(defined $ignoretestcodes{$testnum}) {
        return $ignoretestcodes{$testnum};
    }
    return 0;
}

#######################################################################
# Put the given runner ID onto the queue of runners ready for a new task
#
sub runnerready {
    my ($runnerid) = @_;
    push @runnersidle, $runnerid;
}

#######################################################################
# Create test runners
#
sub createrunners {
    my ($numrunners) = @_;
    if(! $numrunners) {
        $numrunners++;
    }
    # create $numrunners runners with minimum 1
    for my $runnernum (1..$numrunners) {
        my $dir = getrunnernumlogdir($runnernum);
        cleardir($dir);
        mkdir($dir, 0777);
        $runnerids{$runnernum} = runner_init($dir, $jobs);
        runnerready($runnerids{$runnernum});
    }
}

#######################################################################
# Pick a test runner for the given test
#
sub pickrunner {
    my ($testnum) = @_;
    scalar(@runnersidle) or die "No runners available";

    return pop @runnersidle;
}

#######################################################################
# Check options to this test program
#

# Special case for CMake: replace '$TFLAGS' by the contents of the
# environment variable (if any).
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 output
        $verbose = 1;
    }
    elsif($ARGV[0] eq "-c") {
        # use this path to curl instead of default
        $DBGCURL = $CURL = $ARGV[1];
        shift @ARGV;
    }
    elsif($ARGV[0] eq "-vc") {
        # use this path to a curl used to verify servers

        # Particularly useful when you introduce a crashing bug somewhere in
        # the development version as then it is not able to run any tests
        # since it cannot verify the servers!

        $VCURL = shell_quote($ARGV[1]);
        shift @ARGV;
    }
    elsif($ARGV[0] eq "-ac") {
        # use this curl only to talk to APIs (currently only CI test APIs)
        $ACURL = shell_quote($ARGV[1]);
        shift @ARGV;
    }
    elsif($ARGV[0] eq "-d") {
        # have the servers display protocol output
        $debugprotocol = 1;
    }
    elsif(($ARGV[0] eq "-e") || ($ARGV[0] eq "--test-event")) {
        # run the tests cases event based if possible
        $run_event_based = 1;
    }
    elsif($ARGV[0] eq "--test-duphandle") {
        # run the tests with --test-duphandle
        $run_duphandle = 1;
    }
    elsif($ARGV[0] eq "-f") {
        # force - run the test case even if listed in DISABLED
        $run_disabled = 1;
    }
    elsif($ARGV[0] eq "-E") {
        # load additional reasons to skip tests
        shift @ARGV;
        my $exclude_file = $ARGV[0];
        open(my $fd, "<", $exclude_file) or die "Could not 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") {
                    # Strip leading zeros in the test number
                    $pattern = int($pattern);
                }
                $custom_skip_reasons{$type}{$pattern} = $skip_reason;
            }
        }
        close($fd);
    }
    elsif($ARGV[0] eq "-g") {
        # run this test with gdb
        $gdbthis = 1;
    }
    elsif($ARGV[0] eq "-gl") {
        # run this test with lldb
        $gdbthis = 2;
    }
    elsif($ARGV[0] eq "-gw") {
        # run this test with windowed gdb
        $gdbthis = 1;
        $gdbxwin = 1;
    }
    elsif($ARGV[0] eq "-s") {
        # short output
        $short = 1;
    }
    elsif($ARGV[0] eq "-am") {
        # automake-style output
        $short = 1;
        $automakestyle = 1;
    }
    elsif($ARGV[0] =~ /-m=(\d+)/) {
        my ($num) = ($1);
        $maxtime = $num;
    }
    elsif($ARGV[0] =~ /--min=(\d+)/) {
        my ($num) = ($1);
        $mintotal = $num;
    }
    elsif($ARGV[0] eq "-n") {
        # no valgrind
        undef $valgrind;
    }
    elsif($ARGV[0] eq "--no-debuginfod") {
        # disable the valgrind debuginfod functionality
        $no_debuginfod = 1;
    }
    elsif($ARGV[0] eq "-R") {
        # execute in scrambled order
        $scrambleorder = 1;
    }
    elsif($ARGV[0] =~ /^-t(.*)/) {
        # torture
        $torture = 1;
        my $xtra = $1;

        if($xtra =~ s/(\d+)$//) {
            $tortalloc = $1;
        }
    }
    elsif($ARGV[0] =~ /--shallow=(\d+)/) {
        # Fail no more than this amount per tests when running
        # torture.
        my ($num) = ($1);
        $shallow = $num;
    }
    elsif($ARGV[0] =~ /--repeat=(\d+)/) {
        # Repeat-run the given tests this many times
        $repeat = $1;
    }
    elsif($ARGV[0] =~ /--retry=(\d+)/) {
        # Number of attempts for the whole test run to retry failed tests
        $retry = $1;
    }
    elsif($ARGV[0] =~ /--seed=(\d+)/) {
        # Set a fixed random seed (used for -R and --shallow)
        $randseed = $1;
    }
    elsif($ARGV[0] eq "-a") {
        # continue anyway, even if a test fail
        $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") {
        # require additional library file
        shift @ARGV;
        require $ARGV[0];
    }
    elsif($ARGV[0] eq "-l") {
        # lists the test case names only
        $listonly = 1;
    }
    elsif($ARGV[0] eq "--buildinfo") {
        $buildinfo = 1;
    }
    elsif($ARGV[0] =~ /^-j(.*)/) {
        # parallel jobs
        $jobs = 1;
        my $xtra = $1;
        if($xtra =~ s/(\d+)$//) {
            $jobs = $1;
        }
    }
    elsif($ARGV[0] eq "-k") {  # delete this check after December 2026
        print "Option -k became always-on in 7.65.2 (2019) and now a no-op. Delete it to continue.\n";
        exit 1;
    }
    elsif($ARGV[0] eq "-r") {
        # run time statistics needs Time::HiRes
        if($Time::HiRes::VERSION) {
            # presize hashes appropriately to hold an entire test run
            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") {
        # run time statistics needs Time::HiRes
        if($Time::HiRes::VERSION) {
            # presize hashes appropriately to hold an entire test run
            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") {
        # error instead of warning on server unexpectedly alive
        $err_unexpected = 1;
    }
    elsif(($ARGV[0] eq "-h") || ($ARGV[0] eq "--help")) {
        # show help text
        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]
  --buildinfo dump buildinfo.txt
  -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)
  -L path  require an additional perl library file to replace certain functions
  -l       list all test case names/descriptions
  -m=[seconds] set timeout for curl commands in tests
  --min=[count] minimum number of tests to run.
  -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;
}

delete $ENV{'DEBUGINFOD_URLS'} if($ENV{'DEBUGINFOD_URLS'} && $no_debuginfod);

if(!$randseed) {
    my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time);
    # seed of the month. December 2019 becomes 201912
    $randseed = ($year + 1900) * 100 + $mon + 1;
    print "Using curl: $CURL\n";
    open(my $curlvh, "-|", exerunner() . shell_quote($CURL) . " --version 2>$dev_null") or
        die "could not get curl version!";
    my @c = <$curlvh>;
    close($curlvh) or die "could not get curl version!";
    # use the first line of output and get the md5 out of it
    my $str = md5($c[0]);
    $randseed += unpack('S', $str);  # unsigned 16-bit value
}
srand $randseed;

if(@testthis && ($testthis[0] ne "")) {
    $TESTCASES = join(" ", @testthis);
}

if($valgrind) {
    # we have found valgrind on the host, use it

    # verify that we can invoke it fine
    my $code = runclient("valgrind >$dev_null 2>&1");

    if(($code>>8) != 1) {
        #logmsg "Valgrind failure, disable it\n";
        undef $valgrind;
    } else {

        # since valgrind 2.1.x, '--tool' option is mandatory
        # use it, if it is supported by the version installed on the system
        # (this happened in 2003, so we could probably do not need to care about
        # that old version any longer and delete this check)
        runclient("valgrind --help 2>&1 | grep -- --tool >$dev_null 2>&1");
        if(($? >> 8)) {
            $valgrind_tool = "";
        }
        open(my $curlh, "<", $CURL);
        my $l = <$curlh>;
        if($l =~ /^\#\!/) {
            # A shell script. This is typically when built with libtool,
            $valgrind = "../libtool --mode=execute $valgrind";
        }
        close($curlh);

        # valgrind 3 renamed the --logfile option to --log-file!!!
        # (this happened in 2005, so we could probably do not need to care about
        # that old version any longer and delete this check)
        my $ver = join(' ', runclientoutput("valgrind --version"));
        # cut off all but digits and dots
        $ver =~ s/[^0-9.]//g;

        if($ver =~ /^(\d+)/) {
            $ver = $1;
            if($ver < 3) {
                $valgrind_logfile = "--logfile";
            }
        }
    }
}

if($gdbthis) {
    # open the executable curl and read the first 4 bytes of it
    open(my $check, "<", $CURL);
    my $c;
    sysread $check, $c, 4;
    close($check);
    if($c eq "#! /") {
        # A shell script. This is typically when built with libtool,
        $libtool = 1;
        $gdb = "../libtool --mode=execute gdb";
    }
}

#######################################################################
# clear and create logging directory:
#

# TODO: figure how to get around this. This directory is needed for checksystemfeatures()
# Maybe create & use & delete a temporary directory in that function
cleardir($LOGDIR);
mkdir($LOGDIR, 0777);
mkdir("$LOGDIR/$LOCKDIR", 0777);

#######################################################################
# initialize some variables
#

get_disttests();
if(!$jobs) {
    # Disable buffered logging with only one test job
    setlogfunc(\&logmsg);
}

if(!$mintotal && $ENV{"CURL_TEST_MIN"}) {
    $mintotal = $ENV{"CURL_TEST_MIN"};
}

#######################################################################
# Output curl version and host info being tested
#

if(!$listonly) {
    checksystemfeatures();
}

#######################################################################
# Output information about the curl build
#
if(!$listonly && $buildinfo) {
    if(open(my $fd, "<", "../buildinfo.txt")) {
        while(my $line = <$fd>) {
            chomp $line;
            if($line && $line !~ /^#/) {
                logmsg("* $line\n");
            }
        }
        close($fd);
    }
}

#######################################################################
# initialize configuration needed to set up servers
# TODO: rearrange things so this can be called only in runner_init()
#
initserverconfig();

if(!$listonly) {
    # these can only be displayed after initserverconfig() has been called
    displayserverfeatures();

    # globally disabled tests
    disabledtests("$TESTDIR/DISABLED");
}

#######################################################################
# Fetch all disabled tests, if there are any
#
sub disabledtests {
    my ($file) = @_;
    my @input;

    if(open(my $disabledh, "<", $file)) {
        while(<$disabledh>) {
            if(/^ *\#/) {
                # allow comments
                next;
            }
            push @input, $_;
        }
        close($disabledh);

        # preprocess the input to make conditionally disabled tests depending
        # on variables
        my @pp = prepro(0, @input);
        for my $t (@pp) {
            if($t =~ /(\d+)/) {
                my ($n) = $1;
                $disabled{$n} = $n; # disable this test number
                if(! -f "$srcdir/data/test$n") {
                    print STDERR "WARNING! Non-existing test $n in $file!\n";
                    # fail hard to make user notice
                    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 'all' tests are requested, find out all test numbers
#

if($TESTCASES eq "all") {
    # Get all commands and find out their test numbers
    opendir(DIR, $TESTDIR) or die "cannot opendir $TESTDIR: $!";
    my @cmds = grep { /^test([0-9]+)$/ && -f "$TESTDIR/$_" } readdir(DIR);
    closedir(DIR);

    $TESTCASES = ""; # start with no test cases

    # cut off everything but the digits
    for(@cmds) {
        $_ =~ s/[a-z\/\.]*//g;
    }
    # sort the numbers from low to high
    foreach my $n (sort { $a <=> $b } @cmds) {
        if($disabled{$n}) {
            # skip disabled test cases
            my $why = "configured as DISABLED";
            $skipped{$why}++;
            $teststat[$n] = $why; # store reason for this test case
            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) {
    # scramble the order of the test cases
    my @rand;
    while($TESTCASES) {
        my @all = split(/ +/, $TESTCASES);
        if(!$all[0]) {
            # if the first is blank, shift away it
            shift @all;
        }
        my $r = rand @all;
        push @rand, $all[$r];
        $all[$r] = "";
        $TESTCASES = join(" ", @all);
    }
    $TESTCASES = join(" ", @rand);
}

# Display the contents of the given file.  Line endings are canonicalized
# and excessively long files are elided
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) or die "cannot open dir: $!";
    my @logs = readdir(DIR);
    closedir(DIR);

    logmsg "== Contents of files in the $logdir/ directory after test $testnum\n";
    foreach my $log (sort @logs) {
        if($log =~ /\.(\.|)$/) {
            next; # skip "." and ".."
        }
        if($log =~ /^\.nfs/) {
            next; # skip ".nfs"
        }
        if(($log eq "memdump") || ($log eq "core")) {
            next; # skip "memdump" and  "core"
        }
        if((-d "$logdir/$log") || (! -s "$logdir/$log")) {
            next; # skip directory and empty files
        }
        if(($log =~ /^stdout\d+/) && ($log !~ /^stdout$testnum/)) {
            next; # skip stdoutNnn of other tests
        }
        if(($log =~ /^stderr\d+/) && ($log !~ /^stderr$testnum/)) {
            next; # skip stderrNnn of other tests
        }
        if(($log =~ /^upload\d+/) && ($log !~ /^upload$testnum/)) {
            next; # skip uploadNnn of other tests
        }
        if(($log =~ /^curl\d+\.out/) && ($log !~ /^curl$testnum\.out/)) {
            next; # skip curlNnn.out of other tests
        }
        if(($log =~ /^test\d+\.txt/) && ($log !~ /^test$testnum\.txt/)) {
            next; # skip testNnn.txt of other tests
        }
        if(($log =~ /^file\d+\.txt/) && ($log !~ /^file$testnum\.txt/)) {
            next; # skip fileNnn.txt of other tests
        }
        if(($log =~ /^netrc\d+/) && ($log !~ /^netrc$testnum/)) {
            next; # skip netrcNnn of other tests
        }
        if(($log =~ /^trace\d+/) && ($log !~ /^trace$testnum/)) {
            next; # skip traceNnn of other tests
        }
        if(($log =~ /^valgrind\d+/) && ($log !~ /^valgrind$testnum(?:\..*)?$/)) {
            next; # skip valgrindNnn of other tests
        }
        if(($log =~ /^test$testnum$/)) {
            next; # skip test$testnum since it can be big
        }
        logmsg "=== Start of file $log\n";
        displaylogcontent("$logdir/$log");
        logmsg "=== End of file $log\n";
    }
}

#######################################################################
# Scan tests to find suitable candidates
#

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();

# scan all tests to find ones we should try to run
my @runtests;
foreach my $testnum (@at) {
    $lasttest = $testnum if($testnum > $lasttest);
    my ($why, $errorreturncode) = singletest_shouldrun($testnum);
    if($why || $listonly) {
        # Display test name now--test is completely skipped later
        my $error = singletest_count($testnum, $why);
        next;
    }
    $ignoretestcodes{$testnum} = $errorreturncode;
    push(@runtests, $testnum);
}
my $totaltests = scalar(@runtests);

if($listonly) {
    exit(0);
}

#######################################################################
# Setup CI Test Run
citest_starttestrun();

#######################################################################
# Start test runners
#
my $numrunners = $jobs < scalar(@runtests) ? $jobs : scalar(@runtests);
createrunners($numrunners);

#######################################################################
# The main test-loop
#
# Every iteration through the loop consists of these steps:
#   - if the global abort flag is set, exit the loop; we are done
#   - if a runner is idle, start a new test on it
#   - if all runners are idle, exit the loop; we are done
#   - if a runner has a response for us, process the response

# run through each candidate test and execute it
my $runner_wait_cnt = 0;

# number of retry attempts for the whole test run
my $retry_left;
if($torture) {
    $retry_left = 0;  # No use of retrying torture tests
}
else {
    $retry_left = $retry;
}

while(1) {
    # check the abort flag
    if($globalabort) {
        logmsg singletest_dumplogs();
        logmsg "Aborting tests\n";
        logmsg "Waiting for " . scalar((keys %runnersrunning)) . " outstanding test(s) to finish...\n";
        # Wait for the last requests to complete and throw them away so
        # that IPC calls & responses stay in sync
        # TODO: send a signal to the runners to interrupt a long test
        foreach my $rid (keys %runnersrunning) {
            runnerar($rid);
            delete $runnersrunning{$rid};
            logmsg ".";
            $| = 1;
        }
        logmsg "\n";
        last;
    }

    # Start a new test if possible
    if(scalar(@runnersidle) && scalar(@runtests)) {
        # A runner is ready to run a test, and tests are still available to run
        # so start a new test.
        $count++;
        my $testnum = shift(@runtests);

        # pick a runner for this new test
        my $runnerid = pickrunner($testnum);
        $countforrunner{$runnerid} = $count;

        # Start the test
        my ($error, $again) = singletest($runnerid, $testnum, $countforrunner{$runnerid}, $totaltests);
        if($again) {
            # this runner is busy running a test
            $runnersrunning{$runnerid} = $testnum;
        } else {
            runnerready($runnerid);
            if($error >= 0) {
                # We make this simplifying assumption to avoid having to handle
                # $error properly here, but we must handle the case of runner
                # death without abending here.
                die "Internal error: test must not complete on first call";
            }
        }
    }

    # See if we have completed all the tests
    if(!scalar(%runnersrunning)) {
        # No runners are running; we must be done
        scalar(@runtests) && die 'Internal error: still have tests to run';
        last;
    }

    # See if a test runner needs attention
    # If we could be running more tests, do not wait so we can schedule a new
    # one immediately. If all runners are busy, wait a fraction of a second
    # for one to finish so we can still loop around to check the abort flag.
    my $runnerwait = scalar(@runnersidle) && scalar(@runtests) ? 0.1 : 1.0;
    my (@ridsready, $riderror) = runnerar_ready($runnerwait);
    if(@ridsready) {
        for my $ridready (@ridsready) {
            if($ridready && ! defined $runnersrunning{$ridready}) {
                # On Linux, a closed pipe still shows up as ready instead of error.
                # Detect this here by seeing if we are expecting it to be ready and
                # treat it as an error if not.
                logmsg "ERROR: Runner $ridready is unexpectedly ready; is probably actually dead\n";
                $riderror = $ridready;
                undef $ridready;
            }
            if($ridready) {
                $endwaitcnt = 0;
                # This runner is ready to be serviced
                my $testnum = $runnersrunning{$ridready};
                defined $testnum or die "Internal error: test for runner $ridready unknown";
                delete $runnersrunning{$ridready};
                my ($error, $again) = singletest($ridready, $testnum, $countforrunner{$ridready}, $totaltests);
                if($again) {
                    # this runner is busy running a test
                    $runnersrunning{$ridready} = $testnum;
                } else {
                    # Test is complete
                    $runner_wait_cnt = 0;
                    runnerready($ridready);

                    if($error < 0) {
                        # not a test we can run
                        next;
                    }

                    $total++; # number of tests we have run
                    $executed++;

                    if($error > 0) {
                        if($error == 2) {
                            # ignored test failures
                            $failedign .= "$testnum ";
                        }
                        else {
                            # make another attempt to counteract flaky failures
                            if($retry_left > 0) {
                                $retry_left--;
                                $retry_done++;
                                $total--;
                                push(@runtests, $testnum);
                                $failedre .= "$testnum ";
                            }
                            else {
                                $failed.= "$testnum ";
                            }
                        }
                        if($postmortem) {
                            # display all files in $LOGDIR/ in a nice way
                            displaylogs($ridready, $testnum);
                        }
                        if($error == 2) {
                            $ign++; # ignored test result counter
                        }
                        elsif(!$anyway) {
                            # a test failed, abort
                            logmsg "\n - abort tests\n";
                            undef @runtests;  # empty out the remaining tests
                        }
                    }
                    elsif(!$error) {
                        $ok++; # successful test counter
                    }
                }
            }
        }
    }
    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;
    }
    $endwaitcnt += $runnerwait;
    if($endwaitcnt >= 10) {
        # Once all tests have been scheduled on a runner at the end of a test
        # run, we wait for their results to come in. If we are still
        # waiting after a couple of minutes ($endwaitcnt multiplied by
        # $runnerwait, plus $jobs because that number does not time out), display
        # the same test runner status as we give with a SIGUSR1. This likely
        # points to a single test that has hung.
        logmsg "Hmmm, the tests are taking a while to finish. Here is the status:\n";
        catch_usr1();
        $endwaitcnt = 0;
    }
}

my $sofar = time() - $start;

#######################################################################
# Finish CI Test Run
citest_finishtestrun();

# Tests done, stop the servers
foreach my $runnerid (values %runnerids) {
    runnerac_stopservers($runnerid);
}

# Wait for servers to stop
my $unexpected;
foreach my $runnerid (values %runnerids) {
    my ($rid, $unexpected_for_runner, $logs) = runnerar($runnerid);
    $unexpected ||= $unexpected_for_runner;
    logmsg $logs;
}

# Kill the runners
# There is a race condition here since we do not know exactly when the runners
# have each finished shutting themselves down, but we are about to exit so it
# does not make much difference.
foreach my $runnerid (values %runnerids) {
    runnerac_shutdown($runnerid);
    sleep 0;  # give runner a context switch so it can shut itself down
}

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;
    # Temporary hash to print the restraints sorted by the number
    # of their occurrences
    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");

        # now gather all test case numbers that had this reason for being
        # skipped
        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}", 1)) {
            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($mintotal) {
    if($total < $mintotal) {
        logmsg "TESTFAIL: number of tests run ($total) was below the minimum of: $mintotal\n";
        exit 1;
    }
    else {
        logmsg "TESTDONE: minimum number of tests was met: $mintotal\n";
    }
}

if(($total && (($ok+$ign) != $total)) || !$total || $unexpected) {
    exit 1;
}
