runtests.pl - quickjs-tart - quickjs-based runtime for wallet-core logic

runtests.pl (107758B)
      1 #!/usr/bin/env perl
      2 #***************************************************************************
      3 #                                  _   _ ____  _
      4 #  Project                     ___| | | |  _ \| |
      5 #                             / __| | | | |_) | |
      6 #                            | (__| |_| |  _ <| |___
      7 #                             \___|\___/|_| \_\_____|
      8 #
      9 # Copyright (C) Daniel Stenberg, <daniel@haxx.se>, et al.
     10 #
     11 # This software is licensed as described in the file COPYING, which
     12 # you should have received as part of this distribution. The terms
     13 # are also available at https://curl.se/docs/copyright.html.
     14 #
     15 # You may opt to use, copy, modify, merge, publish, distribute and/or sell
     16 # copies of the Software, and permit persons to whom the Software is
     17 # furnished to do so, under the terms of the COPYING file.
     18 #
     19 # This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
     20 # KIND, either express or implied.
     21 #
     22 # SPDX-License-Identifier: curl
     23 #
     24 ###########################################################################
     25 
     26 # For documentation, run `man ./runtests.1` and see README.md.
     27 
     28 # Experimental hooks are available to run tests remotely on machines that
     29 # are able to run curl but are unable to run the test harness.
     30 # The following sections need to be modified:
     31 #
     32 #  $HOSTIP, $HOST6IP - Set to the address of the host running the test suite
     33 #  $CLIENTIP, $CLIENT6IP - Set to the address of the host running curl
     34 #  runclient, runclientoutput - Modify to copy all the files in the log/
     35 #    directory to the system running curl, run the given command remotely
     36 #    and save the return code or returned stdout (respectively), then
     37 #    copy all the files from the remote system's log/ directory back to
     38 #    the host running the test suite.  This can be done a few ways, such
     39 #    as using scp & ssh, rsync & telnet, or using a NFS shared directory
     40 #    and ssh.
     41 #
     42 # 'make && make test' needs to be done on both machines before making the
     43 # above changes and running runtests.pl manually.  In the shared NFS case,
     44 # the contents of the tests/server/ directory must be from the host
     45 # running the test suite, while the rest must be from the host running curl.
     46 #
     47 # Note that even with these changes a number of tests will still fail (mainly
     48 # to do with cookies, those that set environment variables, or those that
     49 # do more than touch the file system in a <precheck> or <postcheck>
     50 # section). These can be added to the $TESTCASES line below,
     51 # e.g. $TESTCASES="!8 !31 !63 !cookies..."
     52 #
     53 # Finally, to properly support -g and -n, checktestcmd needs to change
     54 # to check the remote system's PATH, and the places in the code where
     55 # the curl binary is read directly to determine its type also need to be
     56 # fixed. As long as the -g option is never given, and the -n is always
     57 # given, this won't be a problem.
     58 
     59 use strict;
     60 use warnings;
     61 use 5.006;
     62 use POSIX qw(strftime);
     63 
     64 # These should be the only variables that might be needed to get edited:
     65 
     66 BEGIN {
     67     # Define srcdir to the location of the tests source directory. This is
     68     # usually set by the Makefile, but for out-of-tree builds with direct
     69     # invocation of runtests.pl, it may not be set.
     70     if(!defined $ENV{'srcdir'}) {
     71         use File::Basename;
     72         $ENV{'srcdir'} = dirname(__FILE__);
     73     }
     74     push(@INC, $ENV{'srcdir'});
     75     # run time statistics needs Time::HiRes
     76     eval {
     77         no warnings "all";
     78         require Time::HiRes;
     79         import  Time::HiRes qw( time );
     80     }
     81 }
     82 
     83 use Digest::MD5 qw(md5);
     84 use List::Util 'sum';
     85 use I18N::Langinfo qw(langinfo CODESET);
     86 
     87 use serverhelp qw(
     88     server_exe
     89     );
     90 use pathhelp qw(
     91     exe_ext
     92     sys_native_current_path
     93     );
     94 use processhelp qw(
     95     portable_sleep
     96     );
     97 
     98 use appveyor;
     99 use azure;
    100 use getpart;   # array functions
    101 use servers;
    102 use valgrind;  # valgrind report parser
    103 use globalconfig;
    104 use runner;
    105 use testutil;
    106 
    107 my %custom_skip_reasons;
    108 
    109 my $ACURL=$VCURL;  # what curl binary to use to talk to APIs (relevant for CI)
    110                    # ACURL is handy to set to the system one for reliability
    111 my $CURLCONFIG="../curl-config"; # curl-config from current build
    112 
    113 # Normally, all test cases should be run, but at times it is handy to
    114 # simply run a particular one:
    115 my $TESTCASES="all";
    116 
    117 # To run specific test cases, set them like:
    118 # $TESTCASES="1 2 3 7 8";
    119 
    120 #######################################################################
    121 # No variables below this point should need to be modified
    122 #
    123 
    124 my $libtool;
    125 my $repeat = 0;
    126 my $retry = 0;
    127 
    128 my $start;          # time at which testing started
    129 my $args;           # command-line arguments
    130 
    131 my $uname_release = `uname -r`;
    132 my $is_wsl = $uname_release =~ /Microsoft$/;
    133 
    134 my $http_ipv6;      # set if HTTP server has IPv6 support
    135 my $http_unix;      # set if HTTP server has Unix sockets support
    136 my $ftp_ipv6;       # set if FTP server has IPv6 support
    137 
    138 my $resolver;       # name of the resolver backend (for human presentation)
    139 
    140 my %skipped;    # skipped{reason}=counter, reasons for skip
    141 my @teststat;   # teststat[testnum]=reason, reasons for skip
    142 my %disabled_keywords;  # key words of tests to skip
    143 my %ignored_keywords;   # key words of tests to ignore results
    144 my %enabled_keywords;   # key words of tests to run
    145 my %disabled;           # disabled test cases
    146 my %ignored;            # ignored results of test cases
    147 my %ignoretestcodes;    # if test results are to be ignored
    148 
    149 my $passedign;   # tests passed with results ignored
    150 
    151 my $timestats;   # time stamping and stats generation
    152 my $fullstats;   # show time stats for every single test
    153 my %timeprepini; # timestamp for each test preparation start
    154 my %timesrvrini; # timestamp for each test required servers verification start
    155 my %timesrvrend; # timestamp for each test required servers verification end
    156 my %timetoolini; # timestamp for each test command run starting
    157 my %timetoolend; # timestamp for each test command run stopping
    158 my %timesrvrlog; # timestamp for each test server logs lock removal
    159 my %timevrfyend; # timestamp for each test result verification end
    160 my $globalabort; # flag signalling program abort
    161 
    162 # values for $singletest_state
    163 use constant {
    164     ST_INIT => 0,
    165     ST_INITED => 2,
    166     ST_PREPROCESS => 3,
    167     ST_RUN => 4,
    168 };
    169 my %singletest_state;  # current state of singletest() by runner ID
    170 my %singletest_logs;   # log messages while in singletest array ref by runner
    171 my $singletest_bufferedrunner; # runner ID which is buffering logs
    172 my %runnerids;         # runner IDs by number
    173 my @runnersidle;       # runner IDs idle and ready to execute a test
    174 my %countforrunner;    # test count by runner ID
    175 my %runnersrunning;    # tests currently running by runner ID
    176 
    177 #######################################################################
    178 # variables that command line options may set
    179 #
    180 my $short;
    181 my $no_debuginfod;
    182 my $keepoutfiles; # keep stdout and stderr files after tests
    183 my $postmortem;   # display detailed info about failed tests
    184 my $run_disabled; # run the specific tests even if listed in DISABLED
    185 my $scrambleorder;
    186 my $jobs = 0;
    187 
    188 # Azure Pipelines specific variables
    189 my $AZURE_RUN_ID = 0;
    190 my $AZURE_RESULT_ID = 0;
    191 
    192 #######################################################################
    193 # logmsg is our general message logging subroutine.
    194 #
    195 sub logmsg {
    196     if($singletest_bufferedrunner) {
    197         # Logs are currently being buffered
    198         return singletest_logmsg(@_);
    199     }
    200     for(@_) {
    201         my $line = $_;
    202         if(!$line) {
    203             next;
    204         }
    205         if($is_wsl) {
    206             # use \r\n for WSL shell
    207             $line =~ s/\r?\n$/\r\n/g;
    208         }
    209         print "$line";
    210     }
    211 }
    212 
    213 #######################################################################
    214 # enable logmsg buffering for the given runner ID
    215 #
    216 sub logmsg_bufferfortest {
    217     my ($runnerid)=@_;
    218     if($jobs) {
    219         # Only enable buffering in multiprocess mode
    220         $singletest_bufferedrunner = $runnerid;
    221     }
    222 }
    223 #######################################################################
    224 # Store a log message in a buffer for this test
    225 # The messages can then be displayed all at once at the end of the test
    226 # which prevents messages from different tests from being interleaved.
    227 sub singletest_logmsg {
    228     if(!exists $singletest_logs{$singletest_bufferedrunner}) {
    229         # initialize to a reference to an empty anonymous array
    230         $singletest_logs{$singletest_bufferedrunner} = [];
    231     }
    232     my $logsref = $singletest_logs{$singletest_bufferedrunner};
    233     push @$logsref, @_;
    234 }
    235 
    236 #######################################################################
    237 # Stop buffering log messages, but don't touch them
    238 sub singletest_unbufferlogs {
    239     undef $singletest_bufferedrunner;
    240 }
    241 
    242 #######################################################################
    243 # Clear the buffered log messages & stop buffering after returning them
    244 sub singletest_dumplogs {
    245     if(!defined $singletest_bufferedrunner) {
    246         # probably not multiprocess mode and logs weren't buffered
    247         return undef;
    248     }
    249     my $logsref = $singletest_logs{$singletest_bufferedrunner};
    250     my $msg = join("", @$logsref);
    251     delete $singletest_logs{$singletest_bufferedrunner};
    252     singletest_unbufferlogs();
    253     return $msg;
    254 }
    255 
    256 sub catch_zap {
    257     my $signame = shift;
    258     print "runtests.pl received SIG$signame, exiting\r\n";
    259     $globalabort = 1;
    260 }
    261 $SIG{INT} = \&catch_zap;
    262 $SIG{TERM} = \&catch_zap;
    263 
    264 sub catch_usr1 {
    265     print "runtests.pl internal state:\r\n";
    266     print scalar(%runnersrunning) . " busy test runner(s) of " . scalar(keys %runnerids) . "\r\n";
    267     foreach my $rid (sort(keys(%runnersrunning))) {
    268         my $runnernum = "unknown";
    269         foreach my $rnum (keys %runnerids) {
    270             if($runnerids{$rnum} == $rid) {
    271                 $runnernum = $rnum;
    272                 last;
    273             }
    274         }
    275         print "Runner $runnernum (id $rid) running test $runnersrunning{$rid} in state $singletest_state{$rid}\r\n";
    276     }
    277 }
    278 
    279 eval {
    280     # some msys2 perl versions don't define SIGUSR1
    281     $SIG{USR1} = \&catch_usr1;
    282 };
    283 $SIG{PIPE} = 'IGNORE';  # these errors are captured in the read/write calls
    284 
    285 ##########################################################################
    286 # Clear all possible '*_proxy' environment variables for various protocols
    287 # to prevent them to interfere with our testing!
    288 
    289 foreach my $protocol (('ftp', 'http', 'ftps', 'https', 'no', 'all')) {
    290     my $proxy = "${protocol}_proxy";
    291     # clear lowercase version
    292     delete $ENV{$proxy} if($ENV{$proxy});
    293     # clear uppercase version
    294     delete $ENV{uc($proxy)} if($ENV{uc($proxy)});
    295 }
    296 
    297 # make sure we don't get affected by other variables that control our
    298 # behavior
    299 
    300 delete $ENV{'SSL_CERT_DIR'} if($ENV{'SSL_CERT_DIR'});
    301 delete $ENV{'SSL_CERT_PATH'} if($ENV{'SSL_CERT_PATH'});
    302 delete $ENV{'CURL_CA_BUNDLE'} if($ENV{'CURL_CA_BUNDLE'});
    303 
    304 # provide defaults from our config file for ENV vars not explicitly
    305 # set by the caller
    306 if(open(my $fd, "<", "config")) {
    307     while(my $line = <$fd>) {
    308         next if($line =~ /^#/);
    309         chomp $line;
    310         my ($name, $val) = split(/\s*:\s*/, $line, 2);
    311         $ENV{$name} = $val if(!$ENV{$name});
    312     }
    313     close($fd);
    314 }
    315 
    316 # Check if we have nghttpx available and if it talks http/3
    317 my $nghttpx_h3 = 0;
    318 if(!$ENV{"NGHTTPX"}) {
    319     $ENV{"NGHTTPX"} = checktestcmd("nghttpx");
    320 }
    321 if($ENV{"NGHTTPX"}) {
    322     my $cmd = "\"$ENV{'NGHTTPX'}\" -v 2>$dev_null";
    323     my $nghttpx_version=join(' ', `$cmd`);
    324     $nghttpx_h3 = $nghttpx_version =~ /nghttp3\//;
    325     chomp $nghttpx_h3;
    326 }
    327 
    328 
    329 #######################################################################
    330 # Get the list of tests that the tests/data/Makefile.am knows about!
    331 #
    332 my $disttests = "";
    333 sub get_disttests {
    334     # If a non-default $TESTDIR is being used there may not be any
    335     # Makefile.am in which case there's nothing to do.
    336     open(my $dh, "<", "$TESTDIR/Makefile.am") or return;
    337     while(<$dh>) {
    338         chomp $_;
    339         if(($_ =~ /^#/) ||($_ !~ /test/)) {
    340             next;
    341         }
    342         $disttests .= $_;
    343     }
    344     close($dh);
    345 }
    346 
    347 
    348 #######################################################################
    349 # Remove all files in the specified directory
    350 #
    351 sub cleardir {
    352     my $dir = $_[0];
    353     my $done = 1;  # success
    354     my $file;
    355 
    356     # Get all files
    357     opendir(my $dh, $dir) ||
    358         return 0; # can't open dir
    359     while($file = readdir($dh)) {
    360         # Don't clear the $PIDDIR or $LOCKDIR since those need to live beyond
    361         # one test
    362         if(($file !~ /^(\.|\.\.)\z/) &&
    363             "$file" ne $PIDDIR && "$file" ne $LOCKDIR) {
    364             if(-d "$dir/$file") {
    365                 if(!cleardir("$dir/$file")) {
    366                     $done = 0;
    367                 }
    368                 if(!rmdir("$dir/$file")) {
    369                     $done = 0;
    370                 }
    371             }
    372             else {
    373                 # Ignore stunnel since we cannot do anything about its locks
    374                 if(!unlink("$dir/$file") && "$file" !~ /_stunnel\.log$/) {
    375                     $done = 0;
    376                 }
    377             }
    378         }
    379     }
    380     closedir $dh;
    381     return $done;
    382 }
    383 
    384 
    385 #######################################################################
    386 # Given two array references, this function will store them in two temporary
    387 # files, run 'diff' on them, store the result and return the diff output!
    388 sub showdiff {
    389     my ($logdir, $firstref, $secondref)=@_;
    390 
    391     my $file1="$logdir/check-generated";
    392     my $file2="$logdir/check-expected";
    393 
    394     open(my $temp, ">", "$file1") || die "Failure writing diff file";
    395     for(@$firstref) {
    396         my $l = $_;
    397         $l =~ s/\r/[CR]/g;
    398         $l =~ s/\n/[LF]/g;
    399         $l =~ s/([^\x20-\x7f])/sprintf "%%%02x", ord $1/eg;
    400         print $temp $l;
    401         print $temp "\n";
    402     }
    403     close($temp) || die "Failure writing diff file";
    404 
    405     open($temp, ">", "$file2") || die "Failure writing diff file";
    406     for(@$secondref) {
    407         my $l = $_;
    408         $l =~ s/\r/[CR]/g;
    409         $l =~ s/\n/[LF]/g;
    410         $l =~ s/([^\x20-\x7f])/sprintf "%%%02x", ord $1/eg;
    411         print $temp $l;
    412         print $temp "\n";
    413     }
    414     close($temp) || die "Failure writing diff file";
    415     my @out = `diff -u $file2 $file1 2>$dev_null`;
    416 
    417     if(!$out[0]) {
    418         @out = `diff -c $file2 $file1 2>$dev_null`;
    419         if(!$out[0]) {
    420             logmsg "Failed to show diff. The diff tool may be missing.\n";
    421         }
    422     }
    423 
    424     return @out;
    425 }
    426 
    427 
    428 #######################################################################
    429 # compare test results with the expected output, we might filter off
    430 # some pattern that is allowed to differ, output test results
    431 #
    432 sub compare {
    433     my ($runnerid, $testnum, $testname, $subject, $firstref, $secondref)=@_;
    434 
    435     my $result = compareparts($firstref, $secondref);
    436 
    437     if($result) {
    438         # timestamp test result verification end
    439         $timevrfyend{$testnum} = Time::HiRes::time();
    440 
    441         if(!$short) {
    442             logmsg "\n $testnum: $subject FAILED:\n";
    443             my $logdir = getrunnerlogdir($runnerid);
    444             logmsg showdiff($logdir, $firstref, $secondref);
    445         }
    446         elsif(!$automakestyle) {
    447             logmsg "FAILED\n";
    448         }
    449         else {
    450             # automakestyle
    451             logmsg "FAIL: $testnum - $testname - $subject\n";
    452         }
    453     }
    454     return $result;
    455 }
    456 
    457 #######################################################################
    458 # Numeric-sort words in a string
    459 sub numsortwords {
    460     my ($string)=@_;
    461     return join(' ', sort { $a <=> $b } split(' ', $string));
    462 }
    463 
    464 #######################################################################
    465 # Parse and store the protocols in curl's Protocols: line
    466 sub parseprotocols {
    467     my ($line)=@_;
    468 
    469     @protocols = split(' ', lc($line));
    470 
    471     # Generate a "proto-ipv6" version of each protocol to match the
    472     # IPv6 <server> name and a "proto-unix" to match the variant which
    473     # uses Unix domain sockets. This works even if support isn't
    474     # compiled in because the <features> test will fail.
    475     push @protocols, map(("$_-ipv6", "$_-unix"), @protocols);
    476 
    477     # 'http-proxy' is used in test cases to do CONNECT through
    478     push @protocols, 'http-proxy';
    479 
    480     # 'https-mtls' is used for client certificate auth testing
    481     push @protocols, 'https-mtls';
    482 
    483     # 'none' is used in test cases to mean no server
    484     push @protocols, 'none';
    485 }
    486 
    487 
    488 #######################################################################
    489 # Check & display information about curl and the host the test suite runs on.
    490 # Information to do with servers is displayed in displayserverfeatures, after
    491 # the server initialization is performed.
    492 sub checksystemfeatures {
    493     my $proto;
    494     my $feat;
    495     my $curl;
    496     my $libcurl;
    497     my $versretval;
    498     my $versnoexec;
    499     my @version=();
    500     my @disabled;
    501     my $dis = "";
    502 
    503     my $curlverout="$LOGDIR/curlverout.log";
    504     my $curlvererr="$LOGDIR/curlvererr.log";
    505     my $versioncmd=exerunner() . shell_quote($CURL) . " --version 1>$curlverout 2>$curlvererr";
    506 
    507     unlink($curlverout);
    508     unlink($curlvererr);
    509 
    510     $versretval = runclient($versioncmd);
    511     $versnoexec = $!;
    512 
    513     my $current_time = int(time());
    514     $ENV{'SOURCE_DATE_EPOCH'} = $current_time;
    515     $DATE = strftime "%Y-%m-%d", gmtime($current_time);
    516 
    517     open(my $versout, "<", "$curlverout");
    518     @version = <$versout>;
    519     close($versout);
    520 
    521     open(my $disabledh, "-|", exerunner() . shell_quote($CURLINFO));
    522     while(<$disabledh>) {
    523         if($_ =~ /([^:]*): ([ONF]*)/) {
    524             my ($val, $toggle) = ($1, $2);
    525             push @disabled, $val if($toggle eq "OFF");
    526             $feature{$val} = 1 if($toggle eq "ON");
    527         }
    528     }
    529     close($disabledh);
    530 
    531     if($disabled[0]) {
    532         s/[\r\n]//g for @disabled;
    533         $dis = join(", ", @disabled);
    534     }
    535 
    536     $resolver="stock";
    537     for(@version) {
    538         chomp;
    539 
    540         if($_ =~ /^curl ([^ ]*)/) {
    541             $curl = $_;
    542             $CURLVERSION = $1;
    543             $CURLVERNUM = $CURLVERSION;
    544             $CURLVERNUM =~ s/^([0-9.]+)(.*)/$1/; # leading dots and numbers
    545             $curl =~ s/^(.*)(libcurl.*)/$1/g || die "Failure determining curl binary version";
    546 
    547             $libcurl = $2;
    548             if($curl =~ /win32|Windows|windows|mingw(32|64)/) {
    549                 # This is a Windows MinGW build or native build, we need to use
    550                 # Windows-style path.
    551                 $pwd = sys_native_current_path();
    552                 $feature{"win32"} = 1;
    553             }
    554             if($libcurl =~ /\sschannel\b/i) {
    555                 $feature{"Schannel"} = 1;
    556                 $feature{"SSLpinning"} = 1;
    557             }
    558             elsif($libcurl =~ /\sopenssl\b/i) {
    559                 $feature{"OpenSSL"} = 1;
    560                 $feature{"SSLpinning"} = 1;
    561             }
    562             elsif($libcurl =~ /\sgnutls\b/i) {
    563                 $feature{"GnuTLS"} = 1;
    564                 $feature{"SSLpinning"} = 1;
    565             }
    566             elsif($libcurl =~ /\srustls-ffi\b/i) {
    567                 $feature{"rustls"} = 1;
    568             }
    569             elsif($libcurl =~ /\swolfssl\b/i) {
    570                 $feature{"wolfssl"} = 1;
    571                 $feature{"SSLpinning"} = 1;
    572             }
    573             elsif($libcurl =~ /\s(BoringSSL|AWS-LC)\b/i) {
    574                 # OpenSSL compatible API
    575                 $feature{"OpenSSL"} = 1;
    576                 $feature{"SSLpinning"} = 1;
    577             }
    578             elsif($libcurl =~ /\slibressl\b/i) {
    579                 # OpenSSL compatible API
    580                 $feature{"OpenSSL"} = 1;
    581                 $feature{"SSLpinning"} = 1;
    582             }
    583             elsif($libcurl =~ /\squictls\b/i) {
    584                 # OpenSSL compatible API
    585                 $feature{"OpenSSL"} = 1;
    586                 $feature{"SSLpinning"} = 1;
    587             }
    588             elsif($libcurl =~ /\smbedTLS\b/i) {
    589                 $feature{"mbedtls"} = 1;
    590                 $feature{"SSLpinning"} = 1;
    591             }
    592             if($libcurl =~ /ares/i) {
    593                 $feature{"c-ares"} = 1;
    594                 $resolver="c-ares";
    595             }
    596             if($libcurl =~ /nghttp2/i) {
    597                 # nghttp2 supports h2c
    598                 $feature{"h2c"} = 1;
    599             }
    600             if($libcurl =~ /AppleIDN/) {
    601                 $feature{"AppleIDN"} = 1;
    602             }
    603             if($libcurl =~ /WinIDN/) {
    604                 $feature{"WinIDN"} = 1;
    605             }
    606             if($libcurl =~ /libidn2/) {
    607                 $feature{"libidn2"} = 1;
    608             }
    609             if($libcurl =~ /libssh2/i) {
    610                 $feature{"libssh2"} = 1;
    611             }
    612             if($libcurl =~ /libssh\/([0-9.]*)\//i) {
    613                 $feature{"libssh"} = 1;
    614                 if($1 =~ /(\d+)\.(\d+).(\d+)/) {
    615                     my $v = $1 * 100 + $2 * 10 + $3;
    616                     if($v < 94) {
    617                         # before 0.9.4
    618                         $feature{"oldlibssh"} = 1;
    619                     }
    620                 }
    621             }
    622             if($libcurl =~ /wolfssh/i) {
    623                 $feature{"wolfssh"} = 1;
    624             }
    625         }
    626         elsif($_ =~ /^Protocols: (.*)/i) {
    627             $proto = $1;
    628             # these are the protocols compiled in to this libcurl
    629             parseprotocols($proto);
    630         }
    631         elsif($_ =~ /^Features: (.*)/i) {
    632             $feat = $1;
    633 
    634             # built with memory tracking support (--enable-curldebug); may be disabled later
    635             $feature{"TrackMemory"} = $feat =~ /TrackMemory/i;
    636             # curl was built with --enable-debug
    637             $feature{"Debug"} = $feat =~ /Debug/i;
    638             # ssl enabled
    639             $feature{"SSL"} = $feat =~ /SSL/i;
    640             # multiple ssl backends available.
    641             $feature{"MultiSSL"} = $feat =~ /MultiSSL/i;
    642             # large file support
    643             $feature{"Largefile"} = $feat =~ /Largefile/i;
    644             # IDN support
    645             $feature{"IDN"} = $feat =~ /IDN/i;
    646             # IPv6 support
    647             $feature{"IPv6"} = $feat =~ /IPv6/i;
    648             # Unix sockets support
    649             $feature{"UnixSockets"} = $feat =~ /UnixSockets/i;
    650             # libz compression
    651             $feature{"libz"} = $feat =~ /libz/i;
    652             # Brotli compression
    653             $feature{"brotli"} = $feat =~ /brotli/i;
    654             # Zstd compression
    655             $feature{"zstd"} = $feat =~ /zstd/i;
    656             # NTLM enabled
    657             $feature{"NTLM"} = $feat =~ /NTLM/i;
    658             # NTLM delegation to winbind daemon ntlm_auth helper enabled
    659             $feature{"NTLM_WB"} = $feat =~ /NTLM_WB/i;
    660             # SSPI enabled
    661             $feature{"SSPI"} = $feat =~ /SSPI/i;
    662             # GSS-API enabled
    663             $feature{"GSS-API"} = $feat =~ /GSS-API/i;
    664             # Kerberos enabled
    665             $feature{"Kerberos"} = $feat =~ /Kerberos/i;
    666             # SPNEGO enabled
    667             $feature{"SPNEGO"} = $feat =~ /SPNEGO/i;
    668             # TLS-SRP enabled
    669             $feature{"TLS-SRP"} = $feat =~ /TLS-SRP/i;
    670             # PSL enabled
    671             $feature{"PSL"} = $feat =~ /PSL/i;
    672             # alt-svc enabled
    673             $feature{"alt-svc"} = $feat =~ /alt-svc/i;
    674             # HSTS support
    675             $feature{"HSTS"} = $feat =~ /HSTS/i;
    676             $feature{"asyn-rr"} = $feat =~ /asyn-rr/;
    677             if($feat =~ /AsynchDNS/i) {
    678                 if(!$feature{"c-ares"} || $feature{"asyn-rr"}) {
    679                     # this means threaded resolver
    680                     $feature{"threaded-resolver"} = 1;
    681                     $resolver="threaded";
    682 
    683                     # does not count as "real" c-ares
    684                     $feature{"c-ares"} = 0;
    685                 }
    686             }
    687             # http2 enabled
    688             $feature{"http/2"} = $feat =~ /HTTP2/;
    689             if($feature{"http/2"}) {
    690                 push @protocols, 'http/2';
    691             }
    692             # http3 enabled
    693             $feature{"http/3"} = $feat =~ /HTTP3/;
    694             if($feature{"http/3"}) {
    695                 push @protocols, 'http/3';
    696             }
    697             # https proxy support
    698             $feature{"HTTPS-proxy"} = $feat =~ /HTTPS-proxy/;
    699             if($feature{"HTTPS-proxy"}) {
    700                 # 'https-proxy' is used as "server" so consider it a protocol
    701                 push @protocols, 'https-proxy';
    702             }
    703             # Unicode support
    704             $feature{"Unicode"} = $feat =~ /Unicode/i;
    705             # Thread-safe init
    706             $feature{"threadsafe"} = $feat =~ /threadsafe/i;
    707             $feature{"HTTPSRR"} = $feat =~ /HTTPSRR/;
    708             $feature{"ECH"} = $feat =~ /ECH/;
    709         }
    710         #
    711         # Test harness currently uses a non-stunnel server in order to
    712         # run HTTP TLS-SRP tests required when curl is built with https
    713         # protocol support and TLS-SRP feature enabled. For convenience
    714         # 'httptls' may be included in the test harness protocols array
    715         # to differentiate this from classic stunnel based 'https' test
    716         # harness server.
    717         #
    718         if($feature{"TLS-SRP"}) {
    719             my $add_httptls;
    720             for(@protocols) {
    721                 if($_ =~ /^https(-ipv6|)$/) {
    722                     $add_httptls=1;
    723                     last;
    724                 }
    725             }
    726             if($add_httptls && (! grep /^httptls$/, @protocols)) {
    727                 push @protocols, 'httptls';
    728                 push @protocols, 'httptls-ipv6';
    729             }
    730         }
    731     }
    732 
    733     if(!$curl) {
    734         logmsg "unable to get curl's version, further details are:\n";
    735         logmsg "issued command: \n";
    736         logmsg "$versioncmd \n";
    737         if($versretval == -1) {
    738             logmsg "command failed with: \n";
    739             logmsg "$versnoexec \n";
    740         }
    741         elsif($versretval & 127) {
    742             logmsg sprintf("command died with signal %d, and %s coredump.\n",
    743                            ($versretval & 127), ($versretval & 128)?"a":"no");
    744         }
    745         else {
    746             logmsg sprintf("command exited with value %d \n", $versretval >> 8);
    747         }
    748         logmsg "contents of $curlverout: \n";
    749         displaylogcontent("$curlverout");
    750         logmsg "contents of $curlvererr: \n";
    751         displaylogcontent("$curlvererr");
    752         die "couldn't get curl's version";
    753     }
    754 
    755     if(-r "../lib/curl_config.h") {
    756         open(my $conf, "<", "../lib/curl_config.h");
    757         while(<$conf>) {
    758             if($_ =~ /^\#define HAVE_GETRLIMIT/) {
    759                 # set if system has getrlimit()
    760                 $feature{"getrlimit"} = 1;
    761             }
    762         }
    763         close($conf);
    764     }
    765 
    766     if($feature{"IPv6"}) {
    767         # client has IPv6 support
    768 
    769         # check if the HTTP server has it!
    770         my $cmd = server_exe('sws')." --version";
    771         my @sws = `$cmd`;
    772         if($sws[0] =~ /IPv6/) {
    773             # HTTP server has IPv6 support!
    774             $http_ipv6 = 1;
    775         }
    776 
    777         # check if the FTP server has it!
    778         $cmd = server_exe('sockfilt')." --version";
    779         @sws = `$cmd`;
    780         if($sws[0] =~ /IPv6/) {
    781             # FTP server has IPv6 support!
    782             $ftp_ipv6 = 1;
    783         }
    784     }
    785 
    786     if($feature{"UnixSockets"}) {
    787         # client has Unix sockets support, check whether the HTTP server has it
    788         my $cmd = server_exe('sws')." --version";
    789         my @sws = `$cmd`;
    790         $http_unix = 1 if($sws[0] =~ /unix/);
    791     }
    792 
    793     open(my $manh, "-|", shell_quote($CURL) . " -M 2>&1");
    794     while(my $s = <$manh>) {
    795         if($s =~ /built-in manual was disabled at build-time/) {
    796             $feature{"manual"} = 0;
    797             last;
    798         }
    799         $feature{"manual"} = 1;
    800         last;
    801     }
    802     close($manh);
    803 
    804     $feature{"unittest"} = 1;
    805     $feature{"nghttpx"} = !!$ENV{'NGHTTPX'};
    806     $feature{"nghttpx-h3"} = !!$nghttpx_h3;
    807 
    808     # Use this as a proxy for any cryptographic authentication
    809     $feature{"crypto"} = $feature{"NTLM"} || $feature{"Kerberos"} || $feature{"SPNEGO"};
    810     $feature{"local-http"} = servers::localhttp();
    811     $feature{"codeset-utf8"} = lc(langinfo(CODESET())) eq "utf-8";
    812 
    813     # make each protocol an enabled "feature"
    814     for my $p (@protocols) {
    815         $feature{$p} = 1;
    816     }
    817     # 'socks' was once here but is now removed
    818 
    819     if($torture) {
    820         if(!$feature{"TrackMemory"}) {
    821             die "can't run torture tests since curl was built without ".
    822                 "TrackMemory feature (--enable-curldebug)";
    823         }
    824         if($feature{"threaded-resolver"} && !$valgrind) {
    825             die "can't run torture tests since curl was built with the ".
    826                 "threaded resolver, and we aren't running with valgrind";
    827         }
    828     }
    829 
    830     my $hostname=join(' ', runclientoutput("hostname"));
    831     chomp $hostname;
    832     my $hosttype=join(' ', runclientoutput("uname -a"));
    833     chomp $hosttype;
    834     my $hostos=$^O;
    835 
    836     my $havediff;
    837     if(system("diff $TESTDIR/DISABLED $TESTDIR/DISABLED 2>$dev_null") == 0) {
    838       $havediff = 'available';
    839     }
    840     else {
    841       $havediff = 'missing';
    842     }
    843 
    844     # display summary information about curl and the test host
    845     logmsg ("********* System characteristics ******** \n",
    846             "* $curl\n",
    847             "* $libcurl\n",
    848             "* Protocols: $proto\n",
    849             "* Features: $feat\n",
    850             "* Disabled: $dis\n",
    851             "* Host: $hostname\n",
    852             "* System: $hosttype\n",
    853             "* OS: $hostos\n",
    854             "* Perl: $^V ($^X)\n",
    855             "* diff: $havediff\n",
    856             "* Args: $args\n");
    857 
    858     if($jobs) {
    859         # Only show if not the default for now
    860         logmsg "* Jobs: $jobs\n";
    861     }
    862     # Disable memory tracking when using threaded resolver
    863     if($feature{"TrackMemory"} && $feature{"threaded-resolver"}) {
    864         logmsg("*\n",
    865                "*** DISABLES TrackMemory (memory tracking) when using threaded resolver\n",
    866                "*\n");
    867         $feature{"TrackMemory"} = 0;
    868     }
    869 
    870     logmsg sprintf("* Env: %s%s%s%s", $valgrind?"Valgrind ":"",
    871                    $run_duphandle?"test-duphandle ":"",
    872                    $run_event_based?"event-based ":"",
    873                    $nghttpx_h3);
    874     logmsg sprintf("%s\n", $libtool?"Libtool ":"");
    875     logmsg ("* Seed: $randseed\n");
    876 }
    877 
    878 #######################################################################
    879 # display information about server features
    880 #
    881 sub displayserverfeatures {
    882     logmsg sprintf("* Servers: %s", $stunnel?"SSL ":"");
    883     logmsg sprintf("%s", $http_ipv6?"HTTP-IPv6 ":"");
    884     logmsg sprintf("%s", $http_unix?"HTTP-unix ":"");
    885     logmsg sprintf("%s\n", $ftp_ipv6?"FTP-IPv6 ":"");
    886     logmsg "***************************************** \n";
    887 }
    888 
    889 #######################################################################
    890 # Provide time stamps for single test skipped events
    891 #
    892 sub timestampskippedevents {
    893     my $testnum = $_[0];
    894 
    895     return if((not defined($testnum)) || ($testnum < 1));
    896 
    897     if($timestats) {
    898 
    899         if($timevrfyend{$testnum}) {
    900             return;
    901         }
    902         elsif($timesrvrlog{$testnum}) {
    903             $timevrfyend{$testnum} = $timesrvrlog{$testnum};
    904             return;
    905         }
    906         elsif($timetoolend{$testnum}) {
    907             $timevrfyend{$testnum} = $timetoolend{$testnum};
    908             $timesrvrlog{$testnum} = $timetoolend{$testnum};
    909         }
    910         elsif($timetoolini{$testnum}) {
    911             $timevrfyend{$testnum} = $timetoolini{$testnum};
    912             $timesrvrlog{$testnum} = $timetoolini{$testnum};
    913             $timetoolend{$testnum} = $timetoolini{$testnum};
    914         }
    915         elsif($timesrvrend{$testnum}) {
    916             $timevrfyend{$testnum} = $timesrvrend{$testnum};
    917             $timesrvrlog{$testnum} = $timesrvrend{$testnum};
    918             $timetoolend{$testnum} = $timesrvrend{$testnum};
    919             $timetoolini{$testnum} = $timesrvrend{$testnum};
    920         }
    921         elsif($timesrvrini{$testnum}) {
    922             $timevrfyend{$testnum} = $timesrvrini{$testnum};
    923             $timesrvrlog{$testnum} = $timesrvrini{$testnum};
    924             $timetoolend{$testnum} = $timesrvrini{$testnum};
    925             $timetoolini{$testnum} = $timesrvrini{$testnum};
    926             $timesrvrend{$testnum} = $timesrvrini{$testnum};
    927         }
    928         elsif($timeprepini{$testnum}) {
    929             $timevrfyend{$testnum} = $timeprepini{$testnum};
    930             $timesrvrlog{$testnum} = $timeprepini{$testnum};
    931             $timetoolend{$testnum} = $timeprepini{$testnum};
    932             $timetoolini{$testnum} = $timeprepini{$testnum};
    933             $timesrvrend{$testnum} = $timeprepini{$testnum};
    934             $timesrvrini{$testnum} = $timeprepini{$testnum};
    935         }
    936     }
    937 }
    938 
    939 
    940 # Setup CI Test Run
    941 sub citest_starttestrun {
    942     if(azure_check_environment()) {
    943         $AZURE_RUN_ID = azure_create_test_run($ACURL);
    944         logmsg "Azure Run ID: $AZURE_RUN_ID\n" if($verbose);
    945     }
    946     # Appveyor doesn't require anything here
    947 }
    948 
    949 
    950 # Register the test case with the CI runner
    951 sub citest_starttest {
    952     my $testnum = $_[0];
    953 
    954     # get the name of the test early
    955     my $testname= (getpart("client", "name"))[0];
    956     chomp $testname;
    957 
    958     # create test result in CI services
    959     if(azure_check_environment() && $AZURE_RUN_ID) {
    960         $AZURE_RESULT_ID = azure_create_test_result($ACURL, $AZURE_RUN_ID, $testnum, $testname);
    961     }
    962     elsif(appveyor_check_environment()) {
    963         appveyor_create_test_result($ACURL, $testnum, $testname);
    964     }
    965 }
    966 
    967 
    968 # Submit the test case result with the CI runner
    969 sub citest_finishtest {
    970     my ($testnum, $error) = @_;
    971     # update test result in CI services
    972     if(azure_check_environment() && $AZURE_RUN_ID && $AZURE_RESULT_ID) {
    973         $AZURE_RESULT_ID = azure_update_test_result($ACURL, $AZURE_RUN_ID, $AZURE_RESULT_ID, $testnum, $error,
    974                                                     $timeprepini{$testnum}, $timevrfyend{$testnum});
    975     }
    976     elsif(appveyor_check_environment()) {
    977         appveyor_update_test_result($ACURL, $testnum, $error, $timeprepini{$testnum}, $timevrfyend{$testnum});
    978     }
    979 }
    980 
    981 # Complete CI test run
    982 sub citest_finishtestrun {
    983     if(azure_check_environment() && $AZURE_RUN_ID) {
    984         $AZURE_RUN_ID = azure_update_test_run($ACURL, $AZURE_RUN_ID);
    985     }
    986     # Appveyor doesn't require anything here
    987 }
    988 
    989 
    990 # add one set of test timings from the runner to global set
    991 sub updatetesttimings {
    992     my ($testnum, %testtimings)=@_;
    993 
    994     if(defined $testtimings{"timeprepini"}) {
    995         $timeprepini{$testnum} = $testtimings{"timeprepini"};
    996     }
    997     if(defined $testtimings{"timesrvrini"}) {
    998         $timesrvrini{$testnum} = $testtimings{"timesrvrini"};
    999     }
   1000     if(defined $testtimings{"timesrvrend"}) {
   1001         $timesrvrend{$testnum} = $testtimings{"timesrvrend"};
   1002     }
   1003     if(defined $testtimings{"timetoolini"}) {
   1004         $timetoolini{$testnum} = $testtimings{"timetoolini"};
   1005     }
   1006     if(defined $testtimings{"timetoolend"}) {
   1007         $timetoolend{$testnum} = $testtimings{"timetoolend"};
   1008     }
   1009     if(defined $testtimings{"timesrvrlog"}) {
   1010         $timesrvrlog{$testnum} = $testtimings{"timesrvrlog"};
   1011     }
   1012 }
   1013 
   1014 
   1015 #######################################################################
   1016 # Return the log directory for the given test runner
   1017 sub getrunnernumlogdir {
   1018     my $runnernum = $_[0];
   1019     return $jobs > 1 ? "$LOGDIR/$runnernum" : $LOGDIR;
   1020 }
   1021 
   1022 #######################################################################
   1023 # Return the log directory for the given test runner ID
   1024 sub getrunnerlogdir {
   1025     my $runnerid = $_[0];
   1026     if($jobs <= 1) {
   1027         return $LOGDIR;
   1028     }
   1029     # TODO: speed up this O(n) operation
   1030     for my $runnernum (keys %runnerids) {
   1031         if($runnerid eq $runnerids{$runnernum}) {
   1032             return "$LOGDIR/$runnernum";
   1033         }
   1034     }
   1035     die "Internal error: runner ID $runnerid not found";
   1036 }
   1037 
   1038 
   1039 #######################################################################
   1040 # Verify that this test case should be run
   1041 sub singletest_shouldrun {
   1042     my $testnum = $_[0];
   1043     my $why;   # why the test won't be run
   1044     my $errorreturncode = 1; # 1 means normal error, 2 means ignored error
   1045     my @what;  # what features are needed
   1046 
   1047     if($disttests !~ /test$testnum(\W|\z)/ ) {
   1048         logmsg "Warning: test$testnum not present in tests/data/Makefile.am\n";
   1049     }
   1050     if($disabled{$testnum}) {
   1051         if(!$run_disabled) {
   1052             $why = "listed in DISABLED";
   1053         }
   1054         else {
   1055             logmsg "Warning: test$testnum is explicitly disabled\n";
   1056         }
   1057     }
   1058     if($ignored{$testnum}) {
   1059         logmsg "Warning: test$testnum result is ignored\n";
   1060         $errorreturncode = 2;
   1061     }
   1062 
   1063     if(loadtest("${TESTDIR}/test${testnum}")) {
   1064         if($verbose) {
   1065             # this is not a test
   1066             logmsg "RUN: $testnum doesn't look like a test case\n";
   1067         }
   1068         $why = "no test";
   1069     }
   1070     else {
   1071         @what = getpart("client", "features");
   1072     }
   1073 
   1074     # We require a feature to be present
   1075     for(@what) {
   1076         my $f = $_;
   1077         $f =~ s/\s//g;
   1078 
   1079         if($f =~ /^([^!].*)$/) {
   1080             if($feature{$1}) {
   1081                 next;
   1082             }
   1083 
   1084             $why = "curl lacks $1 support";
   1085             last;
   1086         }
   1087     }
   1088 
   1089     # We require a feature to not be present
   1090     if(!$why) {
   1091         for(@what) {
   1092             my $f = $_;
   1093             $f =~ s/\s//g;
   1094 
   1095             if($f =~ /^!(.*)$/) {
   1096                 if(!$feature{$1}) {
   1097                     next;
   1098                 }
   1099             }
   1100             else {
   1101                 next;
   1102             }
   1103 
   1104             $why = "curl has $1 support";
   1105             last;
   1106         }
   1107     }
   1108 
   1109     my @info_keywords;
   1110     if(!$why) {
   1111         @info_keywords = getpart("info", "keywords");
   1112 
   1113         if(!$info_keywords[0]) {
   1114             $why = "missing the <keywords> section!";
   1115         }
   1116         # Only evaluate keywords if the section is present.
   1117         else {
   1118             # Prefix features with "feat:" and add to keywords list.
   1119             push @info_keywords, map { "feat:" . lc($_) } getpart("client", "features");
   1120 
   1121             my $match;
   1122             for my $k (@info_keywords) {
   1123                 chomp $k;
   1124                 if($disabled_keywords{lc($k)}) {
   1125                     if($k =~ /^feat:/) {
   1126                         $why = "disabled by feature";
   1127                     }
   1128                     else {
   1129                         $why = "disabled by keyword";
   1130                     }
   1131                 }
   1132                 elsif($enabled_keywords{lc($k)}) {
   1133                     $match = 1;
   1134                 }
   1135                 if($ignored_keywords{lc($k)}) {
   1136                     logmsg "Warning: test$testnum result is ignored due to $k\n";
   1137                     $errorreturncode = 2;
   1138                 }
   1139             }
   1140 
   1141             if(!$why && !$match && %enabled_keywords) {
   1142                 if(grep { /^feat:/ } keys %enabled_keywords) {
   1143                     $why = "disabled by missing feature";
   1144                 }
   1145                 else {
   1146                     $why = "disabled by missing keyword";
   1147                 }
   1148             }
   1149         }
   1150     }
   1151 
   1152     if(!$why && defined $custom_skip_reasons{test}{$testnum}) {
   1153         $why = $custom_skip_reasons{test}{$testnum};
   1154     }
   1155 
   1156     if(!$why && defined $custom_skip_reasons{tool}) {
   1157         foreach my $tool (getpart("client", "tool")) {
   1158             foreach my $tool_skip_pattern (keys %{$custom_skip_reasons{tool}}) {
   1159                 if($tool =~ /$tool_skip_pattern/i) {
   1160                     $why = $custom_skip_reasons{tool}{$tool_skip_pattern};
   1161                 }
   1162             }
   1163         }
   1164     }
   1165 
   1166     if(!$why && defined $custom_skip_reasons{keyword}) {
   1167         foreach my $keyword (@info_keywords) {
   1168             foreach my $keyword_skip_pattern (keys %{$custom_skip_reasons{keyword}}) {
   1169                 if($keyword =~ /$keyword_skip_pattern/i) {
   1170                     $why = $custom_skip_reasons{keyword}{$keyword_skip_pattern};
   1171                 }
   1172             }
   1173         }
   1174     }
   1175 
   1176     return ($why, $errorreturncode);
   1177 }
   1178 
   1179 
   1180 #######################################################################
   1181 # Print the test name and count tests
   1182 sub singletest_count {
   1183     my ($testnum, $why) = @_;
   1184 
   1185     if($why && !$listonly) {
   1186         # there's a problem, count it as "skipped"
   1187         $skipped{$why}++;
   1188         $teststat[$testnum]=$why; # store reason for this test case
   1189 
   1190         if(!$short) {
   1191             if($skipped{$why} <= 3) {
   1192                 # show only the first three skips for each reason
   1193                 logmsg sprintf("test %04d SKIPPED: $why\n", $testnum);
   1194             }
   1195         }
   1196 
   1197         timestampskippedevents($testnum);
   1198         return -1;
   1199     }
   1200 
   1201     # At this point we've committed to run this test
   1202     logmsg sprintf("test %04d...", $testnum) if(!$automakestyle);
   1203 
   1204     # name of the test
   1205     my $testname= (getpart("client", "name"))[0];
   1206     chomp $testname;
   1207     logmsg "[$testname]\n" if(!$short);
   1208 
   1209     if($listonly) {
   1210         timestampskippedevents($testnum);
   1211     }
   1212     return 0;
   1213 }
   1214 
   1215 # Make sure all line endings in the array are the same: CRLF
   1216 sub normalize_text {
   1217     my ($ref) = @_;
   1218     s/\r\n/\n/g for @$ref;
   1219     s/\n/\r\n/g for @$ref;
   1220 }
   1221 
   1222 #######################################################################
   1223 # Verify test succeeded
   1224 sub singletest_check {
   1225     my ($runnerid, $testnum, $cmdres, $CURLOUT, $tool, $usedvalgrind)=@_;
   1226 
   1227     # Skip all the verification on torture tests
   1228     if($torture) {
   1229         # timestamp test result verification end
   1230         $timevrfyend{$testnum} = Time::HiRes::time();
   1231         return -2;
   1232     }
   1233 
   1234     my $logdir = getrunnerlogdir($runnerid);
   1235     my @err = getpart("verify", "errorcode");
   1236     my $errorcode = $err[0] || "0";
   1237     my $ok="";
   1238     my $res;
   1239     chomp $errorcode;
   1240     my $testname= (getpart("client", "name"))[0];
   1241     chomp $testname;
   1242     # what parts to cut off from stdout/stderr
   1243     my @stripfile = getpart("verify", "stripfile");
   1244 
   1245     my @validstdout = getpart("verify", "stdout");
   1246     # get all attributes
   1247     my %hash = getpartattr("verify", "stdout");
   1248 
   1249     my $loadfile = $hash{'loadfile'};
   1250     if($loadfile) {
   1251         open(my $tmp, "<", "$loadfile") || die "Cannot open file $loadfile: $!";
   1252         @validstdout = <$tmp>;
   1253         close($tmp);
   1254 
   1255         # Enforce LF newlines on load
   1256         s/\r\n/\n/g for @validstdout;
   1257     }
   1258 
   1259     if(@validstdout) {
   1260         # verify redirected stdout
   1261         my @actual = loadarray(stdoutfilename($logdir, $testnum));
   1262 
   1263         foreach my $strip (@stripfile) {
   1264             chomp $strip;
   1265             my @newgen;
   1266             for(@actual) {
   1267                 eval $strip;
   1268                 if($_) {
   1269                     push @newgen, $_;
   1270                 }
   1271             }
   1272             # this is to get rid of array entries that vanished (zero
   1273             # length) because of replacements
   1274             @actual = @newgen;
   1275         }
   1276 
   1277         # get the mode attribute
   1278         my $filemode=$hash{'mode'};
   1279         if($filemode && ($filemode eq "text")) {
   1280             normalize_text(\@validstdout);
   1281             normalize_text(\@actual);
   1282         }
   1283 
   1284         if($hash{'nonewline'}) {
   1285             # Yes, we must cut off the final newline from the final line
   1286             # of the protocol data
   1287             chomp($validstdout[-1]);
   1288         }
   1289 
   1290         if($hash{'crlf'}) {
   1291             subnewlines(0, \$_) for @validstdout;
   1292         }
   1293 
   1294         $res = compare($runnerid, $testnum, $testname, "stdout", \@actual, \@validstdout);
   1295         if($res) {
   1296             return -1;
   1297         }
   1298         $ok .= "s";
   1299     }
   1300     else {
   1301         $ok .= "-"; # stdout not checked
   1302     }
   1303 
   1304     my @validstderr = getpart("verify", "stderr");
   1305     if(@validstderr) {
   1306         # verify redirected stderr
   1307         my @actual = loadarray(stderrfilename($logdir, $testnum));
   1308 
   1309         foreach my $strip (@stripfile) {
   1310             chomp $strip;
   1311             my @newgen;
   1312             for(@actual) {
   1313                 eval $strip;
   1314                 if($_) {
   1315                     push @newgen, $_;
   1316                 }
   1317             }
   1318             # this is to get rid of array entries that vanished (zero
   1319             # length) because of replacements
   1320             @actual = @newgen;
   1321         }
   1322 
   1323         # get all attributes
   1324         my %hash = getpartattr("verify", "stderr");
   1325 
   1326         # get the mode attribute
   1327         my $filemode=$hash{'mode'};
   1328         if($filemode && ($filemode eq "text")) {
   1329             normalize_text(\@validstderr);
   1330             normalize_text(\@actual);
   1331         }
   1332 
   1333         if($hash{'nonewline'}) {
   1334             # Yes, we must cut off the final newline from the final line
   1335             # of the protocol data
   1336             chomp($validstderr[-1]);
   1337         }
   1338 
   1339         if($hash{'crlf'}) {
   1340             subnewlines(0, \$_) for @validstderr;
   1341         }
   1342 
   1343         $res = compare($runnerid, $testnum, $testname, "stderr", \@actual, \@validstderr);
   1344         if($res) {
   1345             return -1;
   1346         }
   1347         $ok .= "r";
   1348     }
   1349     else {
   1350         $ok .= "-"; # stderr not checked
   1351     }
   1352 
   1353     # what to cut off from the live protocol sent by curl
   1354     my @strip = getpart("verify", "strip");
   1355 
   1356     # what parts to cut off from the protocol & upload
   1357     my @strippart = getpart("verify", "strippart");
   1358 
   1359     # this is the valid protocol blurb curl should generate
   1360     my @protocol= getpart("verify", "protocol");
   1361     if(@protocol) {
   1362         # Verify the sent request
   1363         my @out = loadarray("$logdir/$SERVERIN");
   1364 
   1365         # check if there's any attributes on the verify/protocol section
   1366         my %hash = getpartattr("verify", "protocol");
   1367 
   1368         if($hash{'nonewline'}) {
   1369             # Yes, we must cut off the final newline from the final line
   1370             # of the protocol data
   1371             chomp($protocol[-1]);
   1372         }
   1373 
   1374         for(@strip) {
   1375             # strip off all lines that match the patterns from both arrays
   1376             chomp $_;
   1377             @out = striparray( $_, \@out);
   1378             @protocol= striparray( $_, \@protocol);
   1379         }
   1380 
   1381         for my $strip (@strippart) {
   1382             chomp $strip;
   1383             for(@out) {
   1384                 eval $strip;
   1385             }
   1386         }
   1387 
   1388         if($hash{'crlf'}) {
   1389             subnewlines(1, \$_) for @protocol;
   1390         }
   1391 
   1392         if((!$out[0] || ($out[0] eq "")) && $protocol[0]) {
   1393             logmsg "\n $testnum: protocol FAILED!\n".
   1394                 " There was no content at all in the file $logdir/$SERVERIN.\n".
   1395                 " Server glitch? Total curl failure? Returned: $cmdres\n";
   1396             # timestamp test result verification end
   1397             $timevrfyend{$testnum} = Time::HiRes::time();
   1398             return -1;
   1399         }
   1400 
   1401         $res = compare($runnerid, $testnum, $testname, "protocol", \@out, \@protocol);
   1402         if($res) {
   1403             return -1;
   1404         }
   1405 
   1406         $ok .= "p";
   1407 
   1408     }
   1409     else {
   1410         $ok .= "-"; # protocol not checked
   1411     }
   1412 
   1413     my %replyattr = getpartattr("reply", "data");
   1414     my @reply;
   1415     if(partexists("reply", "datacheck")) {
   1416         for my $partsuffix (('', '1', '2', '3', '4')) {
   1417             my @replycheckpart = getpart("reply", "datacheck".$partsuffix);
   1418             if(@replycheckpart) {
   1419                 my %replycheckpartattr = getpartattr("reply", "datacheck".$partsuffix);
   1420                 # get the mode attribute
   1421                 my $filemode=$replycheckpartattr{'mode'};
   1422                 if($filemode && ($filemode eq "text")) {
   1423                     normalize_text(\@replycheckpart);
   1424                 }
   1425                 if($replycheckpartattr{'nonewline'}) {
   1426                     # Yes, we must cut off the final newline from the final line
   1427                     # of the datacheck
   1428                     chomp($replycheckpart[-1]);
   1429                 }
   1430                 if($replycheckpartattr{'crlf'}) {
   1431                     subnewlines(0, \$_) for @replycheckpart;
   1432                 }
   1433                 push(@reply, @replycheckpart);
   1434             }
   1435         }
   1436     }
   1437     else {
   1438         # check against the data section
   1439         @reply = getpart("reply", "data");
   1440         if(@reply) {
   1441             if($replyattr{'nonewline'}) {
   1442                 # cut off the final newline from the final line of the data
   1443                 chomp($reply[-1]);
   1444             }
   1445         }
   1446         # get the mode attribute
   1447         my $filemode=$replyattr{'mode'};
   1448         if($filemode && ($filemode eq "text")) {
   1449             normalize_text(\@reply);
   1450         }
   1451         if($replyattr{'crlf'}) {
   1452             subnewlines(0, \$_) for @reply;
   1453         }
   1454     }
   1455 
   1456     if(!$replyattr{'nocheck'} && (@reply || $replyattr{'sendzero'})) {
   1457         # verify the received data
   1458         my @out = loadarray($CURLOUT);
   1459 
   1460         # get the mode attribute
   1461         my $filemode=$replyattr{'mode'};
   1462         if($filemode && ($filemode eq "text")) {
   1463             normalize_text(\@out);
   1464         }
   1465         $res = compare($runnerid, $testnum, $testname, "data", \@out, \@reply);
   1466         if($res) {
   1467             return -1;
   1468         }
   1469         $ok .= "d";
   1470     }
   1471     else {
   1472         $ok .= "-"; # data not checked
   1473     }
   1474 
   1475     # if this section exists, we verify upload
   1476     my @upload = getpart("verify", "upload");
   1477     if(@upload) {
   1478         my %hash = getpartattr("verify", "upload");
   1479         if($hash{'nonewline'}) {
   1480             # cut off the final newline from the final line of the upload data
   1481             chomp($upload[-1]);
   1482         }
   1483         for my $line (@upload) {
   1484             subbase64(\$line);
   1485             subsha256base64file(\$line);
   1486             substrippemfile(\$line);
   1487         }
   1488 
   1489         # verify uploaded data
   1490         my @out = loadarray("$logdir/upload.$testnum");
   1491         for my $strip (@strippart) {
   1492             chomp $strip;
   1493             for(@out) {
   1494                 eval $strip;
   1495             }
   1496         }
   1497         if($hash{'crlf'}) {
   1498             subnewlines(1, \$_) for @upload;
   1499         }
   1500         if($hash{'nonewline'}) {
   1501             # Yes, we must cut off the final newline from the final line
   1502             # of the upload data
   1503             chomp($upload[-1]);
   1504         }
   1505 
   1506         $res = compare($runnerid, $testnum, $testname, "upload", \@out, \@upload);
   1507         if($res) {
   1508             return -1;
   1509         }
   1510         $ok .= "u";
   1511     }
   1512     else {
   1513         $ok .= "-"; # upload not checked
   1514     }
   1515 
   1516     # this is the valid protocol blurb curl should generate to a proxy
   1517     my @proxyprot = getpart("verify", "proxy");
   1518     if(@proxyprot) {
   1519         # Verify the sent proxy request
   1520         # check if there's any attributes on the verify/protocol section
   1521         my %hash = getpartattr("verify", "proxy");
   1522 
   1523         if($hash{'nonewline'}) {
   1524             # Yes, we must cut off the final newline from the final line
   1525             # of the protocol data
   1526             chomp($proxyprot[-1]);
   1527         }
   1528 
   1529         my @out = loadarray("$logdir/$PROXYIN");
   1530         for(@strip) {
   1531             # strip off all lines that match the patterns from both arrays
   1532             chomp $_;
   1533             @out = striparray( $_, \@out);
   1534             @proxyprot= striparray( $_, \@proxyprot);
   1535         }
   1536 
   1537         for my $strip (@strippart) {
   1538             chomp $strip;
   1539             for(@out) {
   1540                 eval $strip;
   1541             }
   1542         }
   1543 
   1544         if($hash{'crlf'}) {
   1545             subnewlines(0, \$_) for @proxyprot;
   1546         }
   1547 
   1548         $res = compare($runnerid, $testnum, $testname, "proxy", \@out, \@proxyprot);
   1549         if($res) {
   1550             return -1;
   1551         }
   1552 
   1553         $ok .= "P";
   1554 
   1555     }
   1556     else {
   1557         $ok .= "-"; # proxy not checked
   1558     }
   1559 
   1560     my $outputok;
   1561     for my $partsuffix (('', '1', '2', '3', '4')) {
   1562         my @outfile=getpart("verify", "file".$partsuffix);
   1563         if(@outfile || partexists("verify", "file".$partsuffix) ) {
   1564             # we're supposed to verify a dynamically generated file!
   1565             my %hash = getpartattr("verify", "file".$partsuffix);
   1566 
   1567             my $filename=$hash{'name'};
   1568             if(!$filename) {
   1569                 logmsg " $testnum: IGNORED: section verify=>file$partsuffix ".
   1570                        "has no name attribute\n";
   1571                 if(runnerac_stopservers($runnerid)) {
   1572                     logmsg "ERROR: runner $runnerid seems to have died\n";
   1573                 } else {
   1574 
   1575                     # TODO: this is a blocking call that will stall the controller,
   1576                     if($verbose) {
   1577                         logmsg "WARNING: blocking call in async function\n";
   1578                     }
   1579                     # but this error condition should never happen except during
   1580                     # development.
   1581                     my ($rid, $unexpected, $logs) = runnerar($runnerid);
   1582                     if(!$rid) {
   1583                         logmsg "ERROR: runner $runnerid seems to have died\n";
   1584                     } else {
   1585                         logmsg $logs;
   1586                     }
   1587                 }
   1588                 # timestamp test result verification end
   1589                 $timevrfyend{$testnum} = Time::HiRes::time();
   1590                 return -1;
   1591             }
   1592             my @generated=loadarray($filename);
   1593 
   1594             # what parts to cut off from the file
   1595             my @stripfilepar = getpart("verify", "stripfile".$partsuffix);
   1596 
   1597             my $filemode=$hash{'mode'};
   1598             if($filemode && ($filemode eq "text")) {
   1599                 normalize_text(\@outfile);
   1600                 normalize_text(\@generated);
   1601             }
   1602             if($hash{'crlf'}) {
   1603                 subnewlines(0, \$_) for @outfile;
   1604             }
   1605 
   1606             for my $strip (@stripfilepar) {
   1607                 chomp $strip;
   1608                 my @newgen;
   1609                 for(@generated) {
   1610                     eval $strip;
   1611                     if($_) {
   1612                         push @newgen, $_;
   1613                     }
   1614                 }
   1615                 # this is to get rid of array entries that vanished (zero
   1616                 # length) because of replacements
   1617                 @generated = @newgen;
   1618             }
   1619 
   1620             if($hash{'nonewline'}) {
   1621                 # cut off the final newline from the final line of the
   1622                 # output data
   1623                 chomp($outfile[-1]);
   1624             }
   1625 
   1626             $res = compare($runnerid, $testnum, $testname, "output ($filename)",
   1627                            \@generated, \@outfile);
   1628             if($res) {
   1629                 return -1;
   1630             }
   1631 
   1632             $outputok = 1; # output checked
   1633         }
   1634     }
   1635     $ok .= ($outputok) ? "o" : "-"; # output checked or not
   1636 
   1637     # verify SOCKS proxy details
   1638     my @socksprot = getpart("verify", "socks");
   1639     if(@socksprot) {
   1640         # Verify the sent SOCKS proxy details
   1641         my @out = loadarray("$logdir/$SOCKSIN");
   1642         $res = compare($runnerid, $testnum, $testname, "socks", \@out, \@socksprot);
   1643         if($res) {
   1644             return -1;
   1645         }
   1646     }
   1647 
   1648     # accept multiple comma-separated error codes
   1649     my @splerr = split(/ *, */, $errorcode);
   1650     my $errok;
   1651     foreach my $e (@splerr) {
   1652         if($e == $cmdres) {
   1653             # a fine error code
   1654             $errok = 1;
   1655             last;
   1656         }
   1657     }
   1658 
   1659     if($errok) {
   1660         $ok .= "e";
   1661     }
   1662     else {
   1663         if(!$short) {
   1664             logmsg sprintf("\n%s returned $cmdres, when expecting %s\n",
   1665                            (!$tool)?"curl":$tool, $errorcode);
   1666         }
   1667         logmsg " $testnum: exit FAILED\n";
   1668         # timestamp test result verification end
   1669         $timevrfyend{$testnum} = Time::HiRes::time();
   1670         return -1;
   1671     }
   1672 
   1673     if($feature{"TrackMemory"}) {
   1674         if(! -f "$logdir/$MEMDUMP") {
   1675             my %cmdhash = getpartattr("client", "command");
   1676             my $cmdtype = $cmdhash{'type'} || "default";
   1677             logmsg "\n** ALERT! memory tracking with no output file?\n"
   1678                 if($cmdtype ne "perl");
   1679             $ok .= "-"; # problem with memory checking
   1680         }
   1681         else {
   1682             my @memdata=`$memanalyze "$logdir/$MEMDUMP"`;
   1683             my $leak=0;
   1684             for(@memdata) {
   1685                 if($_ ne "") {
   1686                     # well it could be other memory problems as well, but
   1687                     # we call it leak for short here
   1688                     $leak=1;
   1689                 }
   1690             }
   1691             if($leak) {
   1692                 logmsg "\n** MEMORY FAILURE\n";
   1693                 logmsg @memdata;
   1694                 # timestamp test result verification end
   1695                 $timevrfyend{$testnum} = Time::HiRes::time();
   1696                 return -1;
   1697             }
   1698             else {
   1699                 $ok .= "m";
   1700             }
   1701             my @more=`$memanalyze -v "$logdir/$MEMDUMP"`;
   1702             my $allocs;
   1703             my $max = 0;
   1704             for(@more) {
   1705                 if(/^Allocations: (\d+)/) {
   1706                     $allocs = $1;
   1707                 }
   1708                 elsif(/^Maximum allocated: (\d+)/) {
   1709                     $max = $1;
   1710                 }
   1711             }
   1712             my @limits = getpart("verify", "limits");
   1713             my $lim_allocs = 1000; # high default values
   1714             my $lim_max = 1000000;
   1715             for(@limits) {
   1716                 if(/^Allocations: (\d+)/i) {
   1717                     $lim_allocs = $1;
   1718                 }
   1719                 elsif(/^Maximum allocated: (\d+)/i) {
   1720                     $lim_max = $1;
   1721                 }
   1722             }
   1723             logmsg "did $allocs allocations, $lim_allocs allowed\n"
   1724                 if($verbose);
   1725 
   1726             logmsg "allocated $max maximum, $lim_max allowed\n"
   1727                 if($verbose);
   1728 
   1729             if($allocs > $lim_allocs) {
   1730                 logmsg "\n** TOO MANY ALLOCS\n";
   1731                 logmsg "$lim_allocs allocations allowed, did $allocs\n";
   1732                 # timestamp test result verification end
   1733                 $timevrfyend{$testnum} = Time::HiRes::time();
   1734                 return -1;
   1735             }
   1736             if($max > $lim_max) {
   1737                 logmsg "\n** TOO MUCH TOTAL ALLOCATION\n";
   1738                 logmsg "$lim_max maximum allocation allowed, did $max\n";
   1739                 # timestamp test result verification end
   1740                 $timevrfyend{$testnum} = Time::HiRes::time();
   1741                 return -1;
   1742             }
   1743         }
   1744     }
   1745     else {
   1746         $ok .= "-"; # memory not checked
   1747     }
   1748 
   1749     my @notexists = getpart("verify", "notexists");
   1750     if(@notexists) {
   1751         # a list of directory entries that must not exist
   1752         my $err;
   1753         while(@notexists) {
   1754             my $fname = shift @notexists;
   1755             chomp $fname;
   1756             if(-e $fname) {
   1757                 logmsg "Found '$fname' when not supposed to exist.\n";
   1758                 $err++;
   1759             }
   1760             elsif($verbose) {
   1761                 logmsg "Found '$fname' confirmed to not exist.\n";
   1762             }
   1763         }
   1764         if($err) {
   1765             return -1;
   1766         }
   1767     }
   1768     if($valgrind) {
   1769         if($usedvalgrind) {
   1770             if(!opendir(DIR, "$logdir")) {
   1771                 logmsg "ERROR: unable to read $logdir\n";
   1772                 # timestamp test result verification end
   1773                 $timevrfyend{$testnum} = Time::HiRes::time();
   1774                 return -1;
   1775             }
   1776             my @files = readdir(DIR);
   1777             closedir(DIR);
   1778             my $vgfile;
   1779             foreach my $file (@files) {
   1780                 if($file =~ /^valgrind$testnum(\..*|)$/) {
   1781                     $vgfile = $file;
   1782                     last;
   1783                 }
   1784             }
   1785             if(!$vgfile) {
   1786                 logmsg "ERROR: valgrind log file missing for test $testnum\n";
   1787                 # timestamp test result verification end
   1788                 $timevrfyend{$testnum} = Time::HiRes::time();
   1789                 return -1;
   1790             }
   1791             my @e = valgrindparse("$logdir/$vgfile");
   1792             if(@e && $e[0]) {
   1793                 if($automakestyle) {
   1794                     logmsg "FAIL: $testnum - $testname - valgrind\n";
   1795                 }
   1796                 else {
   1797                     logmsg " valgrind ERROR ";
   1798                     logmsg @e;
   1799                 }
   1800                 # timestamp test result verification end
   1801                 $timevrfyend{$testnum} = Time::HiRes::time();
   1802                 return -1;
   1803             }
   1804             $ok .= "v";
   1805         }
   1806         else {
   1807             if($verbose) {
   1808                 logmsg " valgrind SKIPPED\n";
   1809             }
   1810             $ok .= "-"; # skipped
   1811         }
   1812     }
   1813     else {
   1814         $ok .= "-"; # valgrind not checked
   1815     }
   1816     # add 'E' for event-based
   1817     $ok .= $run_event_based ? "E" : "-";
   1818 
   1819     logmsg "$ok " if(!$short);
   1820 
   1821     # timestamp test result verification end
   1822     $timevrfyend{$testnum} = Time::HiRes::time();
   1823 
   1824     return 0;
   1825 }
   1826 
   1827 
   1828 #######################################################################
   1829 # Report a successful test
   1830 sub singletest_success {
   1831     my ($testnum, $count, $total, $errorreturncode)=@_;
   1832 
   1833     my $sofar= time()-$start;
   1834     my $esttotal = $sofar/$count * $total;
   1835     my $estleft = $esttotal - $sofar;
   1836     my $timeleft=sprintf("remaining: %02d:%02d",
   1837                      $estleft/60,
   1838                      $estleft%60);
   1839     my $took = $timevrfyend{$testnum} - $timeprepini{$testnum};
   1840     my $duration = sprintf("duration: %02d:%02d",
   1841                            $sofar/60, $sofar%60);
   1842     if(!$automakestyle) {
   1843         logmsg sprintf("OK (%-3d out of %-3d, %s, took %.3fs, %s)\n",
   1844                        $count, $total, $timeleft, $took, $duration);
   1845     }
   1846     else {
   1847         my $testname= (getpart("client", "name"))[0];
   1848         chomp $testname;
   1849         logmsg "PASS: $testnum - $testname\n";
   1850     }
   1851 
   1852     if($errorreturncode==2) {
   1853         # ignored test success
   1854         $passedign .= "$testnum ";
   1855         logmsg "Warning: test$testnum result is ignored, but passed!\n";
   1856     }
   1857 }
   1858 
   1859 #######################################################################
   1860 # Run a single specified test case
   1861 # This is structured as a state machine which changes state after an
   1862 # asynchronous call is made that awaits a response. The function returns with
   1863 # an error code and a flag that indicates if the state machine has completed,
   1864 # which means (if not) the function must be called again once the response has
   1865 # arrived.
   1866 #
   1867 sub singletest {
   1868     my ($runnerid, $testnum, $count, $total)=@_;
   1869 
   1870     # start buffering logmsg; stop it on return
   1871     logmsg_bufferfortest($runnerid);
   1872     if(!exists $singletest_state{$runnerid}) {
   1873         # First time in singletest() for this test
   1874         $singletest_state{$runnerid} = ST_INIT;
   1875     }
   1876 
   1877     if($singletest_state{$runnerid} == ST_INIT) {
   1878         my $logdir = getrunnerlogdir($runnerid);
   1879         # first, remove all lingering log & lock files
   1880         if(!cleardir($logdir)) {
   1881             logmsg "Warning: $runnerid: cleardir($logdir) failed\n";
   1882         }
   1883         if(!cleardir("$logdir/$LOCKDIR")) {
   1884             logmsg "Warning: $runnerid: cleardir($logdir/$LOCKDIR) failed\n";
   1885         }
   1886 
   1887         $singletest_state{$runnerid} = ST_INITED;
   1888         # Recursively call the state machine again because there is no
   1889         # event expected that would otherwise trigger a new call.
   1890         return singletest(@_);
   1891 
   1892     } elsif($singletest_state{$runnerid} == ST_INITED) {
   1893         ###################################################################
   1894         # Restore environment variables that were modified in a previous run.
   1895         # Test definition may instruct to (un)set environment vars.
   1896         # This is done this early so that leftover variables don't affect
   1897         # starting servers or CI registration.
   1898         # restore_test_env(1);
   1899 
   1900         ###################################################################
   1901         # Load test file so CI registration can get the right data before the
   1902         # runner is called
   1903         loadtest("${TESTDIR}/test${testnum}");
   1904 
   1905         ###################################################################
   1906         # Register the test case with the CI environment
   1907         citest_starttest($testnum);
   1908 
   1909         if(runnerac_test_preprocess($runnerid, $testnum)) {
   1910             logmsg "ERROR: runner $runnerid seems to have died\n";
   1911             $singletest_state{$runnerid} = ST_INIT;
   1912             return (-1, 0);
   1913         }
   1914         $singletest_state{$runnerid} = ST_PREPROCESS;
   1915 
   1916     } elsif($singletest_state{$runnerid} == ST_PREPROCESS) {
   1917         my ($rid, $why, $error, $logs, $testtimings) = runnerar($runnerid);
   1918         if(!$rid) {
   1919             logmsg "ERROR: runner $runnerid seems to have died\n";
   1920             $singletest_state{$runnerid} = ST_INIT;
   1921             return (-1, 0);
   1922         }
   1923         logmsg $logs;
   1924         updatetesttimings($testnum, %$testtimings);
   1925         if($error == -2) {
   1926             if($postmortem) {
   1927                 # Error indicates an actual problem starting the server, so
   1928                 # display the server logs
   1929                 displaylogs($rid, $testnum);
   1930             }
   1931         }
   1932 
   1933         #######################################################################
   1934         # Load test file for this test number
   1935         my $logdir = getrunnerlogdir($runnerid);
   1936         loadtest("${logdir}/test${testnum}");
   1937 
   1938         #######################################################################
   1939         # Print the test name and count tests
   1940         $error = singletest_count($testnum, $why);
   1941         if($error) {
   1942             # Submit the test case result with the CI environment
   1943             citest_finishtest($testnum, $error);
   1944             $singletest_state{$runnerid} = ST_INIT;
   1945             logmsg singletest_dumplogs();
   1946             return ($error, 0);
   1947         }
   1948 
   1949         #######################################################################
   1950         # Execute this test number
   1951         my $cmdres;
   1952         my $CURLOUT;
   1953         my $tool;
   1954         my $usedvalgrind;
   1955         if(runnerac_test_run($runnerid, $testnum)) {
   1956             logmsg "ERROR: runner $runnerid seems to have died\n";
   1957             $singletest_state{$runnerid} = ST_INIT;
   1958             return (-1, 0);
   1959         }
   1960         $singletest_state{$runnerid} = ST_RUN;
   1961 
   1962     } elsif($singletest_state{$runnerid} == ST_RUN) {
   1963         my ($rid, $error, $logs, $testtimings, $cmdres, $CURLOUT, $tool, $usedvalgrind) = runnerar($runnerid);
   1964         if(!$rid) {
   1965             logmsg "ERROR: runner $runnerid seems to have died\n";
   1966             $singletest_state{$runnerid} = ST_INIT;
   1967             return (-1, 0);
   1968         }
   1969         logmsg $logs;
   1970         updatetesttimings($testnum, %$testtimings);
   1971         if($error == -1) {
   1972             # no further verification will occur
   1973             $timevrfyend{$testnum} = Time::HiRes::time();
   1974             my $err = ignoreresultcode($testnum);
   1975             # Submit the test case result with the CI environment
   1976             citest_finishtest($testnum, $err);
   1977             $singletest_state{$runnerid} = ST_INIT;
   1978             logmsg singletest_dumplogs();
   1979             # return a test failure, either to be reported or to be ignored
   1980             return ($err, 0);
   1981         }
   1982         elsif($error == -2) {
   1983             # fill in the missing timings on error
   1984             timestampskippedevents($testnum);
   1985             # Submit the test case result with the CI environment
   1986             citest_finishtest($testnum, $error);
   1987             $singletest_state{$runnerid} = ST_INIT;
   1988             logmsg singletest_dumplogs();
   1989             return ($error, 0);
   1990         }
   1991         elsif($error > 0) {
   1992             # no further verification will occur
   1993             $timevrfyend{$testnum} = Time::HiRes::time();
   1994             # Submit the test case result with the CI environment
   1995             citest_finishtest($testnum, $error);
   1996             $singletest_state{$runnerid} = ST_INIT;
   1997             logmsg singletest_dumplogs();
   1998             return ($error, 0);
   1999         }
   2000 
   2001         #######################################################################
   2002         # Verify that the test succeeded
   2003         #
   2004         # Load test file for this test number
   2005         my $logdir = getrunnerlogdir($runnerid);
   2006         loadtest("${logdir}/test${testnum}");
   2007         readtestkeywords();
   2008 
   2009         $error = singletest_check($runnerid, $testnum, $cmdres, $CURLOUT, $tool, $usedvalgrind);
   2010         if($error == -1) {
   2011             my $err = ignoreresultcode($testnum);
   2012             # Submit the test case result with the CI environment
   2013             citest_finishtest($testnum, $err);
   2014             $singletest_state{$runnerid} = ST_INIT;
   2015             logmsg singletest_dumplogs();
   2016             # return a test failure, either to be reported or to be ignored
   2017             return ($err, 0);
   2018         }
   2019         elsif($error == -2) {
   2020             # torture test; there is no verification, so the run result holds the
   2021             # test success code
   2022             # Submit the test case result with the CI environment
   2023             citest_finishtest($testnum, $cmdres);
   2024             $singletest_state{$runnerid} = ST_INIT;
   2025             logmsg singletest_dumplogs();
   2026             return ($cmdres, 0);
   2027         }
   2028 
   2029 
   2030         #######################################################################
   2031         # Report a successful test
   2032         singletest_success($testnum, $count, $total, ignoreresultcode($testnum));
   2033 
   2034         # Submit the test case result with the CI environment
   2035         citest_finishtest($testnum, 0);
   2036         $singletest_state{$runnerid} = ST_INIT;
   2037 
   2038         logmsg singletest_dumplogs();
   2039         return (0, 0);  # state machine is finished
   2040     }
   2041     singletest_unbufferlogs();
   2042     return (0, 1);  # state machine must be called again on event
   2043 }
   2044 
   2045 #######################################################################
   2046 # runtimestats displays test-suite run time statistics
   2047 #
   2048 sub runtimestats {
   2049     my $lasttest = $_[0];
   2050 
   2051     return if(not $timestats);
   2052 
   2053     logmsg "::group::Run Time Stats\n";
   2054 
   2055     logmsg "\nTest suite total running time breakdown per task...\n\n";
   2056 
   2057     my @timesrvr;
   2058     my @timeprep;
   2059     my @timetool;
   2060     my @timelock;
   2061     my @timevrfy;
   2062     my @timetest;
   2063     my $timesrvrtot = 0.0;
   2064     my $timepreptot = 0.0;
   2065     my $timetooltot = 0.0;
   2066     my $timelocktot = 0.0;
   2067     my $timevrfytot = 0.0;
   2068     my $timetesttot = 0.0;
   2069     my $counter;
   2070 
   2071     for my $testnum (1 .. $lasttest) {
   2072         if($timesrvrini{$testnum}) {
   2073             $timesrvrtot += $timesrvrend{$testnum} - $timesrvrini{$testnum};
   2074             $timepreptot +=
   2075                 (($timetoolini{$testnum} - $timeprepini{$testnum}) -
   2076                  ($timesrvrend{$testnum} - $timesrvrini{$testnum}));
   2077             $timetooltot += $timetoolend{$testnum} - $timetoolini{$testnum};
   2078             $timelocktot += $timesrvrlog{$testnum} - $timetoolend{$testnum};
   2079             $timevrfytot += $timevrfyend{$testnum} - $timesrvrlog{$testnum};
   2080             $timetesttot += $timevrfyend{$testnum} - $timeprepini{$testnum};
   2081             push @timesrvr, sprintf("%06.3f  %04d",
   2082                 $timesrvrend{$testnum} - $timesrvrini{$testnum}, $testnum);
   2083             push @timeprep, sprintf("%06.3f  %04d",
   2084                 ($timetoolini{$testnum} - $timeprepini{$testnum}) -
   2085                 ($timesrvrend{$testnum} - $timesrvrini{$testnum}), $testnum);
   2086             push @timetool, sprintf("%06.3f  %04d",
   2087                 $timetoolend{$testnum} - $timetoolini{$testnum}, $testnum);
   2088             push @timelock, sprintf("%06.3f  %04d",
   2089                 $timesrvrlog{$testnum} - $timetoolend{$testnum}, $testnum);
   2090             push @timevrfy, sprintf("%06.3f  %04d",
   2091                 $timevrfyend{$testnum} - $timesrvrlog{$testnum}, $testnum);
   2092             push @timetest, sprintf("%06.3f  %04d",
   2093                 $timevrfyend{$testnum} - $timeprepini{$testnum}, $testnum);
   2094         }
   2095     }
   2096 
   2097     {
   2098         no warnings 'numeric';
   2099         @timesrvr = sort { $b <=> $a } @timesrvr;
   2100         @timeprep = sort { $b <=> $a } @timeprep;
   2101         @timetool = sort { $b <=> $a } @timetool;
   2102         @timelock = sort { $b <=> $a } @timelock;
   2103         @timevrfy = sort { $b <=> $a } @timevrfy;
   2104         @timetest = sort { $b <=> $a } @timetest;
   2105     }
   2106 
   2107     logmsg "Spent ". sprintf("%08.3f ", $timesrvrtot) .
   2108            "seconds starting and verifying test harness servers.\n";
   2109     logmsg "Spent ". sprintf("%08.3f ", $timepreptot) .
   2110            "seconds reading definitions and doing test preparations.\n";
   2111     logmsg "Spent ". sprintf("%08.3f ", $timetooltot) .
   2112            "seconds actually running test tools.\n";
   2113     logmsg "Spent ". sprintf("%08.3f ", $timelocktot) .
   2114            "seconds awaiting server logs lock removal.\n";
   2115     logmsg "Spent ". sprintf("%08.3f ", $timevrfytot) .
   2116            "seconds verifying test results.\n";
   2117     logmsg "Spent ". sprintf("%08.3f ", $timetesttot) .
   2118            "seconds doing all of the above.\n";
   2119 
   2120     $counter = 25;
   2121     logmsg "\nTest server starting and verification time per test ".
   2122         sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
   2123     logmsg "-time-  test\n";
   2124     logmsg "------  ----\n";
   2125     foreach my $txt (@timesrvr) {
   2126         last if((not $fullstats) && (not $counter--));
   2127         logmsg "$txt\n";
   2128     }
   2129 
   2130     $counter = 10;
   2131     logmsg "\nTest definition reading and preparation time per test ".
   2132         sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
   2133     logmsg "-time-  test\n";
   2134     logmsg "------  ----\n";
   2135     foreach my $txt (@timeprep) {
   2136         last if((not $fullstats) && (not $counter--));
   2137         logmsg "$txt\n";
   2138     }
   2139 
   2140     $counter = 25;
   2141     logmsg "\nTest tool execution time per test ".
   2142         sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
   2143     logmsg "-time-  test\n";
   2144     logmsg "------  ----\n";
   2145     foreach my $txt (@timetool) {
   2146         last if((not $fullstats) && (not $counter--));
   2147         logmsg "$txt\n";
   2148     }
   2149 
   2150     $counter = 15;
   2151     logmsg "\nTest server logs lock removal time per test ".
   2152         sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
   2153     logmsg "-time-  test\n";
   2154     logmsg "------  ----\n";
   2155     foreach my $txt (@timelock) {
   2156         last if((not $fullstats) && (not $counter--));
   2157         logmsg "$txt\n";
   2158     }
   2159 
   2160     $counter = 10;
   2161     logmsg "\nTest results verification time per test ".
   2162         sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
   2163     logmsg "-time-  test\n";
   2164     logmsg "------  ----\n";
   2165     foreach my $txt (@timevrfy) {
   2166         last if((not $fullstats) && (not $counter--));
   2167         logmsg "$txt\n";
   2168     }
   2169 
   2170     $counter = 50;
   2171     logmsg "\nTotal time per test ".
   2172         sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
   2173     logmsg "-time-  test\n";
   2174     logmsg "------  ----\n";
   2175     foreach my $txt (@timetest) {
   2176         last if((not $fullstats) && (not $counter--));
   2177         logmsg "$txt\n";
   2178     }
   2179 
   2180     logmsg "\n";
   2181 
   2182     logmsg "::endgroup::\n";
   2183 }
   2184 
   2185 #######################################################################
   2186 # returns code indicating why a test was skipped
   2187 # 0=unknown test, 1=use test result, 2=ignore test result
   2188 #
   2189 sub ignoreresultcode {
   2190     my ($testnum)=@_;
   2191     if(defined $ignoretestcodes{$testnum}) {
   2192         return $ignoretestcodes{$testnum};
   2193     }
   2194     return 0;
   2195 }
   2196 
   2197 #######################################################################
   2198 # Put the given runner ID onto the queue of runners ready for a new task
   2199 #
   2200 sub runnerready {
   2201     my ($runnerid)=@_;
   2202     push @runnersidle, $runnerid;
   2203 }
   2204 
   2205 #######################################################################
   2206 # Create test runners
   2207 #
   2208 sub createrunners {
   2209     my ($numrunners)=@_;
   2210     if(! $numrunners) {
   2211         $numrunners++;
   2212     }
   2213     # create $numrunners runners with minimum 1
   2214     for my $runnernum (1..$numrunners) {
   2215         my $dir = getrunnernumlogdir($runnernum);
   2216         cleardir($dir);
   2217         mkdir($dir, 0777);
   2218         $runnerids{$runnernum} = runner_init($dir, $jobs);
   2219         runnerready($runnerids{$runnernum});
   2220     }
   2221 }
   2222 
   2223 #######################################################################
   2224 # Pick a test runner for the given test
   2225 #
   2226 sub pickrunner {
   2227     my ($testnum)=@_;
   2228     scalar(@runnersidle) || die "No runners available";
   2229 
   2230     return pop @runnersidle;
   2231 }
   2232 
   2233 #######################################################################
   2234 # Check options to this test program
   2235 #
   2236 
   2237 # Special case for CMake: replace '$TFLAGS' by the contents of the
   2238 # environment variable (if any).
   2239 if(@ARGV && $ARGV[-1] eq '$TFLAGS') {
   2240     pop @ARGV;
   2241     push(@ARGV, split(' ', $ENV{'TFLAGS'})) if defined($ENV{'TFLAGS'});
   2242 }
   2243 
   2244 $args = join(' ', @ARGV);
   2245 
   2246 $valgrind = checktestcmd("valgrind");
   2247 my $number=0;
   2248 my $fromnum=-1;
   2249 my @testthis;
   2250 while(@ARGV) {
   2251     if($ARGV[0] eq "-v") {
   2252         # verbose output
   2253         $verbose=1;
   2254     }
   2255     elsif($ARGV[0] eq "-c") {
   2256         # use this path to curl instead of default
   2257         $DBGCURL=$CURL=$ARGV[1];
   2258         shift @ARGV;
   2259     }
   2260     elsif($ARGV[0] eq "-vc") {
   2261         # use this path to a curl used to verify servers
   2262 
   2263         # Particularly useful when you introduce a crashing bug somewhere in
   2264         # the development version as then it won't be able to run any tests
   2265         # since it can't verify the servers!
   2266 
   2267         $VCURL=shell_quote($ARGV[1]);
   2268         shift @ARGV;
   2269     }
   2270     elsif($ARGV[0] eq "-ac") {
   2271         # use this curl only to talk to APIs (currently only CI test APIs)
   2272         $ACURL=shell_quote($ARGV[1]);
   2273         shift @ARGV;
   2274     }
   2275     elsif($ARGV[0] eq "-d") {
   2276         # have the servers display protocol output
   2277         $debugprotocol=1;
   2278     }
   2279     elsif(($ARGV[0] eq "-e") || ($ARGV[0] eq "--test-event")) {
   2280         # run the tests cases event based if possible
   2281         $run_event_based=1;
   2282     }
   2283     elsif($ARGV[0] eq "--test-duphandle") {
   2284         # run the tests with --test-duphandle
   2285         $run_duphandle=1;
   2286     }
   2287     elsif($ARGV[0] eq "-f") {
   2288         # force - run the test case even if listed in DISABLED
   2289         $run_disabled=1;
   2290     }
   2291     elsif($ARGV[0] eq "-E") {
   2292         # load additional reasons to skip tests
   2293         shift @ARGV;
   2294         my $exclude_file = $ARGV[0];
   2295         open(my $fd, "<", $exclude_file) or die "Couldn't open '$exclude_file': $!";
   2296         while(my $line = <$fd>) {
   2297             next if($line =~ /^#/);
   2298             chomp $line;
   2299             my ($type, $patterns, $skip_reason) = split(/\s*:\s*/, $line, 3);
   2300 
   2301             die "Unsupported type: $type\n" if($type !~ /^keyword|test|tool$/);
   2302 
   2303             foreach my $pattern (split(/,/, $patterns)) {
   2304                 if($type eq "test") {
   2305                     # Strip leading zeros in the test number
   2306                     $pattern = int($pattern);
   2307                 }
   2308                 $custom_skip_reasons{$type}{$pattern} = $skip_reason;
   2309             }
   2310         }
   2311         close($fd);
   2312     }
   2313     elsif($ARGV[0] eq "-g") {
   2314         # run this test with gdb
   2315         $gdbthis=1;
   2316     }
   2317     elsif($ARGV[0] eq "-gl") {
   2318         # run this test with lldb
   2319         $gdbthis=2;
   2320     }
   2321     elsif($ARGV[0] eq "-gw") {
   2322         # run this test with windowed gdb
   2323         $gdbthis=1;
   2324         $gdbxwin=1;
   2325     }
   2326     elsif($ARGV[0] eq "-s") {
   2327         # short output
   2328         $short=1;
   2329     }
   2330     elsif($ARGV[0] eq "-am") {
   2331         # automake-style output
   2332         $short=1;
   2333         $automakestyle=1;
   2334     }
   2335     elsif($ARGV[0] eq "-n") {
   2336         # no valgrind
   2337         undef $valgrind;
   2338     }
   2339     elsif($ARGV[0] eq "--no-debuginfod") {
   2340         # disable the valgrind debuginfod functionality
   2341         $no_debuginfod = 1;
   2342     }
   2343     elsif($ARGV[0] eq "-R") {
   2344         # execute in scrambled order
   2345         $scrambleorder=1;
   2346     }
   2347     elsif($ARGV[0] =~ /^-t(.*)/) {
   2348         # torture
   2349         $torture=1;
   2350         my $xtra = $1;
   2351 
   2352         if($xtra =~ s/(\d+)$//) {
   2353             $tortalloc = $1;
   2354         }
   2355     }
   2356     elsif($ARGV[0] =~ /--shallow=(\d+)/) {
   2357         # Fail no more than this amount per tests when running
   2358         # torture.
   2359         my ($num)=($1);
   2360         $shallow=$num;
   2361     }
   2362     elsif($ARGV[0] =~ /--repeat=(\d+)/) {
   2363         # Repeat-run the given tests this many times
   2364         $repeat = $1;
   2365     }
   2366     elsif($ARGV[0] =~ /--retry=(\d+)/) {
   2367         # Number of attempts for the whole test run to retry failed tests
   2368         $retry = $1;
   2369     }
   2370     elsif($ARGV[0] =~ /--seed=(\d+)/) {
   2371         # Set a fixed random seed (used for -R and --shallow)
   2372         $randseed = $1;
   2373     }
   2374     elsif($ARGV[0] eq "-a") {
   2375         # continue anyway, even if a test fail
   2376         $anyway=1;
   2377     }
   2378     elsif($ARGV[0] eq "-o") {
   2379         shift @ARGV;
   2380         if($ARGV[0] =~ /^(\w+)=([\w.:\/\[\]-]+)$/) {
   2381             my ($variable, $value) = ($1, $2);
   2382             eval "\$$variable='$value'" or die "Failed to set \$$variable to $value: $@";
   2383         } else {
   2384             die "Failed to parse '-o $ARGV[0]'. May contain unexpected characters.\n";
   2385         }
   2386     }
   2387     elsif($ARGV[0] eq "-p") {
   2388         $postmortem=1;
   2389     }
   2390     elsif($ARGV[0] eq "-P") {
   2391         shift @ARGV;
   2392         $proxy_address=$ARGV[0];
   2393     }
   2394     elsif($ARGV[0] eq "-L") {
   2395         # require additional library file
   2396         shift @ARGV;
   2397         require $ARGV[0];
   2398     }
   2399     elsif($ARGV[0] eq "-l") {
   2400         # lists the test case names only
   2401         $listonly=1;
   2402     }
   2403     elsif($ARGV[0] =~ /^-j(.*)/) {
   2404         # parallel jobs
   2405         $jobs=1;
   2406         my $xtra = $1;
   2407         if($xtra =~ s/(\d+)$//) {
   2408             $jobs = $1;
   2409         }
   2410     }
   2411     elsif($ARGV[0] eq "-k") {
   2412         # keep stdout and stderr files after tests
   2413         $keepoutfiles=1;
   2414     }
   2415     elsif($ARGV[0] eq "-r") {
   2416         # run time statistics needs Time::HiRes
   2417         if($Time::HiRes::VERSION) {
   2418             # presize hashes appropriately to hold an entire test run
   2419             keys(%timeprepini) = 2000;
   2420             keys(%timesrvrini) = 2000;
   2421             keys(%timesrvrend) = 2000;
   2422             keys(%timetoolini) = 2000;
   2423             keys(%timetoolend) = 2000;
   2424             keys(%timesrvrlog) = 2000;
   2425             keys(%timevrfyend) = 2000;
   2426             $timestats=1;
   2427             $fullstats=0;
   2428         }
   2429     }
   2430     elsif($ARGV[0] eq "-rf") {
   2431         # run time statistics needs Time::HiRes
   2432         if($Time::HiRes::VERSION) {
   2433             # presize hashes appropriately to hold an entire test run
   2434             keys(%timeprepini) = 2000;
   2435             keys(%timesrvrini) = 2000;
   2436             keys(%timesrvrend) = 2000;
   2437             keys(%timetoolini) = 2000;
   2438             keys(%timetoolend) = 2000;
   2439             keys(%timesrvrlog) = 2000;
   2440             keys(%timevrfyend) = 2000;
   2441             $timestats=1;
   2442             $fullstats=1;
   2443         }
   2444     }
   2445     elsif($ARGV[0] eq "-u") {
   2446         # error instead of warning on server unexpectedly alive
   2447         $err_unexpected=1;
   2448     }
   2449     elsif(($ARGV[0] eq "-h") || ($ARGV[0] eq "--help")) {
   2450         # show help text
   2451         print <<"EOHELP"
   2452 Usage: runtests.pl [options] [test selection(s)]
   2453   -a       continue even if a test fails
   2454   -ac path use this curl only to talk to APIs (currently only CI test APIs)
   2455   -am      automake style output PASS/FAIL: [number] [name]
   2456   -c path  use this curl executable
   2457   -d       display server debug info
   2458   -e, --test-event  event-based execution
   2459   --test-duphandle  duplicate handles before use
   2460   -E file  load the specified file to exclude certain tests
   2461   -f       forcibly run even if disabled
   2462   -g       run the test case with gdb
   2463   -gw      run the test case with gdb as a windowed application
   2464   -h       this help text
   2465   -j[N]    spawn this number of processes to run tests (default 0)
   2466   -k       keep stdout and stderr files present after tests
   2467   -L path  require an additional perl library file to replace certain functions
   2468   -l       list all test case names/descriptions
   2469   -n       no valgrind
   2470   --no-debuginfod disable the valgrind debuginfod functionality
   2471   -o variable=value set internal variable to the specified value
   2472   -P proxy use the specified proxy
   2473   -p       print log file contents when a test fails
   2474   -R       scrambled order (uses the random seed, see --seed)
   2475   -r       run time statistics
   2476   -rf      full run time statistics
   2477   --repeat=[num] run the given tests this many times
   2478   --retry=[num] number of attempts for the whole test run to retry failed tests
   2479   -s       short output
   2480   --seed=[num] set the random seed to a fixed number
   2481   --shallow=[num] randomly makes the torture tests "thinner"
   2482   -t[N]    torture (simulate function failures); N means fail Nth function
   2483   -u       error instead of warning on server unexpectedly alive
   2484   -v       verbose output
   2485   -vc path use this curl only to verify the existing servers
   2486   [num]    like "5 6 9" or " 5 to 22 " to run those tests only
   2487   [!num]   like "!5 !6 !9" to disable those tests
   2488   [~num]   like "~5 ~6 ~9" to ignore the result of those tests
   2489   [keyword] like "IPv6" to select only tests containing the key word
   2490   [!keyword] like "!cookies" to disable any tests containing the key word
   2491   [~keyword] like "~cookies" to ignore results of tests containing key word
   2492 EOHELP
   2493     ;
   2494         exit;
   2495     }
   2496     elsif($ARGV[0] =~ /^(\d+)/) {
   2497         $number = $1;
   2498         if($fromnum >= 0) {
   2499             for my $n ($fromnum .. $number) {
   2500                 push @testthis, $n;
   2501             }
   2502             $fromnum = -1;
   2503         }
   2504         else {
   2505             push @testthis, $1;
   2506         }
   2507     }
   2508     elsif($ARGV[0] =~ /^to$/i) {
   2509         $fromnum = $number+1;
   2510     }
   2511     elsif($ARGV[0] =~ /^!(\d+)/) {
   2512         $fromnum = -1;
   2513         $disabled{$1}=$1;
   2514     }
   2515     elsif($ARGV[0] =~ /^~(\d+)/) {
   2516         $fromnum = -1;
   2517         $ignored{$1}=$1;
   2518     }
   2519     elsif($ARGV[0] =~ /^!(.+)/) {
   2520         $disabled_keywords{lc($1)}=$1;
   2521     }
   2522     elsif($ARGV[0] =~ /^~(.+)/) {
   2523         $ignored_keywords{lc($1)}=$1;
   2524     }
   2525     elsif($ARGV[0] =~ /^([-[{a-zA-Z].*)/) {
   2526         $enabled_keywords{lc($1)}=$1;
   2527     }
   2528     else {
   2529         print "Unknown option: $ARGV[0]\n";
   2530         exit;
   2531     }
   2532     shift @ARGV;
   2533 }
   2534 
   2535 delete $ENV{'DEBUGINFOD_URLS'} if($ENV{'DEBUGINFOD_URLS'} && $no_debuginfod);
   2536 
   2537 if(!$randseed) {
   2538     my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
   2539         localtime(time);
   2540     # seed of the month. December 2019 becomes 201912
   2541     $randseed = ($year+1900)*100 + $mon+1;
   2542     print "Using curl: $CURL\n";
   2543     open(my $curlvh, "-|", exerunner() . shell_quote($CURL) . " --version 2>$dev_null") ||
   2544         die "could not get curl version!";
   2545     my @c = <$curlvh>;
   2546     close($curlvh) || die "could not get curl version!";
   2547     # use the first line of output and get the md5 out of it
   2548     my $str = md5($c[0]);
   2549     $randseed += unpack('S', $str);  # unsigned 16 bit value
   2550 }
   2551 srand $randseed;
   2552 
   2553 if(@testthis && ($testthis[0] ne "")) {
   2554     $TESTCASES=join(" ", @testthis);
   2555 }
   2556 
   2557 if($valgrind) {
   2558     # we have found valgrind on the host, use it
   2559 
   2560     # verify that we can invoke it fine
   2561     my $code = runclient("valgrind >$dev_null 2>&1");
   2562 
   2563     if(($code>>8) != 1) {
   2564         #logmsg "Valgrind failure, disable it\n";
   2565         undef $valgrind;
   2566     } else {
   2567 
   2568         # since valgrind 2.1.x, '--tool' option is mandatory
   2569         # use it, if it is supported by the version installed on the system
   2570         # (this happened in 2003, so we could probably don't need to care about
   2571         # that old version any longer and just delete this check)
   2572         runclient("valgrind --help 2>&1 | grep -- --tool >$dev_null 2>&1");
   2573         if(($? >> 8)) {
   2574             $valgrind_tool="";
   2575         }
   2576         open(my $curlh, "<", "$CURL");
   2577         my $l = <$curlh>;
   2578         if($l =~ /^\#\!/) {
   2579             # A shell script. This is typically when built with libtool,
   2580             $valgrind="../libtool --mode=execute $valgrind";
   2581         }
   2582         close($curlh);
   2583 
   2584         # valgrind 3 renamed the --logfile option to --log-file!!!
   2585         # (this happened in 2005, so we could probably don't need to care about
   2586         # that old version any longer and just delete this check)
   2587         my $ver=join(' ', runclientoutput("valgrind --version"));
   2588         # cut off all but digits and dots
   2589         $ver =~ s/[^0-9.]//g;
   2590 
   2591         if($ver =~ /^(\d+)/) {
   2592             $ver = $1;
   2593             if($ver < 3) {
   2594                 $valgrind_logfile="--logfile";
   2595             }
   2596         }
   2597     }
   2598 }
   2599 
   2600 if($gdbthis) {
   2601     # open the executable curl and read the first 4 bytes of it
   2602     open(my $check, "<", "$CURL");
   2603     my $c;
   2604     sysread $check, $c, 4;
   2605     close($check);
   2606     if($c eq "#! /") {
   2607         # A shell script. This is typically when built with libtool,
   2608         $libtool = 1;
   2609         $gdb = "../libtool --mode=execute gdb";
   2610     }
   2611 }
   2612 
   2613 #######################################################################
   2614 # clear and create logging directory:
   2615 #
   2616 
   2617 # TODO: figure how to get around this. This dir is needed for checksystemfeatures()
   2618 # Maybe create & use & delete a temporary directory in that function
   2619 cleardir($LOGDIR);
   2620 mkdir($LOGDIR, 0777);
   2621 mkdir("$LOGDIR/$LOCKDIR", 0777);
   2622 
   2623 #######################################################################
   2624 # initialize some variables
   2625 #
   2626 
   2627 get_disttests();
   2628 if(!$jobs) {
   2629     # Disable buffered logging with only one test job
   2630     setlogfunc(\&logmsg);
   2631 }
   2632 
   2633 #######################################################################
   2634 # Output curl version and host info being tested
   2635 #
   2636 
   2637 if(!$listonly) {
   2638     checksystemfeatures();
   2639 }
   2640 
   2641 #######################################################################
   2642 # Output information about the curl build
   2643 #
   2644 if(!$listonly) {
   2645     if(open(my $fd, "<", "../buildinfo.txt")) {
   2646         while(my $line = <$fd>) {
   2647             chomp $line;
   2648             if($line && $line !~ /^#/) {
   2649                 logmsg("* $line\n");
   2650             }
   2651         }
   2652         close($fd);
   2653     }
   2654 }
   2655 
   2656 #######################################################################
   2657 # initialize configuration needed to set up servers
   2658 # TODO: rearrange things so this can be called only in runner_init()
   2659 #
   2660 initserverconfig();
   2661 
   2662 if(!$listonly) {
   2663     # these can only be displayed after initserverconfig() has been called
   2664     displayserverfeatures();
   2665 
   2666     # globally disabled tests
   2667     disabledtests("$TESTDIR/DISABLED");
   2668 }
   2669 
   2670 #######################################################################
   2671 # Fetch all disabled tests, if there are any
   2672 #
   2673 
   2674 sub disabledtests {
   2675     my ($file) = @_;
   2676     my @input;
   2677 
   2678     if(open(my $disabledh, "<", "$file")) {
   2679         while(<$disabledh>) {
   2680             if(/^ *\#/) {
   2681                 # allow comments
   2682                 next;
   2683             }
   2684             push @input, $_;
   2685         }
   2686         close($disabledh);
   2687 
   2688         # preprocess the input to make conditionally disabled tests depending
   2689         # on variables
   2690         my @pp = prepro(0, @input);
   2691         for my $t (@pp) {
   2692             if($t =~ /(\d+)/) {
   2693                 my ($n) = $1;
   2694                 $disabled{$n}=$n; # disable this test number
   2695                 if(! -f "$srcdir/data/test$n") {
   2696                     print STDERR "WARNING! Non-existing test $n in $file!\n";
   2697                     # fail hard to make user notice
   2698                     exit 1;
   2699                 }
   2700                 logmsg "DISABLED: test $n\n" if($verbose);
   2701             }
   2702             else {
   2703                 print STDERR "$file: rubbish content: $t\n";
   2704                 exit 2;
   2705             }
   2706         }
   2707     }
   2708     else {
   2709         print STDERR "Cannot open $file, exiting\n";
   2710         exit 3;
   2711     }
   2712 }
   2713 
   2714 #######################################################################
   2715 # If 'all' tests are requested, find out all test numbers
   2716 #
   2717 
   2718 if($TESTCASES eq "all") {
   2719     # Get all commands and find out their test numbers
   2720     opendir(DIR, $TESTDIR) || die "can't opendir $TESTDIR: $!";
   2721     my @cmds = grep { /^test([0-9]+)$/ && -f "$TESTDIR/$_" } readdir(DIR);
   2722     closedir(DIR);
   2723 
   2724     $TESTCASES=""; # start with no test cases
   2725 
   2726     # cut off everything but the digits
   2727     for(@cmds) {
   2728         $_ =~ s/[a-z\/\.]*//g;
   2729     }
   2730     # sort the numbers from low to high
   2731     foreach my $n (sort { $a <=> $b } @cmds) {
   2732         if($disabled{$n}) {
   2733             # skip disabled test cases
   2734             my $why = "configured as DISABLED";
   2735             $skipped{$why}++;
   2736             $teststat[$n]=$why; # store reason for this test case
   2737             next;
   2738         }
   2739         $TESTCASES .= " $n";
   2740     }
   2741 }
   2742 else {
   2743     my $verified="";
   2744     for(split(" ", $TESTCASES)) {
   2745         if(-e "$TESTDIR/test$_") {
   2746             $verified.="$_ ";
   2747         }
   2748     }
   2749     if($verified eq "") {
   2750         print "No existing test cases were specified\n";
   2751         exit;
   2752     }
   2753     $TESTCASES = $verified;
   2754 }
   2755 if($repeat) {
   2756     my $s;
   2757     for(1 .. $repeat) {
   2758         $s .= $TESTCASES;
   2759     }
   2760     $TESTCASES = $s;
   2761 }
   2762 
   2763 if($scrambleorder) {
   2764     # scramble the order of the test cases
   2765     my @rand;
   2766     while($TESTCASES) {
   2767         my @all = split(/ +/, $TESTCASES);
   2768         if(!$all[0]) {
   2769             # if the first is blank, shift away it
   2770             shift @all;
   2771         }
   2772         my $r = rand @all;
   2773         push @rand, $all[$r];
   2774         $all[$r]="";
   2775         $TESTCASES = join(" ", @all);
   2776     }
   2777     $TESTCASES = join(" ", @rand);
   2778 }
   2779 
   2780 # Display the contents of the given file.  Line endings are canonicalized
   2781 # and excessively long files are elided
   2782 sub displaylogcontent {
   2783     my ($file)=@_;
   2784     if(open(my $single, "<", "$file")) {
   2785         my $linecount = 0;
   2786         my $truncate;
   2787         my @tail;
   2788         while(my $string = <$single>) {
   2789             $string =~ s/\r\n/\n/g;
   2790             $string =~ s/[\r\f\032]/\n/g;
   2791             $string .= "\n" unless ($string =~ /\n$/);
   2792             $string =~ tr/\n//;
   2793             for my $line (split(m/\n/, $string)) {
   2794                 $line =~ s/\s*\!$//;
   2795                 if($truncate) {
   2796                     push @tail, " $line\n";
   2797                 } else {
   2798                     logmsg " $line\n";
   2799                 }
   2800                 $linecount++;
   2801                 $truncate = $linecount > 1200;
   2802             }
   2803         }
   2804         close($single);
   2805         if(@tail) {
   2806             my $tailshow = 200;
   2807             my $tailskip = 0;
   2808             my $tailtotal = scalar @tail;
   2809             if($tailtotal > $tailshow) {
   2810                 $tailskip = $tailtotal - $tailshow;
   2811                 logmsg "=== File too long: $tailskip lines omitted here\n";
   2812             }
   2813             for($tailskip .. $tailtotal-1) {
   2814                 logmsg "$tail[$_]";
   2815             }
   2816         }
   2817     }
   2818 }
   2819 
   2820 sub displaylogs {
   2821     my ($runnerid, $testnum)=@_;
   2822     my $logdir = getrunnerlogdir($runnerid);
   2823     opendir(DIR, "$logdir") ||
   2824         die "can't open dir: $!";
   2825     my @logs = readdir(DIR);
   2826     closedir(DIR);
   2827 
   2828     logmsg "== Contents of files in the $logdir/ dir after test $testnum\n";
   2829     foreach my $log (sort @logs) {
   2830         if($log =~ /\.(\.|)$/) {
   2831             next; # skip "." and ".."
   2832         }
   2833         if($log =~ /^\.nfs/) {
   2834             next; # skip ".nfs"
   2835         }
   2836         if(($log eq "memdump") || ($log eq "core")) {
   2837             next; # skip "memdump" and  "core"
   2838         }
   2839         if((-d "$logdir/$log") || (! -s "$logdir/$log")) {
   2840             next; # skip directory and empty files
   2841         }
   2842         if(($log =~ /^stdout\d+/) && ($log !~ /^stdout$testnum/)) {
   2843             next; # skip stdoutNnn of other tests
   2844         }
   2845         if(($log =~ /^stderr\d+/) && ($log !~ /^stderr$testnum/)) {
   2846             next; # skip stderrNnn of other tests
   2847         }
   2848         if(($log =~ /^upload\d+/) && ($log !~ /^upload$testnum/)) {
   2849             next; # skip uploadNnn of other tests
   2850         }
   2851         if(($log =~ /^curl\d+\.out/) && ($log !~ /^curl$testnum\.out/)) {
   2852             next; # skip curlNnn.out of other tests
   2853         }
   2854         if(($log =~ /^test\d+\.txt/) && ($log !~ /^test$testnum\.txt/)) {
   2855             next; # skip testNnn.txt of other tests
   2856         }
   2857         if(($log =~ /^file\d+\.txt/) && ($log !~ /^file$testnum\.txt/)) {
   2858             next; # skip fileNnn.txt of other tests
   2859         }
   2860         if(($log =~ /^netrc\d+/) && ($log !~ /^netrc$testnum/)) {
   2861             next; # skip netrcNnn of other tests
   2862         }
   2863         if(($log =~ /^trace\d+/) && ($log !~ /^trace$testnum/)) {
   2864             next; # skip traceNnn of other tests
   2865         }
   2866         if(($log =~ /^valgrind\d+/) && ($log !~ /^valgrind$testnum(?:\..*)?$/)) {
   2867             next; # skip valgrindNnn of other tests
   2868         }
   2869         if(($log =~ /^test$testnum$/)) {
   2870             next; # skip test$testnum since it can be very big
   2871         }
   2872         logmsg "=== Start of file $log\n";
   2873         displaylogcontent("$logdir/$log");
   2874         logmsg "=== End of file $log\n";
   2875     }
   2876 }
   2877 
   2878 #######################################################################
   2879 # Scan tests to find suitable candidates
   2880 #
   2881 
   2882 my $failed;
   2883 my $failedign;
   2884 my $failedre;
   2885 my $ok=0;
   2886 my $ign=0;
   2887 my $total=0;
   2888 my $executed=0;
   2889 my $retry_done=0;
   2890 my $lasttest=0;
   2891 my @at = split(" ", $TESTCASES);
   2892 my $count=0;
   2893 my $endwaitcnt=0;
   2894 
   2895 $start = time();
   2896 
   2897 # scan all tests to find ones we should try to run
   2898 my @runtests;
   2899 foreach my $testnum (@at) {
   2900     $lasttest = $testnum if($testnum > $lasttest);
   2901     my ($why, $errorreturncode) = singletest_shouldrun($testnum);
   2902     if($why || $listonly) {
   2903         # Display test name now--test will be completely skipped later
   2904         my $error = singletest_count($testnum, $why);
   2905         next;
   2906     }
   2907     $ignoretestcodes{$testnum} = $errorreturncode;
   2908     push(@runtests, $testnum);
   2909 }
   2910 my $totaltests = scalar(@runtests);
   2911 
   2912 if($listonly) {
   2913     exit(0);
   2914 }
   2915 
   2916 #######################################################################
   2917 # Setup CI Test Run
   2918 citest_starttestrun();
   2919 
   2920 #######################################################################
   2921 # Start test runners
   2922 #
   2923 my $numrunners = $jobs < scalar(@runtests) ? $jobs : scalar(@runtests);
   2924 createrunners($numrunners);
   2925 
   2926 #######################################################################
   2927 # The main test-loop
   2928 #
   2929 # Every iteration through the loop consists of these steps:
   2930 #   - if the global abort flag is set, exit the loop; we are done
   2931 #   - if a runner is idle, start a new test on it
   2932 #   - if all runners are idle, exit the loop; we are done
   2933 #   - if a runner has a response for us, process the response
   2934 
   2935 # run through each candidate test and execute it
   2936 my $runner_wait_cnt = 0;
   2937 
   2938 # number of retry attempts for the whole test run
   2939 my $retry_left;
   2940 if($torture) {
   2941     $retry_left = 0;  # No use of retrying torture tests
   2942 }
   2943 else {
   2944     $retry_left = $retry;
   2945 }
   2946 
   2947 while() {
   2948     # check the abort flag
   2949     if($globalabort) {
   2950         logmsg singletest_dumplogs();
   2951         logmsg "Aborting tests\n";
   2952         logmsg "Waiting for " . scalar((keys %runnersrunning)) . " outstanding test(s) to finish...\n";
   2953         # Wait for the last requests to complete and throw them away so
   2954         # that IPC calls & responses stay in sync
   2955         # TODO: send a signal to the runners to interrupt a long test
   2956         foreach my $rid (keys %runnersrunning) {
   2957             runnerar($rid);
   2958             delete $runnersrunning{$rid};
   2959             logmsg ".";
   2960             $| = 1;
   2961         }
   2962         logmsg "\n";
   2963         last;
   2964     }
   2965 
   2966     # Start a new test if possible
   2967     if(scalar(@runnersidle) && scalar(@runtests)) {
   2968         # A runner is ready to run a test, and tests are still available to run
   2969         # so start a new test.
   2970         $count++;
   2971         my $testnum = shift(@runtests);
   2972 
   2973         # pick a runner for this new test
   2974         my $runnerid = pickrunner($testnum);
   2975         $countforrunner{$runnerid} = $count;
   2976 
   2977         # Start the test
   2978         my ($error, $again) = singletest($runnerid, $testnum, $countforrunner{$runnerid}, $totaltests);
   2979         if($again) {
   2980             # this runner is busy running a test
   2981             $runnersrunning{$runnerid} = $testnum;
   2982         } else {
   2983             runnerready($runnerid);
   2984             if($error >= 0) {
   2985                 # We make this simplifying assumption to avoid having to handle
   2986                 # $error properly here, but we must handle the case of runner
   2987                 # death without abending here.
   2988                 die "Internal error: test must not complete on first call";
   2989             }
   2990         }
   2991     }
   2992 
   2993     # See if we've completed all the tests
   2994     if(!scalar(%runnersrunning)) {
   2995         # No runners are running; we must be done
   2996         scalar(@runtests) && die 'Internal error: still have tests to run';
   2997         last;
   2998     }
   2999 
   3000     # See if a test runner needs attention
   3001     # If we could be running more tests, don't wait so we can schedule a new
   3002     # one immediately. If all runners are busy, wait a fraction of a second
   3003     # for one to finish so we can still loop around to check the abort flag.
   3004     my $runnerwait = scalar(@runnersidle) && scalar(@runtests) ? 0 : 1.0;
   3005     my (@ridsready, $riderror) = runnerar_ready($runnerwait);
   3006     if(@ridsready) {
   3007         for my $ridready (@ridsready) {
   3008             if($ridready && ! defined $runnersrunning{$ridready}) {
   3009                 # On Linux, a closed pipe still shows up as ready instead of error.
   3010                 # Detect this here by seeing if we are expecting it to be ready and
   3011                 # treat it as an error if not.
   3012                 logmsg "ERROR: Runner $ridready is unexpectedly ready; is probably actually dead\n";
   3013                 $riderror = $ridready;
   3014                 undef $ridready;
   3015             }
   3016             if($ridready) {
   3017                 # This runner is ready to be serviced
   3018                 my $testnum = $runnersrunning{$ridready};
   3019                 defined $testnum ||  die "Internal error: test for runner $ridready unknown";
   3020                 delete $runnersrunning{$ridready};
   3021                 my ($error, $again) = singletest($ridready, $testnum, $countforrunner{$ridready}, $totaltests);
   3022                 if($again) {
   3023                     # this runner is busy running a test
   3024                     $runnersrunning{$ridready} = $testnum;
   3025                 } else {
   3026                     # Test is complete
   3027                     $runner_wait_cnt = 0;
   3028                     runnerready($ridready);
   3029 
   3030                     if($error < 0) {
   3031                         # not a test we can run
   3032                         next;
   3033                     }
   3034 
   3035                     $total++; # number of tests we've run
   3036                     $executed++;
   3037 
   3038                     if($error>0) {
   3039                         if($error==2) {
   3040                             # ignored test failures
   3041                             $failedign .= "$testnum ";
   3042                         }
   3043                         else {
   3044                             # make another attempt to counteract flaky failures
   3045                             if($retry_left > 0) {
   3046                                 $retry_left--;
   3047                                 $retry_done++;
   3048                                 $total--;
   3049                                 push(@runtests, $testnum);
   3050                                 $failedre .= "$testnum ";
   3051                             }
   3052                             else {
   3053                                 $failed.= "$testnum ";
   3054                             }
   3055                         }
   3056                         if($postmortem) {
   3057                             # display all files in $LOGDIR/ in a nice way
   3058                             displaylogs($ridready, $testnum);
   3059                         }
   3060                         if($error==2) {
   3061                             $ign++; # ignored test result counter
   3062                         }
   3063                         elsif(!$anyway) {
   3064                             # a test failed, abort
   3065                             logmsg "\n - abort tests\n";
   3066                             undef @runtests;  # empty out the remaining tests
   3067                         }
   3068                     }
   3069                     elsif(!$error) {
   3070                         $ok++; # successful test counter
   3071                     }
   3072                 }
   3073             }
   3074         }
   3075     }
   3076     if(!@ridsready && $runnerwait && !$torture && scalar(%runnersrunning)) {
   3077         $runner_wait_cnt++;
   3078         if($runner_wait_cnt >= 5) {
   3079             my $msg = "waiting for " . scalar(%runnersrunning) . " results:";
   3080             my $sep = " ";
   3081             foreach my $rid (keys %runnersrunning) {
   3082                 $msg .= $sep . $runnersrunning{$rid} . "[$rid]";
   3083                 $sep = ", "
   3084             }
   3085             logmsg "$msg\n";
   3086         }
   3087         if($runner_wait_cnt >= 10) {
   3088             $runner_wait_cnt = 0;
   3089             foreach my $rid (keys %runnersrunning) {
   3090                 my $testnum = $runnersrunning{$rid};
   3091                 logmsg "current state of test $testnum in [$rid]:\n";
   3092                 displaylogs($rid, $testnum);
   3093             }
   3094         }
   3095     }
   3096     if($riderror) {
   3097         logmsg "ERROR: runner $riderror is dead! aborting test run\n";
   3098         delete $runnersrunning{$riderror} if(defined $runnersrunning{$riderror});
   3099         $globalabort = 1;
   3100     }
   3101     if(!scalar(@runtests) && ++$endwaitcnt == (240 + $jobs)) {
   3102         # Once all tests have been scheduled on a runner at the end of a test
   3103         # run, we just wait for their results to come in. If we're still
   3104         # waiting after a couple of minutes ($endwaitcnt multiplied by
   3105         # $runnerwait, plus $jobs because that number won't time out), display
   3106         # the same test runner status as we give with a SIGUSR1. This will
   3107         # likely point to a single test that has hung.
   3108         logmsg "Hmmm, the tests are taking a while to finish. Here is the status:\n";
   3109         catch_usr1();
   3110     }
   3111 }
   3112 
   3113 my $sofar = time() - $start;
   3114 
   3115 #######################################################################
   3116 # Finish CI Test Run
   3117 citest_finishtestrun();
   3118 
   3119 # Tests done, stop the servers
   3120 foreach my $runnerid (values %runnerids) {
   3121     runnerac_stopservers($runnerid);
   3122 }
   3123 
   3124 # Wait for servers to stop
   3125 my $unexpected;
   3126 foreach my $runnerid (values %runnerids) {
   3127     my ($rid, $unexpect, $logs) = runnerar($runnerid);
   3128     $unexpected ||= $unexpect;
   3129     logmsg $logs;
   3130 }
   3131 
   3132 # Kill the runners
   3133 # There is a race condition here since we don't know exactly when the runners
   3134 # have each finished shutting themselves down, but we're about to exit so it
   3135 # doesn't make much difference.
   3136 foreach my $runnerid (values %runnerids) {
   3137     runnerac_shutdown($runnerid);
   3138     sleep 0;  # give runner a context switch so it can shut itself down
   3139 }
   3140 
   3141 my $numskipped = %skipped ? sum values %skipped : 0;
   3142 my $all = $total + $numskipped;
   3143 
   3144 runtimestats($lasttest);
   3145 
   3146 if($all) {
   3147     logmsg "TESTDONE: $all tests were considered during ".
   3148         sprintf("%.0f", $sofar) ." seconds.\n";
   3149 }
   3150 
   3151 if(%skipped && !$short) {
   3152     my $s=0;
   3153     # Temporary hash to print the restraints sorted by the number
   3154     # of their occurrences
   3155     my %restraints;
   3156     logmsg "TESTINFO: $numskipped tests were skipped due to these restraints:\n";
   3157 
   3158     for(keys %skipped) {
   3159         my $r = $_;
   3160         my $skip_count = $skipped{$r};
   3161         my $log_line = sprintf("TESTINFO: \"%s\" %d time%s (", $r, $skip_count,
   3162                            ($skip_count == 1) ? "" : "s");
   3163 
   3164         # now gather all test case numbers that had this reason for being
   3165         # skipped
   3166         my $c=0;
   3167         my $max = 9;
   3168         for(0 .. scalar @teststat) {
   3169             my $t = $_;
   3170             if($teststat[$t] && ($teststat[$t] eq $r)) {
   3171                 if($c < $max) {
   3172                     $log_line .= ", " if($c);
   3173                     $log_line .= $t;
   3174                 }
   3175                 $c++;
   3176             }
   3177         }
   3178         if($c > $max) {
   3179             $log_line .= " and ".($c-$max)." more";
   3180         }
   3181         $log_line .= ")\n";
   3182         $restraints{$log_line} = $skip_count;
   3183     }
   3184     foreach my $log_line (sort {$restraints{$b} <=> $restraints{$a} || uc($a) cmp uc($b)} keys %restraints) {
   3185         logmsg $log_line;
   3186     }
   3187 }
   3188 
   3189 sub testnumdetails {
   3190     my ($desc, $numlist) = @_;
   3191     foreach my $testnum (split(' ', $numlist)) {
   3192         if(!loadtest("${TESTDIR}/test${testnum}")) {
   3193             my @info_keywords = getpart("info", "keywords");
   3194             my $testname = (getpart("client", "name"))[0];
   3195             chomp $testname;
   3196             logmsg "$desc $testnum: '$testname'";
   3197             my $first = 1;
   3198             for my $k (@info_keywords) {
   3199                 chomp $k;
   3200                 my $sep = ($first == 1) ? " " : ", ";
   3201                 logmsg "$sep$k";
   3202                 $first = 0;
   3203             }
   3204             logmsg "\n";
   3205         }
   3206     }
   3207 }
   3208 
   3209 if($executed) {
   3210     if($failedre) {
   3211         my $sorted = numsortwords($failedre);
   3212         logmsg "::group::Failed Retried Test details\n";
   3213         testnumdetails("FAIL-RETRIED", $sorted);
   3214         logmsg "RETRIED: failed tests: $sorted\n";
   3215         logmsg "::endgroup::\n";
   3216     }
   3217 
   3218     if($passedign) {
   3219         my $sorted = numsortwords($passedign);
   3220         logmsg "::group::Passed Ignored Test details\n";
   3221         testnumdetails("PASSED-IGNORED", $sorted);
   3222         logmsg "IGNORED: passed tests: $sorted\n";
   3223         logmsg "::endgroup::\n";
   3224     }
   3225 
   3226     if($failedign) {
   3227         my $sorted = numsortwords($failedign);
   3228         testnumdetails("FAIL-IGNORED", $sorted);
   3229         logmsg "IGNORED: failed tests: $sorted\n";
   3230     }
   3231     logmsg sprintf("TESTDONE: $ok tests out of $total reported OK: %d%%\n",
   3232                    $ok/$total*100);
   3233 
   3234     if($failed && ($ok != $total)) {
   3235         my $failedsorted = numsortwords($failed);
   3236         logmsg "\n";
   3237         testnumdetails("FAIL", $failedsorted);
   3238         logmsg "\nTESTFAIL: These test cases failed: $failedsorted\n\n";
   3239     }
   3240 }
   3241 else {
   3242     logmsg "\nTESTFAIL: No tests were performed\n\n";
   3243     if(scalar(keys %enabled_keywords)) {
   3244         logmsg "TESTFAIL: Nothing matched these keywords: ";
   3245         for(keys %enabled_keywords) {
   3246             logmsg "$_ ";
   3247         }
   3248         logmsg "\n";
   3249     }
   3250 }
   3251 
   3252 if(($total && (($ok+$ign) != $total)) || !$total || $unexpected) {
   3253     exit 1;
   3254 }
	quickjs-tart quickjs-based runtime for wallet-core logic
	Log \| Files \| Refs \| README \| LICENSE