mirror of
https://github.com/curl/curl.git
synced 2024-12-15 06:40:09 +08:00
65729f65c7
It sometimes happens that a test hangs during a test run and never returns. The test harness will wait indefinitely for the results and on CI servers the CI job will eventually be killed after an hour or two. At the end of a test run, if results haven't come in within a couple of minutes, display the status of all test runners and what tests they're running to help in debugging the problem. This feature is really only kick in with parallel testing enabled, which is fine because without parallel testing it's usually easy to tell what test has hung. Closes #11980
3039 lines
99 KiB
Perl
Executable File
3039 lines
99 KiB
Perl
Executable File
#!/usr/bin/env perl
|
|
#***************************************************************************
|
|
# _ _ ____ _
|
|
# Project ___| | | | _ \| |
|
|
# / __| | | | |_) | |
|
|
# | (__| |_| | _ <| |___
|
|
# \___|\___/|_| \_\_____|
|
|
#
|
|
# Copyright (C) Daniel Stenberg, <daniel@haxx.se>, et al.
|
|
#
|
|
# This software is licensed as described in the file COPYING, which
|
|
# you should have received as part of this distribution. The terms
|
|
# are also available at https://curl.se/docs/copyright.html.
|
|
#
|
|
# You may opt to use, copy, modify, merge, publish, distribute and/or sell
|
|
# copies of the Software, and permit persons to whom the Software is
|
|
# furnished to do so, under the terms of the COPYING file.
|
|
#
|
|
# This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
|
|
# KIND, either express or implied.
|
|
#
|
|
# SPDX-License-Identifier: curl
|
|
#
|
|
###########################################################################
|
|
|
|
# Experimental hooks are available to run tests remotely on machines that
|
|
# are able to run curl but are unable to run the test harness.
|
|
# The following sections need to be modified:
|
|
#
|
|
# $HOSTIP, $HOST6IP - Set to the address of the host running the test suite
|
|
# $CLIENTIP, $CLIENT6IP - Set to the address of the host running curl
|
|
# runclient, runclientoutput - Modify to copy all the files in the log/
|
|
# directory to the system running curl, run the given command remotely
|
|
# and save the return code or returned stdout (respectively), then
|
|
# copy all the files from the remote system's log/ directory back to
|
|
# the host running the test suite. This can be done a few ways, such
|
|
# as using scp & ssh, rsync & telnet, or using a NFS shared directory
|
|
# and ssh.
|
|
#
|
|
# 'make && make test' needs to be done on both machines before making the
|
|
# above changes and running runtests.pl manually. In the shared NFS case,
|
|
# the contents of the tests/server/ directory must be from the host
|
|
# running the test suite, while the rest must be from the host running curl.
|
|
#
|
|
# Note that even with these changes a number of tests will still fail (mainly
|
|
# to do with cookies, those that set environment variables, or those that
|
|
# do more than touch the file system in a <precheck> or <postcheck>
|
|
# section). These can be added to the $TESTCASES line below,
|
|
# e.g. $TESTCASES="!8 !31 !63 !cookies..."
|
|
#
|
|
# Finally, to properly support -g and -n, checktestcmd needs to change
|
|
# to check the remote system's PATH, and the places in the code where
|
|
# the curl binary is read directly to determine its type also need to be
|
|
# fixed. As long as the -g option is never given, and the -n is always
|
|
# given, this won't be a problem.
|
|
|
|
use strict;
|
|
# Promote all warnings to fatal
|
|
use warnings FATAL => 'all';
|
|
use 5.006;
|
|
|
|
# These should be the only variables that might be needed to get edited:
|
|
|
|
BEGIN {
|
|
# Define srcdir to the location of the tests source directory. This is
|
|
# usually set by the Makefile, but for out-of-tree builds with direct
|
|
# invocation of runtests.pl, it may not be set.
|
|
if(!defined $ENV{'srcdir'}) {
|
|
use File::Basename;
|
|
$ENV{'srcdir'} = dirname(__FILE__);
|
|
}
|
|
push(@INC, $ENV{'srcdir'});
|
|
# run time statistics needs Time::HiRes
|
|
eval {
|
|
no warnings "all";
|
|
require Time::HiRes;
|
|
import Time::HiRes qw( time );
|
|
}
|
|
}
|
|
|
|
use Digest::MD5 qw(md5);
|
|
use List::Util 'sum';
|
|
|
|
use pathhelp qw(
|
|
exe_ext
|
|
sys_native_current_path
|
|
);
|
|
use processhelp qw(
|
|
portable_sleep
|
|
);
|
|
|
|
use appveyor;
|
|
use azure;
|
|
use getpart; # array functions
|
|
use servers;
|
|
use valgrind; # valgrind report parser
|
|
use globalconfig;
|
|
use runner;
|
|
use testutil;
|
|
|
|
my %custom_skip_reasons;
|
|
|
|
my $ACURL=$VCURL; # what curl binary to use to talk to APIs (relevant for CI)
|
|
# ACURL is handy to set to the system one for reliability
|
|
my $CURLCONFIG="../curl-config"; # curl-config from current build
|
|
|
|
# Normally, all test cases should be run, but at times it is handy to
|
|
# simply run a particular one:
|
|
my $TESTCASES="all";
|
|
|
|
# To run specific test cases, set them like:
|
|
# $TESTCASES="1 2 3 7 8";
|
|
|
|
#######################################################################
|
|
# No variables below this point should need to be modified
|
|
#
|
|
|
|
my $libtool;
|
|
my $repeat = 0;
|
|
|
|
my $start; # time at which testing started
|
|
|
|
my $uname_release = `uname -r`;
|
|
my $is_wsl = $uname_release =~ /Microsoft$/;
|
|
|
|
my $http_ipv6; # set if HTTP server has IPv6 support
|
|
my $http_unix; # set if HTTP server has Unix sockets support
|
|
my $ftp_ipv6; # set if FTP server has IPv6 support
|
|
|
|
my $resolver; # name of the resolver backend (for human presentation)
|
|
|
|
my $has_textaware; # set if running on a system that has a text mode concept
|
|
# on files. Windows for example
|
|
|
|
my %skipped; # skipped{reason}=counter, reasons for skip
|
|
my @teststat; # teststat[testnum]=reason, reasons for skip
|
|
my %disabled_keywords; # key words of tests to skip
|
|
my %ignored_keywords; # key words of tests to ignore results
|
|
my %enabled_keywords; # key words of tests to run
|
|
my %disabled; # disabled test cases
|
|
my %ignored; # ignored results of test cases
|
|
my %ignoretestcodes; # if test results are to be ignored
|
|
|
|
my $timestats; # time stamping and stats generation
|
|
my $fullstats; # show time stats for every single test
|
|
my %timeprepini; # timestamp for each test preparation start
|
|
my %timesrvrini; # timestamp for each test required servers verification start
|
|
my %timesrvrend; # timestamp for each test required servers verification end
|
|
my %timetoolini; # timestamp for each test command run starting
|
|
my %timetoolend; # timestamp for each test command run stopping
|
|
my %timesrvrlog; # timestamp for each test server logs lock removal
|
|
my %timevrfyend; # timestamp for each test result verification end
|
|
my $globalabort; # flag signalling program abort
|
|
|
|
# values for $singletest_state
|
|
use constant {
|
|
ST_INIT => 0,
|
|
ST_CLEARLOCKS => 1,
|
|
ST_INITED => 2,
|
|
ST_PREPROCESS => 3,
|
|
ST_RUN => 4,
|
|
};
|
|
my %singletest_state; # current state of singletest() by runner ID
|
|
my %singletest_logs; # log messages while in singletest array ref by runner
|
|
my $singletest_bufferedrunner; # runner ID which is buffering logs
|
|
my %runnerids; # runner IDs by number
|
|
my @runnersidle; # runner IDs idle and ready to execute a test
|
|
my %countforrunner; # test count by runner ID
|
|
my %runnersrunning; # tests currently running by runner ID
|
|
|
|
#######################################################################
|
|
# variables that command line options may set
|
|
#
|
|
my $short;
|
|
my $no_debuginfod;
|
|
my $keepoutfiles; # keep stdout and stderr files after tests
|
|
my $clearlocks; # force removal of files by killing locking processes
|
|
my $postmortem; # display detailed info about failed tests
|
|
my $run_disabled; # run the specific tests even if listed in DISABLED
|
|
my $scrambleorder;
|
|
my $jobs = 0;
|
|
|
|
# Azure Pipelines specific variables
|
|
my $AZURE_RUN_ID = 0;
|
|
my $AZURE_RESULT_ID = 0;
|
|
|
|
#######################################################################
|
|
# logmsg is our general message logging subroutine.
|
|
#
|
|
sub logmsg {
|
|
if($singletest_bufferedrunner) {
|
|
# Logs are currently being buffered
|
|
return singletest_logmsg(@_);
|
|
}
|
|
for(@_) {
|
|
my $line = $_;
|
|
if(!$line) {
|
|
next;
|
|
}
|
|
if ($is_wsl) {
|
|
# use \r\n for WSL shell
|
|
$line =~ s/\r?\n$/\r\n/g;
|
|
}
|
|
print "$line";
|
|
}
|
|
}
|
|
|
|
#######################################################################
|
|
# enable logmsg buffering for the given runner ID
|
|
#
|
|
sub logmsg_bufferfortest {
|
|
my ($runnerid)=@_;
|
|
if($jobs) {
|
|
# Only enable buffering in multiprocess mode
|
|
$singletest_bufferedrunner = $runnerid;
|
|
}
|
|
}
|
|
#######################################################################
|
|
# Store a log message in a buffer for this test
|
|
# The messages can then be displayed all at once at the end of the test
|
|
# which prevents messages from different tests from being interleaved.
|
|
sub singletest_logmsg {
|
|
if(!exists $singletest_logs{$singletest_bufferedrunner}) {
|
|
# initialize to a reference to an empty anonymous array
|
|
$singletest_logs{$singletest_bufferedrunner} = [];
|
|
}
|
|
my $logsref = $singletest_logs{$singletest_bufferedrunner};
|
|
push @$logsref, @_;
|
|
}
|
|
|
|
#######################################################################
|
|
# Stop buffering log messages, but don't touch them
|
|
sub singletest_unbufferlogs {
|
|
undef $singletest_bufferedrunner;
|
|
}
|
|
|
|
#######################################################################
|
|
# Clear the buffered log messages & stop buffering after returning them
|
|
sub singletest_dumplogs {
|
|
if(!defined $singletest_bufferedrunner) {
|
|
# probably not multiprocess mode and logs weren't buffered
|
|
return undef;
|
|
}
|
|
my $logsref = $singletest_logs{$singletest_bufferedrunner};
|
|
my $msg = join("", @$logsref);
|
|
delete $singletest_logs{$singletest_bufferedrunner};
|
|
singletest_unbufferlogs();
|
|
return $msg;
|
|
}
|
|
|
|
sub catch_zap {
|
|
my $signame = shift;
|
|
print "runtests.pl received SIG$signame, exiting\r\n";
|
|
$globalabort = 1;
|
|
}
|
|
$SIG{INT} = \&catch_zap;
|
|
$SIG{TERM} = \&catch_zap;
|
|
|
|
sub catch_usr1 {
|
|
print "runtests.pl internal state:\r\n";
|
|
print scalar(%runnersrunning) . " busy test runner(s) of " . scalar(keys %runnerids) . "\r\n";
|
|
foreach my $rid (sort(keys(%runnersrunning))) {
|
|
my $runnernum = "unknown";
|
|
foreach my $rnum (keys %runnerids) {
|
|
if($runnerids{$rnum} == $rid) {
|
|
$runnernum = $rnum;
|
|
last;
|
|
}
|
|
}
|
|
print "Runner $runnernum (id $rid) running test $runnersrunning{$rid} in state $singletest_state{$rid}\r\n";
|
|
}
|
|
}
|
|
|
|
eval {
|
|
# some msys2 perl versions don't define SIGUSR1
|
|
$SIG{USR1} = \&catch_usr1;
|
|
};
|
|
$SIG{PIPE} = 'IGNORE'; # these errors are captured in the read/write calls
|
|
|
|
##########################################################################
|
|
# Clear all possible '*_proxy' environment variables for various protocols
|
|
# to prevent them to interfere with our testing!
|
|
|
|
foreach my $protocol (('ftp', 'http', 'ftps', 'https', 'no', 'all')) {
|
|
my $proxy = "${protocol}_proxy";
|
|
# clear lowercase version
|
|
delete $ENV{$proxy} if($ENV{$proxy});
|
|
# clear uppercase version
|
|
delete $ENV{uc($proxy)} if($ENV{uc($proxy)});
|
|
}
|
|
|
|
# make sure we don't get affected by other variables that control our
|
|
# behavior
|
|
|
|
delete $ENV{'SSL_CERT_DIR'} if($ENV{'SSL_CERT_DIR'});
|
|
delete $ENV{'SSL_CERT_PATH'} if($ENV{'SSL_CERT_PATH'});
|
|
delete $ENV{'CURL_CA_BUNDLE'} if($ENV{'CURL_CA_BUNDLE'});
|
|
|
|
# provide defaults from our config file for ENV vars not explicitly
|
|
# set by the caller
|
|
if (open(my $fd, "<", "config")) {
|
|
while(my $line = <$fd>) {
|
|
next if ($line =~ /^#/);
|
|
chomp $line;
|
|
my ($name, $val) = split(/\s*:\s*/, $line, 2);
|
|
$ENV{$name} = $val if(!$ENV{$name});
|
|
}
|
|
close($fd);
|
|
}
|
|
|
|
# Check if we have nghttpx available and if it talks http/3
|
|
my $nghttpx_h3 = 0;
|
|
if (!$ENV{"NGHTTPX"}) {
|
|
$ENV{"NGHTTPX"} = checktestcmd("nghttpx");
|
|
}
|
|
if ($ENV{"NGHTTPX"}) {
|
|
my $nghttpx_version=join(' ', `"$ENV{'NGHTTPX'}" -v 2>/dev/null`);
|
|
$nghttpx_h3 = $nghttpx_version =~ /nghttp3\//;
|
|
chomp $nghttpx_h3;
|
|
}
|
|
|
|
|
|
#######################################################################
|
|
# Get the list of tests that the tests/data/Makefile.am knows about!
|
|
#
|
|
my $disttests = "";
|
|
sub get_disttests {
|
|
# If a non-default $TESTDIR is being used there may not be any
|
|
# Makefile.inc in which case there's nothing to do.
|
|
open(my $dh, "<", "$TESTDIR/Makefile.inc") or return;
|
|
while(<$dh>) {
|
|
chomp $_;
|
|
if(($_ =~ /^#/) ||($_ !~ /test/)) {
|
|
next;
|
|
}
|
|
$disttests .= $_;
|
|
}
|
|
close($dh);
|
|
}
|
|
|
|
|
|
#######################################################################
|
|
# Remove all files in the specified directory
|
|
#
|
|
sub cleardir {
|
|
my $dir = $_[0];
|
|
my $done = 1; # success
|
|
my $file;
|
|
|
|
# Get all files
|
|
opendir(my $dh, $dir) ||
|
|
return 0; # can't open dir
|
|
while($file = readdir($dh)) {
|
|
# Don't clear the $PIDDIR or $LOCKDIR since those need to live beyond
|
|
# one test
|
|
if(($file !~ /^(\.|\.\.)\z/) &&
|
|
"$file" ne $PIDDIR && "$file" ne $LOCKDIR) {
|
|
if(-d "$dir/$file") {
|
|
if(!cleardir("$dir/$file")) {
|
|
$done = 0;
|
|
}
|
|
if(!rmdir("$dir/$file")) {
|
|
$done = 0;
|
|
}
|
|
}
|
|
else {
|
|
# Ignore stunnel since we cannot do anything about its locks
|
|
if(!unlink("$dir/$file") && "$file" !~ /_stunnel\.log$/) {
|
|
$done = 0;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
closedir $dh;
|
|
return $done;
|
|
}
|
|
|
|
|
|
#######################################################################
|
|
# Given two array references, this function will store them in two temporary
|
|
# files, run 'diff' on them, store the result and return the diff output!
|
|
sub showdiff {
|
|
my ($logdir, $firstref, $secondref)=@_;
|
|
|
|
my $file1="$logdir/check-generated";
|
|
my $file2="$logdir/check-expected";
|
|
|
|
open(my $temp, ">", "$file1") || die "Failure writing diff file";
|
|
for(@$firstref) {
|
|
my $l = $_;
|
|
$l =~ s/\r/[CR]/g;
|
|
$l =~ s/\n/[LF]/g;
|
|
$l =~ s/([^\x20-\x7f])/sprintf "%%%02x", ord $1/eg;
|
|
print $temp $l;
|
|
print $temp "\n";
|
|
}
|
|
close($temp) || die "Failure writing diff file";
|
|
|
|
open($temp, ">", "$file2") || die "Failure writing diff file";
|
|
for(@$secondref) {
|
|
my $l = $_;
|
|
$l =~ s/\r/[CR]/g;
|
|
$l =~ s/\n/[LF]/g;
|
|
$l =~ s/([^\x20-\x7f])/sprintf "%%%02x", ord $1/eg;
|
|
print $temp $l;
|
|
print $temp "\n";
|
|
}
|
|
close($temp) || die "Failure writing diff file";
|
|
my @out = `diff -u $file2 $file1 2>/dev/null`;
|
|
|
|
if(!$out[0]) {
|
|
@out = `diff -c $file2 $file1 2>/dev/null`;
|
|
}
|
|
|
|
return @out;
|
|
}
|
|
|
|
|
|
#######################################################################
|
|
# compare test results with the expected output, we might filter off
|
|
# some pattern that is allowed to differ, output test results
|
|
#
|
|
sub compare {
|
|
my ($runnerid, $testnum, $testname, $subject, $firstref, $secondref)=@_;
|
|
|
|
my $result = compareparts($firstref, $secondref);
|
|
|
|
if($result) {
|
|
# timestamp test result verification end
|
|
$timevrfyend{$testnum} = Time::HiRes::time();
|
|
|
|
if(!$short) {
|
|
logmsg "\n $testnum: $subject FAILED:\n";
|
|
my $logdir = getrunnerlogdir($runnerid);
|
|
logmsg showdiff($logdir, $firstref, $secondref);
|
|
}
|
|
elsif(!$automakestyle) {
|
|
logmsg "FAILED\n";
|
|
}
|
|
else {
|
|
# automakestyle
|
|
logmsg "FAIL: $testnum - $testname - $subject\n";
|
|
}
|
|
}
|
|
return $result;
|
|
}
|
|
|
|
#######################################################################
|
|
# Parse and store the protocols in curl's Protocols: line
|
|
sub parseprotocols {
|
|
my ($line)=@_;
|
|
|
|
@protocols = split(' ', lc($line));
|
|
|
|
# Generate a "proto-ipv6" version of each protocol to match the
|
|
# IPv6 <server> name and a "proto-unix" to match the variant which
|
|
# uses Unix domain sockets. This works even if support isn't
|
|
# compiled in because the <features> test will fail.
|
|
push @protocols, map(("$_-ipv6", "$_-unix"), @protocols);
|
|
|
|
# 'http-proxy' is used in test cases to do CONNECT through
|
|
push @protocols, 'http-proxy';
|
|
|
|
# 'none' is used in test cases to mean no server
|
|
push @protocols, 'none';
|
|
}
|
|
|
|
|
|
#######################################################################
|
|
# Check & display information about curl and the host the test suite runs on.
|
|
# Information to do with servers is displayed in displayserverfeatures, after
|
|
# the server initialization is performed.
|
|
sub checksystemfeatures {
|
|
my $feat;
|
|
my $curl;
|
|
my $libcurl;
|
|
my $versretval;
|
|
my $versnoexec;
|
|
my @version=();
|
|
my @disabled;
|
|
my $dis = "";
|
|
|
|
my $curlverout="$LOGDIR/curlverout.log";
|
|
my $curlvererr="$LOGDIR/curlvererr.log";
|
|
my $versioncmd=shell_quote($CURL) . " --version 1>$curlverout 2>$curlvererr";
|
|
|
|
unlink($curlverout);
|
|
unlink($curlvererr);
|
|
|
|
$versretval = runclient($versioncmd);
|
|
$versnoexec = $!;
|
|
|
|
open(my $versout, "<", "$curlverout");
|
|
@version = <$versout>;
|
|
close($versout);
|
|
|
|
open(my $disabledh, "-|", "server/disabled".exe_ext('TOOL'));
|
|
@disabled = <$disabledh>;
|
|
close($disabledh);
|
|
|
|
if($disabled[0]) {
|
|
s/[\r\n]//g for @disabled;
|
|
$dis = join(", ", @disabled);
|
|
}
|
|
|
|
$resolver="stock";
|
|
for(@version) {
|
|
chomp;
|
|
|
|
if($_ =~ /^curl ([^ ]*)/) {
|
|
$curl = $_;
|
|
$CURLVERSION = $1;
|
|
$curl =~ s/^(.*)(libcurl.*)/$1/g || die "Failure determining curl binary version";
|
|
|
|
$libcurl = $2;
|
|
if($curl =~ /linux|bsd|solaris/) {
|
|
# system support LD_PRELOAD; may be disabled later
|
|
$feature{"ld_preload"} = 1;
|
|
}
|
|
if($curl =~ /win32|Windows|mingw(32|64)/) {
|
|
# This is a Windows MinGW build or native build, we need to use
|
|
# Win32-style path.
|
|
$pwd = sys_native_current_path();
|
|
$has_textaware = 1;
|
|
$feature{"win32"} = 1;
|
|
# set if built with MinGW (as opposed to MinGW-w64)
|
|
$feature{"MinGW"} = 1 if ($curl =~ /-pc-mingw32/);
|
|
}
|
|
if ($libcurl =~ /\s(winssl|schannel)\b/i) {
|
|
$feature{"Schannel"} = 1;
|
|
$feature{"SSLpinning"} = 1;
|
|
}
|
|
elsif ($libcurl =~ /\sopenssl\b/i) {
|
|
$feature{"OpenSSL"} = 1;
|
|
$feature{"SSLpinning"} = 1;
|
|
}
|
|
elsif ($libcurl =~ /\sgnutls\b/i) {
|
|
$feature{"GnuTLS"} = 1;
|
|
$feature{"SSLpinning"} = 1;
|
|
}
|
|
elsif ($libcurl =~ /\srustls-ffi\b/i) {
|
|
$feature{"rustls"} = 1;
|
|
}
|
|
elsif ($libcurl =~ /\swolfssl\b/i) {
|
|
$feature{"wolfssl"} = 1;
|
|
$feature{"SSLpinning"} = 1;
|
|
}
|
|
elsif ($libcurl =~ /\sbearssl\b/i) {
|
|
$feature{"bearssl"} = 1;
|
|
}
|
|
elsif ($libcurl =~ /\ssecuretransport\b/i) {
|
|
$feature{"sectransp"} = 1;
|
|
$feature{"SSLpinning"} = 1;
|
|
}
|
|
elsif ($libcurl =~ /\sBoringSSL\b/i) {
|
|
# OpenSSL compatible API
|
|
$feature{"OpenSSL"} = 1;
|
|
$feature{"SSLpinning"} = 1;
|
|
}
|
|
elsif ($libcurl =~ /\slibressl\b/i) {
|
|
# OpenSSL compatible API
|
|
$feature{"OpenSSL"} = 1;
|
|
$feature{"SSLpinning"} = 1;
|
|
}
|
|
elsif ($libcurl =~ /\smbedTLS\b/i) {
|
|
$feature{"mbedtls"} = 1;
|
|
$feature{"SSLpinning"} = 1;
|
|
}
|
|
if ($libcurl =~ /ares/i) {
|
|
$feature{"c-ares"} = 1;
|
|
$resolver="c-ares";
|
|
}
|
|
if ($libcurl =~ /Hyper/i) {
|
|
$feature{"hyper"} = 1;
|
|
}
|
|
if ($libcurl =~ /nghttp2/i) {
|
|
# nghttp2 supports h2c, hyper does not
|
|
$feature{"h2c"} = 1;
|
|
}
|
|
if ($libcurl =~ /libssh2/i) {
|
|
$feature{"libssh2"} = 1;
|
|
}
|
|
if ($libcurl =~ /libssh\/([0-9.]*)\//i) {
|
|
$feature{"libssh"} = 1;
|
|
if($1 =~ /(\d+)\.(\d+).(\d+)/) {
|
|
my $v = $1 * 100 + $2 * 10 + $3;
|
|
if($v < 94) {
|
|
# before 0.9.4
|
|
$feature{"oldlibssh"} = 1;
|
|
}
|
|
}
|
|
}
|
|
if ($libcurl =~ /wolfssh/i) {
|
|
$feature{"wolfssh"} = 1;
|
|
}
|
|
}
|
|
elsif($_ =~ /^Protocols: (.*)/i) {
|
|
# these are the protocols compiled in to this libcurl
|
|
parseprotocols($1);
|
|
}
|
|
elsif($_ =~ /^Features: (.*)/i) {
|
|
$feat = $1;
|
|
|
|
# built with memory tracking support (--enable-curldebug); may be disabled later
|
|
$feature{"TrackMemory"} = $feat =~ /TrackMemory/i;
|
|
# curl was built with --enable-debug
|
|
$feature{"debug"} = $feat =~ /debug/i;
|
|
# ssl enabled
|
|
$feature{"SSL"} = $feat =~ /SSL/i;
|
|
# multiple ssl backends available.
|
|
$feature{"MultiSSL"} = $feat =~ /MultiSSL/i;
|
|
# large file support
|
|
$feature{"large_file"} = $feat =~ /Largefile/i;
|
|
# IDN support
|
|
$feature{"idn"} = $feat =~ /IDN/i;
|
|
# IPv6 support
|
|
$feature{"ipv6"} = $feat =~ /IPv6/i;
|
|
# Unix sockets support
|
|
$feature{"unix-sockets"} = $feat =~ /UnixSockets/i;
|
|
# libz compression
|
|
$feature{"libz"} = $feat =~ /libz/i;
|
|
# Brotli compression
|
|
$feature{"brotli"} = $feat =~ /brotli/i;
|
|
# Zstd compression
|
|
$feature{"zstd"} = $feat =~ /zstd/i;
|
|
# NTLM enabled
|
|
$feature{"NTLM"} = $feat =~ /NTLM/i;
|
|
# NTLM delegation to winbind daemon ntlm_auth helper enabled
|
|
$feature{"NTLM_WB"} = $feat =~ /NTLM_WB/i;
|
|
# SSPI enabled
|
|
$feature{"SSPI"} = $feat =~ /SSPI/i;
|
|
# GSS-API enabled
|
|
$feature{"GSS-API"} = $feat =~ /GSS-API/i;
|
|
# Kerberos enabled
|
|
$feature{"Kerberos"} = $feat =~ /Kerberos/i;
|
|
# SPNEGO enabled
|
|
$feature{"SPNEGO"} = $feat =~ /SPNEGO/i;
|
|
# CharConv enabled
|
|
$feature{"CharConv"} = $feat =~ /CharConv/i;
|
|
# TLS-SRP enabled
|
|
$feature{"TLS-SRP"} = $feat =~ /TLS-SRP/i;
|
|
# PSL enabled
|
|
$feature{"PSL"} = $feat =~ /PSL/i;
|
|
# alt-svc enabled
|
|
$feature{"alt-svc"} = $feat =~ /alt-svc/i;
|
|
# HSTS support
|
|
$feature{"HSTS"} = $feat =~ /HSTS/i;
|
|
if($feat =~ /AsynchDNS/i) {
|
|
if(!$feature{"c-ares"}) {
|
|
# this means threaded resolver
|
|
$feature{"threaded-resolver"} = 1;
|
|
$resolver="threaded";
|
|
}
|
|
}
|
|
# http2 enabled
|
|
$feature{"http/2"} = $feat =~ /HTTP2/;
|
|
if($feature{"http/2"}) {
|
|
push @protocols, 'http/2';
|
|
}
|
|
# http3 enabled
|
|
$feature{"http/3"} = $feat =~ /HTTP3/;
|
|
if($feature{"http/3"}) {
|
|
push @protocols, 'http/3';
|
|
}
|
|
# https proxy support
|
|
$feature{"https-proxy"} = $feat =~ /HTTPS-proxy/;
|
|
if($feature{"https-proxy"}) {
|
|
# 'https-proxy' is used as "server" so consider it a protocol
|
|
push @protocols, 'https-proxy';
|
|
}
|
|
# UNICODE support
|
|
$feature{"Unicode"} = $feat =~ /Unicode/i;
|
|
# Thread-safe init
|
|
$feature{"threadsafe"} = $feat =~ /threadsafe/i;
|
|
}
|
|
#
|
|
# Test harness currently uses a non-stunnel server in order to
|
|
# run HTTP TLS-SRP tests required when curl is built with https
|
|
# protocol support and TLS-SRP feature enabled. For convenience
|
|
# 'httptls' may be included in the test harness protocols array
|
|
# to differentiate this from classic stunnel based 'https' test
|
|
# harness server.
|
|
#
|
|
if($feature{"TLS-SRP"}) {
|
|
my $add_httptls;
|
|
for(@protocols) {
|
|
if($_ =~ /^https(-ipv6|)$/) {
|
|
$add_httptls=1;
|
|
last;
|
|
}
|
|
}
|
|
if($add_httptls && (! grep /^httptls$/, @protocols)) {
|
|
push @protocols, 'httptls';
|
|
push @protocols, 'httptls-ipv6';
|
|
}
|
|
}
|
|
}
|
|
|
|
if(!$curl) {
|
|
logmsg "unable to get curl's version, further details are:\n";
|
|
logmsg "issued command: \n";
|
|
logmsg "$versioncmd \n";
|
|
if ($versretval == -1) {
|
|
logmsg "command failed with: \n";
|
|
logmsg "$versnoexec \n";
|
|
}
|
|
elsif ($versretval & 127) {
|
|
logmsg sprintf("command died with signal %d, and %s coredump.\n",
|
|
($versretval & 127), ($versretval & 128)?"a":"no");
|
|
}
|
|
else {
|
|
logmsg sprintf("command exited with value %d \n", $versretval >> 8);
|
|
}
|
|
logmsg "contents of $curlverout: \n";
|
|
displaylogcontent("$curlverout");
|
|
logmsg "contents of $curlvererr: \n";
|
|
displaylogcontent("$curlvererr");
|
|
die "couldn't get curl's version";
|
|
}
|
|
|
|
if(-r "../lib/curl_config.h") {
|
|
open(my $conf, "<", "../lib/curl_config.h");
|
|
while(<$conf>) {
|
|
if($_ =~ /^\#define HAVE_GETRLIMIT/) {
|
|
# set if system has getrlimit()
|
|
$feature{"getrlimit"} = 1;
|
|
}
|
|
}
|
|
close($conf);
|
|
}
|
|
|
|
# allow this feature only if debug mode is disabled
|
|
$feature{"ld_preload"} = $feature{"ld_preload"} && !$feature{"debug"};
|
|
|
|
if($feature{"ipv6"}) {
|
|
# client has IPv6 support
|
|
|
|
# check if the HTTP server has it!
|
|
my $cmd = "server/sws".exe_ext('SRV')." --version";
|
|
my @sws = `$cmd`;
|
|
if($sws[0] =~ /IPv6/) {
|
|
# HTTP server has IPv6 support!
|
|
$http_ipv6 = 1;
|
|
}
|
|
|
|
# check if the FTP server has it!
|
|
$cmd = "server/sockfilt".exe_ext('SRV')." --version";
|
|
@sws = `$cmd`;
|
|
if($sws[0] =~ /IPv6/) {
|
|
# FTP server has IPv6 support!
|
|
$ftp_ipv6 = 1;
|
|
}
|
|
}
|
|
|
|
if($feature{"unix-sockets"}) {
|
|
# client has Unix sockets support, check whether the HTTP server has it
|
|
my $cmd = "server/sws".exe_ext('SRV')." --version";
|
|
my @sws = `$cmd`;
|
|
$http_unix = 1 if($sws[0] =~ /unix/);
|
|
}
|
|
|
|
open(my $manh, "-|", shell_quote($CURL) . " -M 2>&1");
|
|
while(my $s = <$manh>) {
|
|
if($s =~ /built-in manual was disabled at build-time/) {
|
|
$feature{"manual"} = 0;
|
|
last;
|
|
}
|
|
$feature{"manual"} = 1;
|
|
last;
|
|
}
|
|
close($manh);
|
|
|
|
$feature{"unittest"} = $feature{"debug"};
|
|
$feature{"nghttpx"} = !!$ENV{'NGHTTPX'};
|
|
$feature{"nghttpx-h3"} = !!$nghttpx_h3;
|
|
|
|
#
|
|
# strings that must exactly match the names used in server/disabled.c
|
|
#
|
|
$feature{"cookies"} = 1;
|
|
# Use this as a proxy for any cryptographic authentication
|
|
$feature{"crypto"} = $feature{"NTLM"} || $feature{"Kerberos"} || $feature{"SPNEGO"};
|
|
$feature{"DoH"} = 1;
|
|
$feature{"HTTP-auth"} = 1;
|
|
$feature{"Mime"} = 1;
|
|
$feature{"form-api"} = 1;
|
|
$feature{"netrc"} = 1;
|
|
$feature{"parsedate"} = 1;
|
|
$feature{"proxy"} = 1;
|
|
$feature{"shuffle-dns"} = 1;
|
|
$feature{"typecheck"} = 1;
|
|
$feature{"verbose-strings"} = 1;
|
|
$feature{"wakeup"} = 1;
|
|
$feature{"headers-api"} = 1;
|
|
$feature{"xattr"} = 1;
|
|
$feature{"large-time"} = 1;
|
|
|
|
# make each protocol an enabled "feature"
|
|
for my $p (@protocols) {
|
|
$feature{$p} = 1;
|
|
}
|
|
# 'socks' was once here but is now removed
|
|
|
|
$has_shared = `sh $CURLCONFIG --built-shared`;
|
|
chomp $has_shared;
|
|
$has_shared = $has_shared eq "yes";
|
|
|
|
if(!$feature{"TrackMemory"} && $torture) {
|
|
die "can't run torture tests since curl was built without ".
|
|
"TrackMemory feature (--enable-curldebug)";
|
|
}
|
|
|
|
my $hostname=join(' ', runclientoutput("hostname"));
|
|
my $hosttype=join(' ', runclientoutput("uname -a"));
|
|
my $hostos=$^O;
|
|
|
|
# display summary information about curl and the test host
|
|
logmsg ("********* System characteristics ******** \n",
|
|
"* $curl\n",
|
|
"* $libcurl\n",
|
|
"* Features: $feat\n",
|
|
"* Disabled: $dis\n",
|
|
"* Host: $hostname",
|
|
"* System: $hosttype",
|
|
"* OS: $hostos\n");
|
|
|
|
if($jobs) {
|
|
# Only show if not the default for now
|
|
logmsg "* Jobs: $jobs\n";
|
|
}
|
|
if($feature{"TrackMemory"} && $feature{"threaded-resolver"}) {
|
|
logmsg("*\n",
|
|
"*** DISABLES memory tracking when using threaded resolver\n",
|
|
"*\n");
|
|
}
|
|
|
|
logmsg sprintf("* Env: %s%s%s", $valgrind?"Valgrind ":"",
|
|
$run_event_based?"event-based ":"",
|
|
$nghttpx_h3);
|
|
logmsg sprintf("%s\n", $libtool?"Libtool ":"");
|
|
logmsg ("* Seed: $randseed\n");
|
|
|
|
# Disable memory tracking when using threaded resolver
|
|
$feature{"TrackMemory"} = $feature{"TrackMemory"} && !$feature{"threaded-resolver"};
|
|
|
|
# toggle off the features that were disabled in the build
|
|
for my $d(@disabled) {
|
|
$feature{$d} = 0;
|
|
}
|
|
}
|
|
|
|
#######################################################################
|
|
# display information about server features
|
|
#
|
|
sub displayserverfeatures {
|
|
logmsg sprintf("* Servers: %s", $stunnel?"SSL ":"");
|
|
logmsg sprintf("%s", $http_ipv6?"HTTP-IPv6 ":"");
|
|
logmsg sprintf("%s", $http_unix?"HTTP-unix ":"");
|
|
logmsg sprintf("%s\n", $ftp_ipv6?"FTP-IPv6 ":"");
|
|
logmsg "***************************************** \n";
|
|
}
|
|
|
|
#######################################################################
|
|
# Provide time stamps for single test skipped events
|
|
#
|
|
sub timestampskippedevents {
|
|
my $testnum = $_[0];
|
|
|
|
return if((not defined($testnum)) || ($testnum < 1));
|
|
|
|
if($timestats) {
|
|
|
|
if($timevrfyend{$testnum}) {
|
|
return;
|
|
}
|
|
elsif($timesrvrlog{$testnum}) {
|
|
$timevrfyend{$testnum} = $timesrvrlog{$testnum};
|
|
return;
|
|
}
|
|
elsif($timetoolend{$testnum}) {
|
|
$timevrfyend{$testnum} = $timetoolend{$testnum};
|
|
$timesrvrlog{$testnum} = $timetoolend{$testnum};
|
|
}
|
|
elsif($timetoolini{$testnum}) {
|
|
$timevrfyend{$testnum} = $timetoolini{$testnum};
|
|
$timesrvrlog{$testnum} = $timetoolini{$testnum};
|
|
$timetoolend{$testnum} = $timetoolini{$testnum};
|
|
}
|
|
elsif($timesrvrend{$testnum}) {
|
|
$timevrfyend{$testnum} = $timesrvrend{$testnum};
|
|
$timesrvrlog{$testnum} = $timesrvrend{$testnum};
|
|
$timetoolend{$testnum} = $timesrvrend{$testnum};
|
|
$timetoolini{$testnum} = $timesrvrend{$testnum};
|
|
}
|
|
elsif($timesrvrini{$testnum}) {
|
|
$timevrfyend{$testnum} = $timesrvrini{$testnum};
|
|
$timesrvrlog{$testnum} = $timesrvrini{$testnum};
|
|
$timetoolend{$testnum} = $timesrvrini{$testnum};
|
|
$timetoolini{$testnum} = $timesrvrini{$testnum};
|
|
$timesrvrend{$testnum} = $timesrvrini{$testnum};
|
|
}
|
|
elsif($timeprepini{$testnum}) {
|
|
$timevrfyend{$testnum} = $timeprepini{$testnum};
|
|
$timesrvrlog{$testnum} = $timeprepini{$testnum};
|
|
$timetoolend{$testnum} = $timeprepini{$testnum};
|
|
$timetoolini{$testnum} = $timeprepini{$testnum};
|
|
$timesrvrend{$testnum} = $timeprepini{$testnum};
|
|
$timesrvrini{$testnum} = $timeprepini{$testnum};
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
# Setup CI Test Run
|
|
sub citest_starttestrun {
|
|
if(azure_check_environment()) {
|
|
$AZURE_RUN_ID = azure_create_test_run($ACURL);
|
|
logmsg "Azure Run ID: $AZURE_RUN_ID\n" if ($verbose);
|
|
}
|
|
# Appveyor doesn't require anything here
|
|
}
|
|
|
|
|
|
# Register the test case with the CI runner
|
|
sub citest_starttest {
|
|
my $testnum = $_[0];
|
|
|
|
# get the name of the test early
|
|
my $testname= (getpart("client", "name"))[0];
|
|
chomp $testname;
|
|
|
|
# create test result in CI services
|
|
if(azure_check_environment() && $AZURE_RUN_ID) {
|
|
$AZURE_RESULT_ID = azure_create_test_result($ACURL, $AZURE_RUN_ID, $testnum, $testname);
|
|
}
|
|
elsif(appveyor_check_environment()) {
|
|
appveyor_create_test_result($ACURL, $testnum, $testname);
|
|
}
|
|
}
|
|
|
|
|
|
# Submit the test case result with the CI runner
|
|
sub citest_finishtest {
|
|
my ($testnum, $error) = @_;
|
|
# update test result in CI services
|
|
if(azure_check_environment() && $AZURE_RUN_ID && $AZURE_RESULT_ID) {
|
|
$AZURE_RESULT_ID = azure_update_test_result($ACURL, $AZURE_RUN_ID, $AZURE_RESULT_ID, $testnum, $error,
|
|
$timeprepini{$testnum}, $timevrfyend{$testnum});
|
|
}
|
|
elsif(appveyor_check_environment()) {
|
|
appveyor_update_test_result($ACURL, $testnum, $error, $timeprepini{$testnum}, $timevrfyend{$testnum});
|
|
}
|
|
}
|
|
|
|
# Complete CI test run
|
|
sub citest_finishtestrun {
|
|
if(azure_check_environment() && $AZURE_RUN_ID) {
|
|
$AZURE_RUN_ID = azure_update_test_run($ACURL, $AZURE_RUN_ID);
|
|
}
|
|
# Appveyor doesn't require anything here
|
|
}
|
|
|
|
|
|
# add one set of test timings from the runner to global set
|
|
sub updatetesttimings {
|
|
my ($testnum, %testtimings)=@_;
|
|
|
|
if(defined $testtimings{"timeprepini"}) {
|
|
$timeprepini{$testnum} = $testtimings{"timeprepini"};
|
|
}
|
|
if(defined $testtimings{"timesrvrini"}) {
|
|
$timesrvrini{$testnum} = $testtimings{"timesrvrini"};
|
|
}
|
|
if(defined $testtimings{"timesrvrend"}) {
|
|
$timesrvrend{$testnum} = $testtimings{"timesrvrend"};
|
|
}
|
|
if(defined $testtimings{"timetoolini"}) {
|
|
$timetoolini{$testnum} = $testtimings{"timetoolini"};
|
|
}
|
|
if(defined $testtimings{"timetoolend"}) {
|
|
$timetoolend{$testnum} = $testtimings{"timetoolend"};
|
|
}
|
|
if(defined $testtimings{"timesrvrlog"}) {
|
|
$timesrvrlog{$testnum} = $testtimings{"timesrvrlog"};
|
|
}
|
|
}
|
|
|
|
|
|
#######################################################################
|
|
# Return the log directory for the given test runner
|
|
sub getrunnernumlogdir {
|
|
my $runnernum = $_[0];
|
|
return $jobs > 1 ? "$LOGDIR/$runnernum" : $LOGDIR;
|
|
}
|
|
|
|
#######################################################################
|
|
# Return the log directory for the given test runner ID
|
|
sub getrunnerlogdir {
|
|
my $runnerid = $_[0];
|
|
if($jobs <= 1) {
|
|
return $LOGDIR;
|
|
}
|
|
# TODO: speed up this O(n) operation
|
|
for my $runnernum (keys %runnerids) {
|
|
if($runnerid eq $runnerids{$runnernum}) {
|
|
return "$LOGDIR/$runnernum";
|
|
}
|
|
}
|
|
die "Internal error: runner ID $runnerid not found";
|
|
}
|
|
|
|
|
|
#######################################################################
|
|
# Verify that this test case should be run
|
|
sub singletest_shouldrun {
|
|
my $testnum = $_[0];
|
|
my $why; # why the test won't be run
|
|
my $errorreturncode = 1; # 1 means normal error, 2 means ignored error
|
|
my @what; # what features are needed
|
|
|
|
if($disttests !~ /test$testnum(\W|\z)/ ) {
|
|
logmsg "Warning: test$testnum not present in tests/data/Makefile.inc\n";
|
|
}
|
|
if($disabled{$testnum}) {
|
|
if(!$run_disabled) {
|
|
$why = "listed in DISABLED";
|
|
}
|
|
else {
|
|
logmsg "Warning: test$testnum is explicitly disabled\n";
|
|
}
|
|
}
|
|
if($ignored{$testnum}) {
|
|
logmsg "Warning: test$testnum result is ignored\n";
|
|
$errorreturncode = 2;
|
|
}
|
|
|
|
if(loadtest("${TESTDIR}/test${testnum}")) {
|
|
if($verbose) {
|
|
# this is not a test
|
|
logmsg "RUN: $testnum doesn't look like a test case\n";
|
|
}
|
|
$why = "no test";
|
|
}
|
|
else {
|
|
@what = getpart("client", "features");
|
|
}
|
|
|
|
# We require a feature to be present
|
|
for(@what) {
|
|
my $f = $_;
|
|
$f =~ s/\s//g;
|
|
|
|
if($f =~ /^([^!].*)$/) {
|
|
if($feature{$1}) {
|
|
next;
|
|
}
|
|
|
|
$why = "curl lacks $1 support";
|
|
last;
|
|
}
|
|
}
|
|
|
|
# We require a feature to not be present
|
|
if(!$why) {
|
|
for(@what) {
|
|
my $f = $_;
|
|
$f =~ s/\s//g;
|
|
|
|
if($f =~ /^!(.*)$/) {
|
|
if(!$feature{$1}) {
|
|
next;
|
|
}
|
|
}
|
|
else {
|
|
next;
|
|
}
|
|
|
|
$why = "curl has $1 support";
|
|
last;
|
|
}
|
|
}
|
|
|
|
my @info_keywords;
|
|
if(!$why) {
|
|
@info_keywords = getpart("info", "keywords");
|
|
|
|
if(!$info_keywords[0]) {
|
|
$why = "missing the <keywords> section!";
|
|
}
|
|
|
|
my $match;
|
|
for my $k (@info_keywords) {
|
|
chomp $k;
|
|
if ($disabled_keywords{lc($k)}) {
|
|
$why = "disabled by keyword";
|
|
}
|
|
elsif ($enabled_keywords{lc($k)}) {
|
|
$match = 1;
|
|
}
|
|
if ($ignored_keywords{lc($k)}) {
|
|
logmsg "Warning: test$testnum result is ignored due to $k\n";
|
|
$errorreturncode = 2;
|
|
}
|
|
}
|
|
|
|
if(!$why && !$match && %enabled_keywords) {
|
|
$why = "disabled by missing keyword";
|
|
}
|
|
}
|
|
|
|
if (!$why && defined $custom_skip_reasons{test}{$testnum}) {
|
|
$why = $custom_skip_reasons{test}{$testnum};
|
|
}
|
|
|
|
if (!$why && defined $custom_skip_reasons{tool}) {
|
|
foreach my $tool (getpart("client", "tool")) {
|
|
foreach my $tool_skip_pattern (keys %{$custom_skip_reasons{tool}}) {
|
|
if ($tool =~ /$tool_skip_pattern/i) {
|
|
$why = $custom_skip_reasons{tool}{$tool_skip_pattern};
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
if (!$why && defined $custom_skip_reasons{keyword}) {
|
|
foreach my $keyword (@info_keywords) {
|
|
foreach my $keyword_skip_pattern (keys %{$custom_skip_reasons{keyword}}) {
|
|
if ($keyword =~ /$keyword_skip_pattern/i) {
|
|
$why = $custom_skip_reasons{keyword}{$keyword_skip_pattern};
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
return ($why, $errorreturncode);
|
|
}
|
|
|
|
|
|
#######################################################################
|
|
# Print the test name and count tests
|
|
sub singletest_count {
|
|
my ($testnum, $why) = @_;
|
|
|
|
if($why && !$listonly) {
|
|
# there's a problem, count it as "skipped"
|
|
$skipped{$why}++;
|
|
$teststat[$testnum]=$why; # store reason for this test case
|
|
|
|
if(!$short) {
|
|
if($skipped{$why} <= 3) {
|
|
# show only the first three skips for each reason
|
|
logmsg sprintf("test %04d SKIPPED: $why\n", $testnum);
|
|
}
|
|
}
|
|
|
|
timestampskippedevents($testnum);
|
|
return -1;
|
|
}
|
|
|
|
# At this point we've committed to run this test
|
|
logmsg sprintf("test %04d...", $testnum) if(!$automakestyle);
|
|
|
|
# name of the test
|
|
my $testname= (getpart("client", "name"))[0];
|
|
chomp $testname;
|
|
logmsg "[$testname]\n" if(!$short);
|
|
|
|
if($listonly) {
|
|
timestampskippedevents($testnum);
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
|
|
#######################################################################
|
|
# Verify test succeeded
|
|
sub singletest_check {
|
|
my ($runnerid, $testnum, $cmdres, $CURLOUT, $tool, $usedvalgrind)=@_;
|
|
|
|
# Skip all the verification on torture tests
|
|
if ($torture) {
|
|
# timestamp test result verification end
|
|
$timevrfyend{$testnum} = Time::HiRes::time();
|
|
return -2;
|
|
}
|
|
|
|
my $logdir = getrunnerlogdir($runnerid);
|
|
my @err = getpart("verify", "errorcode");
|
|
my $errorcode = $err[0] || "0";
|
|
my $ok="";
|
|
my $res;
|
|
chomp $errorcode;
|
|
my $testname= (getpart("client", "name"))[0];
|
|
chomp $testname;
|
|
# what parts to cut off from stdout/stderr
|
|
my @stripfile = getpart("verify", "stripfile");
|
|
|
|
my @validstdout = getpart("verify", "stdout");
|
|
# get all attributes
|
|
my %hash = getpartattr("verify", "stdout");
|
|
|
|
my $loadfile = $hash{'loadfile'};
|
|
if ($loadfile) {
|
|
open(my $tmp, "<", "$loadfile") || die "Cannot open file $loadfile: $!";
|
|
@validstdout = <$tmp>;
|
|
close($tmp);
|
|
|
|
# Enforce LF newlines on load
|
|
s/\r\n/\n/g for @validstdout;
|
|
}
|
|
|
|
if (@validstdout) {
|
|
# verify redirected stdout
|
|
my @actual = loadarray(stdoutfilename($logdir, $testnum));
|
|
|
|
foreach my $strip (@stripfile) {
|
|
chomp $strip;
|
|
my @newgen;
|
|
for(@actual) {
|
|
eval $strip;
|
|
if($_) {
|
|
push @newgen, $_;
|
|
}
|
|
}
|
|
# this is to get rid of array entries that vanished (zero
|
|
# length) because of replacements
|
|
@actual = @newgen;
|
|
}
|
|
|
|
# get the mode attribute
|
|
my $filemode=$hash{'mode'};
|
|
if($filemode && ($filemode eq "text") && $has_textaware) {
|
|
# text mode when running on windows: fix line endings
|
|
s/\r\n/\n/g for @validstdout;
|
|
s/\n/\r\n/g for @validstdout;
|
|
}
|
|
|
|
if($hash{'nonewline'}) {
|
|
# Yes, we must cut off the final newline from the final line
|
|
# of the protocol data
|
|
chomp($validstdout[-1]);
|
|
}
|
|
|
|
if($hash{'crlf'} ||
|
|
($feature{"hyper"} && ($keywords{"HTTP"}
|
|
|| $keywords{"HTTPS"}))) {
|
|
subnewlines(0, \$_) for @validstdout;
|
|
}
|
|
|
|
$res = compare($runnerid, $testnum, $testname, "stdout", \@actual, \@validstdout);
|
|
if($res) {
|
|
return -1;
|
|
}
|
|
$ok .= "s";
|
|
}
|
|
else {
|
|
$ok .= "-"; # stdout not checked
|
|
}
|
|
|
|
my @validstderr = getpart("verify", "stderr");
|
|
if (@validstderr) {
|
|
# verify redirected stderr
|
|
my @actual = loadarray(stderrfilename($logdir, $testnum));
|
|
|
|
foreach my $strip (@stripfile) {
|
|
chomp $strip;
|
|
my @newgen;
|
|
for(@actual) {
|
|
eval $strip;
|
|
if($_) {
|
|
push @newgen, $_;
|
|
}
|
|
}
|
|
# this is to get rid of array entries that vanished (zero
|
|
# length) because of replacements
|
|
@actual = @newgen;
|
|
}
|
|
|
|
# get all attributes
|
|
my %hash = getpartattr("verify", "stderr");
|
|
|
|
# get the mode attribute
|
|
my $filemode=$hash{'mode'};
|
|
if($filemode && ($filemode eq "text") && $feature{"hyper"}) {
|
|
# text mode check in hyper-mode. Sometimes necessary if the stderr
|
|
# data *looks* like HTTP and thus has gotten CRLF newlines
|
|
# mistakenly
|
|
s/\r\n/\n/g for @validstderr;
|
|
}
|
|
if($filemode && ($filemode eq "text") && $has_textaware) {
|
|
# text mode when running on windows: fix line endings
|
|
s/\r\n/\n/g for @validstderr;
|
|
s/\n/\r\n/g for @validstderr;
|
|
}
|
|
|
|
if($hash{'nonewline'}) {
|
|
# Yes, we must cut off the final newline from the final line
|
|
# of the protocol data
|
|
chomp($validstderr[-1]);
|
|
}
|
|
|
|
$res = compare($runnerid, $testnum, $testname, "stderr", \@actual, \@validstderr);
|
|
if($res) {
|
|
return -1;
|
|
}
|
|
$ok .= "r";
|
|
}
|
|
else {
|
|
$ok .= "-"; # stderr not checked
|
|
}
|
|
|
|
# what to cut off from the live protocol sent by curl
|
|
my @strip = getpart("verify", "strip");
|
|
|
|
# what parts to cut off from the protocol & upload
|
|
my @strippart = getpart("verify", "strippart");
|
|
|
|
# this is the valid protocol blurb curl should generate
|
|
my @protocol= getpart("verify", "protocol");
|
|
if(@protocol) {
|
|
# Verify the sent request
|
|
my @out = loadarray("$logdir/$SERVERIN");
|
|
|
|
# check if there's any attributes on the verify/protocol section
|
|
my %hash = getpartattr("verify", "protocol");
|
|
|
|
if($hash{'nonewline'}) {
|
|
# Yes, we must cut off the final newline from the final line
|
|
# of the protocol data
|
|
chomp($protocol[-1]);
|
|
}
|
|
|
|
for(@strip) {
|
|
# strip off all lines that match the patterns from both arrays
|
|
chomp $_;
|
|
@out = striparray( $_, \@out);
|
|
@protocol= striparray( $_, \@protocol);
|
|
}
|
|
|
|
for my $strip (@strippart) {
|
|
chomp $strip;
|
|
for(@out) {
|
|
eval $strip;
|
|
}
|
|
}
|
|
|
|
if($hash{'crlf'}) {
|
|
subnewlines(1, \$_) for @protocol;
|
|
}
|
|
|
|
if((!$out[0] || ($out[0] eq "")) && $protocol[0]) {
|
|
logmsg "\n $testnum: protocol FAILED!\n".
|
|
" There was no content at all in the file $logdir/$SERVERIN.\n".
|
|
" Server glitch? Total curl failure? Returned: $cmdres\n";
|
|
# timestamp test result verification end
|
|
$timevrfyend{$testnum} = Time::HiRes::time();
|
|
return -1;
|
|
}
|
|
|
|
$res = compare($runnerid, $testnum, $testname, "protocol", \@out, \@protocol);
|
|
if($res) {
|
|
return -1;
|
|
}
|
|
|
|
$ok .= "p";
|
|
|
|
}
|
|
else {
|
|
$ok .= "-"; # protocol not checked
|
|
}
|
|
|
|
my %replyattr = getpartattr("reply", "data");
|
|
my @reply;
|
|
if (partexists("reply", "datacheck")) {
|
|
for my $partsuffix (('', '1', '2', '3', '4')) {
|
|
my @replycheckpart = getpart("reply", "datacheck".$partsuffix);
|
|
if(@replycheckpart) {
|
|
my %replycheckpartattr = getpartattr("reply", "datacheck".$partsuffix);
|
|
# get the mode attribute
|
|
my $filemode=$replycheckpartattr{'mode'};
|
|
if($filemode && ($filemode eq "text") && $has_textaware) {
|
|
# text mode when running on windows: fix line endings
|
|
s/\r\n/\n/g for @replycheckpart;
|
|
s/\n/\r\n/g for @replycheckpart;
|
|
}
|
|
if($replycheckpartattr{'nonewline'}) {
|
|
# Yes, we must cut off the final newline from the final line
|
|
# of the datacheck
|
|
chomp($replycheckpart[-1]);
|
|
}
|
|
if($replycheckpartattr{'crlf'} ||
|
|
($feature{"hyper"} && ($keywords{"HTTP"}
|
|
|| $keywords{"HTTPS"}))) {
|
|
subnewlines(0, \$_) for @replycheckpart;
|
|
}
|
|
push(@reply, @replycheckpart);
|
|
}
|
|
}
|
|
}
|
|
else {
|
|
# check against the data section
|
|
@reply = getpart("reply", "data");
|
|
if(@reply) {
|
|
if($replyattr{'nonewline'}) {
|
|
# cut off the final newline from the final line of the data
|
|
chomp($reply[-1]);
|
|
}
|
|
}
|
|
# get the mode attribute
|
|
my $filemode=$replyattr{'mode'};
|
|
if($filemode && ($filemode eq "text") && $has_textaware) {
|
|
# text mode when running on windows: fix line endings
|
|
s/\r\n/\n/g for @reply;
|
|
s/\n/\r\n/g for @reply;
|
|
}
|
|
if($replyattr{'crlf'} ||
|
|
($feature{"hyper"} && ($keywords{"HTTP"}
|
|
|| $keywords{"HTTPS"}))) {
|
|
subnewlines(0, \$_) for @reply;
|
|
}
|
|
}
|
|
|
|
if(!$replyattr{'nocheck'} && (@reply || $replyattr{'sendzero'})) {
|
|
# verify the received data
|
|
my @out = loadarray($CURLOUT);
|
|
$res = compare($runnerid, $testnum, $testname, "data", \@out, \@reply);
|
|
if ($res) {
|
|
return -1;
|
|
}
|
|
$ok .= "d";
|
|
}
|
|
else {
|
|
$ok .= "-"; # data not checked
|
|
}
|
|
|
|
# if this section exists, we verify upload
|
|
my @upload = getpart("verify", "upload");
|
|
if(@upload) {
|
|
my %hash = getpartattr("verify", "upload");
|
|
if($hash{'nonewline'}) {
|
|
# cut off the final newline from the final line of the upload data
|
|
chomp($upload[-1]);
|
|
}
|
|
|
|
# verify uploaded data
|
|
my @out = loadarray("$logdir/upload.$testnum");
|
|
for my $strip (@strippart) {
|
|
chomp $strip;
|
|
for(@out) {
|
|
eval $strip;
|
|
}
|
|
}
|
|
|
|
$res = compare($runnerid, $testnum, $testname, "upload", \@out, \@upload);
|
|
if ($res) {
|
|
return -1;
|
|
}
|
|
$ok .= "u";
|
|
}
|
|
else {
|
|
$ok .= "-"; # upload not checked
|
|
}
|
|
|
|
# this is the valid protocol blurb curl should generate to a proxy
|
|
my @proxyprot = getpart("verify", "proxy");
|
|
if(@proxyprot) {
|
|
# Verify the sent proxy request
|
|
# check if there's any attributes on the verify/protocol section
|
|
my %hash = getpartattr("verify", "proxy");
|
|
|
|
if($hash{'nonewline'}) {
|
|
# Yes, we must cut off the final newline from the final line
|
|
# of the protocol data
|
|
chomp($proxyprot[-1]);
|
|
}
|
|
|
|
my @out = loadarray("$logdir/$PROXYIN");
|
|
for(@strip) {
|
|
# strip off all lines that match the patterns from both arrays
|
|
chomp $_;
|
|
@out = striparray( $_, \@out);
|
|
@proxyprot= striparray( $_, \@proxyprot);
|
|
}
|
|
|
|
for my $strip (@strippart) {
|
|
chomp $strip;
|
|
for(@out) {
|
|
eval $strip;
|
|
}
|
|
}
|
|
|
|
if($hash{'crlf'} ||
|
|
($feature{"hyper"} && ($keywords{"HTTP"} || $keywords{"HTTPS"}))) {
|
|
subnewlines(0, \$_) for @proxyprot;
|
|
}
|
|
|
|
$res = compare($runnerid, $testnum, $testname, "proxy", \@out, \@proxyprot);
|
|
if($res) {
|
|
return -1;
|
|
}
|
|
|
|
$ok .= "P";
|
|
|
|
}
|
|
else {
|
|
$ok .= "-"; # protocol not checked
|
|
}
|
|
|
|
my $outputok;
|
|
for my $partsuffix (('', '1', '2', '3', '4')) {
|
|
my @outfile=getpart("verify", "file".$partsuffix);
|
|
if(@outfile || partexists("verify", "file".$partsuffix) ) {
|
|
# we're supposed to verify a dynamically generated file!
|
|
my %hash = getpartattr("verify", "file".$partsuffix);
|
|
|
|
my $filename=$hash{'name'};
|
|
if(!$filename) {
|
|
logmsg " $testnum: IGNORED: section verify=>file$partsuffix ".
|
|
"has no name attribute\n";
|
|
if (runnerac_stopservers($runnerid)) {
|
|
logmsg "ERROR: runner $runnerid seems to have died\n";
|
|
} else {
|
|
|
|
# TODO: this is a blocking call that will stall the controller,
|
|
if($verbose) {
|
|
logmsg "WARNING: blocking call in async function\n";
|
|
}
|
|
# but this error condition should never happen except during
|
|
# development.
|
|
my ($rid, $unexpected, $logs) = runnerar($runnerid);
|
|
if(!$rid) {
|
|
logmsg "ERROR: runner $runnerid seems to have died\n";
|
|
} else {
|
|
logmsg $logs;
|
|
}
|
|
}
|
|
# timestamp test result verification end
|
|
$timevrfyend{$testnum} = Time::HiRes::time();
|
|
return -1;
|
|
}
|
|
my @generated=loadarray($filename);
|
|
|
|
# what parts to cut off from the file
|
|
my @stripfilepar = getpart("verify", "stripfile".$partsuffix);
|
|
|
|
my $filemode=$hash{'mode'};
|
|
if($filemode && ($filemode eq "text") && $has_textaware) {
|
|
# text mode when running on windows: fix line endings
|
|
s/\r\n/\n/g for @outfile;
|
|
s/\n/\r\n/g for @outfile;
|
|
}
|
|
if($hash{'crlf'} ||
|
|
($feature{"hyper"} && ($keywords{"HTTP"}
|
|
|| $keywords{"HTTPS"}))) {
|
|
subnewlines(0, \$_) for @outfile;
|
|
}
|
|
|
|
for my $strip (@stripfilepar) {
|
|
chomp $strip;
|
|
my @newgen;
|
|
for(@generated) {
|
|
eval $strip;
|
|
if($_) {
|
|
push @newgen, $_;
|
|
}
|
|
}
|
|
# this is to get rid of array entries that vanished (zero
|
|
# length) because of replacements
|
|
@generated = @newgen;
|
|
}
|
|
|
|
if($hash{'nonewline'}) {
|
|
# cut off the final newline from the final line of the
|
|
# output data
|
|
chomp($outfile[-1]);
|
|
}
|
|
|
|
$res = compare($runnerid, $testnum, $testname, "output ($filename)",
|
|
\@generated, \@outfile);
|
|
if($res) {
|
|
return -1;
|
|
}
|
|
|
|
$outputok = 1; # output checked
|
|
}
|
|
}
|
|
$ok .= ($outputok) ? "o" : "-"; # output checked or not
|
|
|
|
# verify SOCKS proxy details
|
|
my @socksprot = getpart("verify", "socks");
|
|
if(@socksprot) {
|
|
# Verify the sent SOCKS proxy details
|
|
my @out = loadarray("$logdir/$SOCKSIN");
|
|
$res = compare($runnerid, $testnum, $testname, "socks", \@out, \@socksprot);
|
|
if($res) {
|
|
return -1;
|
|
}
|
|
}
|
|
|
|
# accept multiple comma-separated error codes
|
|
my @splerr = split(/ *, */, $errorcode);
|
|
my $errok;
|
|
foreach my $e (@splerr) {
|
|
if($e == $cmdres) {
|
|
# a fine error code
|
|
$errok = 1;
|
|
last;
|
|
}
|
|
}
|
|
|
|
if($errok) {
|
|
$ok .= "e";
|
|
}
|
|
else {
|
|
if(!$short) {
|
|
logmsg sprintf("\n%s returned $cmdres, when expecting %s\n",
|
|
(!$tool)?"curl":$tool, $errorcode);
|
|
}
|
|
logmsg " $testnum: exit FAILED\n";
|
|
# timestamp test result verification end
|
|
$timevrfyend{$testnum} = Time::HiRes::time();
|
|
return -1;
|
|
}
|
|
|
|
if($feature{"TrackMemory"}) {
|
|
if(! -f "$logdir/$MEMDUMP") {
|
|
my %cmdhash = getpartattr("client", "command");
|
|
my $cmdtype = $cmdhash{'type'} || "default";
|
|
logmsg "\n** ALERT! memory tracking with no output file?\n"
|
|
if(!$cmdtype eq "perl");
|
|
$ok .= "-"; # problem with memory checking
|
|
}
|
|
else {
|
|
my @memdata=`$memanalyze "$logdir/$MEMDUMP"`;
|
|
my $leak=0;
|
|
for(@memdata) {
|
|
if($_ ne "") {
|
|
# well it could be other memory problems as well, but
|
|
# we call it leak for short here
|
|
$leak=1;
|
|
}
|
|
}
|
|
if($leak) {
|
|
logmsg "\n** MEMORY FAILURE\n";
|
|
logmsg @memdata;
|
|
# timestamp test result verification end
|
|
$timevrfyend{$testnum} = Time::HiRes::time();
|
|
return -1;
|
|
}
|
|
else {
|
|
$ok .= "m";
|
|
}
|
|
}
|
|
}
|
|
else {
|
|
$ok .= "-"; # memory not checked
|
|
}
|
|
|
|
if($valgrind) {
|
|
if($usedvalgrind) {
|
|
if(!opendir(DIR, "$logdir")) {
|
|
logmsg "ERROR: unable to read $logdir\n";
|
|
# timestamp test result verification end
|
|
$timevrfyend{$testnum} = Time::HiRes::time();
|
|
return -1;
|
|
}
|
|
my @files = readdir(DIR);
|
|
closedir(DIR);
|
|
my $vgfile;
|
|
foreach my $file (@files) {
|
|
if($file =~ /^valgrind$testnum(\..*|)$/) {
|
|
$vgfile = $file;
|
|
last;
|
|
}
|
|
}
|
|
if(!$vgfile) {
|
|
logmsg "ERROR: valgrind log file missing for test $testnum\n";
|
|
# timestamp test result verification end
|
|
$timevrfyend{$testnum} = Time::HiRes::time();
|
|
return -1;
|
|
}
|
|
my @e = valgrindparse("$logdir/$vgfile");
|
|
if(@e && $e[0]) {
|
|
if($automakestyle) {
|
|
logmsg "FAIL: $testnum - $testname - valgrind\n";
|
|
}
|
|
else {
|
|
logmsg " valgrind ERROR ";
|
|
logmsg @e;
|
|
}
|
|
# timestamp test result verification end
|
|
$timevrfyend{$testnum} = Time::HiRes::time();
|
|
return -1;
|
|
}
|
|
$ok .= "v";
|
|
}
|
|
else {
|
|
if($verbose) {
|
|
logmsg " valgrind SKIPPED\n";
|
|
}
|
|
$ok .= "-"; # skipped
|
|
}
|
|
}
|
|
else {
|
|
$ok .= "-"; # valgrind not checked
|
|
}
|
|
# add 'E' for event-based
|
|
$ok .= $run_event_based ? "E" : "-";
|
|
|
|
logmsg "$ok " if(!$short);
|
|
|
|
# timestamp test result verification end
|
|
$timevrfyend{$testnum} = Time::HiRes::time();
|
|
|
|
return 0;
|
|
}
|
|
|
|
|
|
#######################################################################
|
|
# Report a successful test
|
|
sub singletest_success {
|
|
my ($testnum, $count, $total, $errorreturncode)=@_;
|
|
|
|
my $sofar= time()-$start;
|
|
my $esttotal = $sofar/$count * $total;
|
|
my $estleft = $esttotal - $sofar;
|
|
my $timeleft=sprintf("remaining: %02d:%02d",
|
|
$estleft/60,
|
|
$estleft%60);
|
|
my $took = $timevrfyend{$testnum} - $timeprepini{$testnum};
|
|
my $duration = sprintf("duration: %02d:%02d",
|
|
$sofar/60, $sofar%60);
|
|
if(!$automakestyle) {
|
|
logmsg sprintf("OK (%-3d out of %-3d, %s, took %.3fs, %s)\n",
|
|
$count, $total, $timeleft, $took, $duration);
|
|
}
|
|
else {
|
|
my $testname= (getpart("client", "name"))[0];
|
|
chomp $testname;
|
|
logmsg "PASS: $testnum - $testname\n";
|
|
}
|
|
|
|
if($errorreturncode==2) {
|
|
logmsg "Warning: test$testnum result is ignored, but passed!\n";
|
|
}
|
|
}
|
|
|
|
#######################################################################
|
|
# Run a single specified test case
|
|
# This is structured as a state machine which changes state after an
|
|
# asynchronous call is made that awaits a response. The function returns with
|
|
# an error code and a flag that indicates if the state machine has completed,
|
|
# which means (if not) the function must be called again once the response has
|
|
# arrived.
|
|
#
|
|
sub singletest {
|
|
my ($runnerid, $testnum, $count, $total)=@_;
|
|
|
|
# start buffering logmsg; stop it on return
|
|
logmsg_bufferfortest($runnerid);
|
|
if(!exists $singletest_state{$runnerid}) {
|
|
# First time in singletest() for this test
|
|
$singletest_state{$runnerid} = ST_INIT;
|
|
}
|
|
|
|
if($singletest_state{$runnerid} == ST_INIT) {
|
|
my $logdir = getrunnerlogdir($runnerid);
|
|
# first, remove all lingering log & lock files
|
|
if((!cleardir($logdir) || !cleardir("$logdir/$LOCKDIR"))
|
|
&& $clearlocks) {
|
|
# On Windows, lock files can't be deleted when the process still
|
|
# has them open, so kill those processes first
|
|
if(runnerac_clearlocks($runnerid, "$logdir/$LOCKDIR")) {
|
|
logmsg "ERROR: runner $runnerid seems to have died\n";
|
|
$singletest_state{$runnerid} = ST_INIT;
|
|
return (-1, 0);
|
|
}
|
|
$singletest_state{$runnerid} = ST_CLEARLOCKS;
|
|
} else {
|
|
$singletest_state{$runnerid} = ST_INITED;
|
|
# Recursively call the state machine again because there is no
|
|
# event expected that would otherwise trigger a new call.
|
|
return singletest(@_);
|
|
}
|
|
|
|
} elsif($singletest_state{$runnerid} == ST_CLEARLOCKS) {
|
|
my ($rid, $logs) = runnerar($runnerid);
|
|
if(!$rid) {
|
|
logmsg "ERROR: runner $runnerid seems to have died\n";
|
|
$singletest_state{$runnerid} = ST_INIT;
|
|
return (-1, 0);
|
|
}
|
|
logmsg $logs;
|
|
my $logdir = getrunnerlogdir($runnerid);
|
|
cleardir($logdir);
|
|
$singletest_state{$runnerid} = ST_INITED;
|
|
# Recursively call the state machine again because there is no
|
|
# event expected that would otherwise trigger a new call.
|
|
return singletest(@_);
|
|
|
|
} elsif($singletest_state{$runnerid} == ST_INITED) {
|
|
###################################################################
|
|
# Restore environment variables that were modified in a previous run.
|
|
# Test definition may instruct to (un)set environment vars.
|
|
# This is done this early so that leftover variables don't affect
|
|
# starting servers or CI registration.
|
|
# restore_test_env(1);
|
|
|
|
###################################################################
|
|
# Load test file so CI registration can get the right data before the
|
|
# runner is called
|
|
loadtest("${TESTDIR}/test${testnum}");
|
|
|
|
###################################################################
|
|
# Register the test case with the CI environment
|
|
citest_starttest($testnum);
|
|
|
|
if(runnerac_test_preprocess($runnerid, $testnum)) {
|
|
logmsg "ERROR: runner $runnerid seems to have died\n";
|
|
$singletest_state{$runnerid} = ST_INIT;
|
|
return (-1, 0);
|
|
}
|
|
$singletest_state{$runnerid} = ST_PREPROCESS;
|
|
|
|
} elsif($singletest_state{$runnerid} == ST_PREPROCESS) {
|
|
my ($rid, $why, $error, $logs, $testtimings) = runnerar($runnerid);
|
|
if(!$rid) {
|
|
logmsg "ERROR: runner $runnerid seems to have died\n";
|
|
$singletest_state{$runnerid} = ST_INIT;
|
|
return (-1, 0);
|
|
}
|
|
logmsg $logs;
|
|
updatetesttimings($testnum, %$testtimings);
|
|
if($error == -2) {
|
|
if($postmortem) {
|
|
# Error indicates an actual problem starting the server, so
|
|
# display the server logs
|
|
displaylogs($rid, $testnum);
|
|
}
|
|
}
|
|
|
|
#######################################################################
|
|
# Load test file for this test number
|
|
my $logdir = getrunnerlogdir($runnerid);
|
|
loadtest("${logdir}/test${testnum}");
|
|
|
|
#######################################################################
|
|
# Print the test name and count tests
|
|
$error = singletest_count($testnum, $why);
|
|
if($error) {
|
|
# Submit the test case result with the CI environment
|
|
citest_finishtest($testnum, $error);
|
|
$singletest_state{$runnerid} = ST_INIT;
|
|
logmsg singletest_dumplogs();
|
|
return ($error, 0);
|
|
}
|
|
|
|
#######################################################################
|
|
# Execute this test number
|
|
my $cmdres;
|
|
my $CURLOUT;
|
|
my $tool;
|
|
my $usedvalgrind;
|
|
if(runnerac_test_run($runnerid, $testnum)) {
|
|
logmsg "ERROR: runner $runnerid seems to have died\n";
|
|
$singletest_state{$runnerid} = ST_INIT;
|
|
return (-1, 0);
|
|
}
|
|
$singletest_state{$runnerid} = ST_RUN;
|
|
|
|
} elsif($singletest_state{$runnerid} == ST_RUN) {
|
|
my ($rid, $error, $logs, $testtimings, $cmdres, $CURLOUT, $tool, $usedvalgrind) = runnerar($runnerid);
|
|
if(!$rid) {
|
|
logmsg "ERROR: runner $runnerid seems to have died\n";
|
|
$singletest_state{$runnerid} = ST_INIT;
|
|
return (-1, 0);
|
|
}
|
|
logmsg $logs;
|
|
updatetesttimings($testnum, %$testtimings);
|
|
if($error == -1) {
|
|
# no further verification will occur
|
|
$timevrfyend{$testnum} = Time::HiRes::time();
|
|
my $err = ignoreresultcode($testnum);
|
|
# Submit the test case result with the CI environment
|
|
citest_finishtest($testnum, $err);
|
|
$singletest_state{$runnerid} = ST_INIT;
|
|
logmsg singletest_dumplogs();
|
|
# return a test failure, either to be reported or to be ignored
|
|
return ($err, 0);
|
|
}
|
|
elsif($error == -2) {
|
|
# fill in the missing timings on error
|
|
timestampskippedevents($testnum);
|
|
# Submit the test case result with the CI environment
|
|
citest_finishtest($testnum, $error);
|
|
$singletest_state{$runnerid} = ST_INIT;
|
|
logmsg singletest_dumplogs();
|
|
return ($error, 0);
|
|
}
|
|
elsif($error > 0) {
|
|
# no further verification will occur
|
|
$timevrfyend{$testnum} = Time::HiRes::time();
|
|
# Submit the test case result with the CI environment
|
|
citest_finishtest($testnum, $error);
|
|
$singletest_state{$runnerid} = ST_INIT;
|
|
logmsg singletest_dumplogs();
|
|
return ($error, 0);
|
|
}
|
|
|
|
#######################################################################
|
|
# Verify that the test succeeded
|
|
#
|
|
# Load test file for this test number
|
|
my $logdir = getrunnerlogdir($runnerid);
|
|
loadtest("${logdir}/test${testnum}");
|
|
readtestkeywords();
|
|
|
|
$error = singletest_check($runnerid, $testnum, $cmdres, $CURLOUT, $tool, $usedvalgrind);
|
|
if($error == -1) {
|
|
my $err = ignoreresultcode($testnum);
|
|
# Submit the test case result with the CI environment
|
|
citest_finishtest($testnum, $err);
|
|
$singletest_state{$runnerid} = ST_INIT;
|
|
logmsg singletest_dumplogs();
|
|
# return a test failure, either to be reported or to be ignored
|
|
return ($err, 0);
|
|
}
|
|
elsif($error == -2) {
|
|
# torture test; there is no verification, so the run result holds the
|
|
# test success code
|
|
# Submit the test case result with the CI environment
|
|
citest_finishtest($testnum, $cmdres);
|
|
$singletest_state{$runnerid} = ST_INIT;
|
|
logmsg singletest_dumplogs();
|
|
return ($cmdres, 0);
|
|
}
|
|
|
|
|
|
#######################################################################
|
|
# Report a successful test
|
|
singletest_success($testnum, $count, $total, ignoreresultcode($testnum));
|
|
|
|
# Submit the test case result with the CI environment
|
|
citest_finishtest($testnum, 0);
|
|
$singletest_state{$runnerid} = ST_INIT;
|
|
|
|
logmsg singletest_dumplogs();
|
|
return (0, 0); # state machine is finished
|
|
}
|
|
singletest_unbufferlogs();
|
|
return (0, 1); # state machine must be called again on event
|
|
}
|
|
|
|
#######################################################################
|
|
# runtimestats displays test-suite run time statistics
|
|
#
|
|
sub runtimestats {
|
|
my $lasttest = $_[0];
|
|
|
|
return if(not $timestats);
|
|
|
|
logmsg "\nTest suite total running time breakdown per task...\n\n";
|
|
|
|
my @timesrvr;
|
|
my @timeprep;
|
|
my @timetool;
|
|
my @timelock;
|
|
my @timevrfy;
|
|
my @timetest;
|
|
my $timesrvrtot = 0.0;
|
|
my $timepreptot = 0.0;
|
|
my $timetooltot = 0.0;
|
|
my $timelocktot = 0.0;
|
|
my $timevrfytot = 0.0;
|
|
my $timetesttot = 0.0;
|
|
my $counter;
|
|
|
|
for my $testnum (1 .. $lasttest) {
|
|
if($timesrvrini{$testnum}) {
|
|
$timesrvrtot += $timesrvrend{$testnum} - $timesrvrini{$testnum};
|
|
$timepreptot +=
|
|
(($timetoolini{$testnum} - $timeprepini{$testnum}) -
|
|
($timesrvrend{$testnum} - $timesrvrini{$testnum}));
|
|
$timetooltot += $timetoolend{$testnum} - $timetoolini{$testnum};
|
|
$timelocktot += $timesrvrlog{$testnum} - $timetoolend{$testnum};
|
|
$timevrfytot += $timevrfyend{$testnum} - $timesrvrlog{$testnum};
|
|
$timetesttot += $timevrfyend{$testnum} - $timeprepini{$testnum};
|
|
push @timesrvr, sprintf("%06.3f %04d",
|
|
$timesrvrend{$testnum} - $timesrvrini{$testnum}, $testnum);
|
|
push @timeprep, sprintf("%06.3f %04d",
|
|
($timetoolini{$testnum} - $timeprepini{$testnum}) -
|
|
($timesrvrend{$testnum} - $timesrvrini{$testnum}), $testnum);
|
|
push @timetool, sprintf("%06.3f %04d",
|
|
$timetoolend{$testnum} - $timetoolini{$testnum}, $testnum);
|
|
push @timelock, sprintf("%06.3f %04d",
|
|
$timesrvrlog{$testnum} - $timetoolend{$testnum}, $testnum);
|
|
push @timevrfy, sprintf("%06.3f %04d",
|
|
$timevrfyend{$testnum} - $timesrvrlog{$testnum}, $testnum);
|
|
push @timetest, sprintf("%06.3f %04d",
|
|
$timevrfyend{$testnum} - $timeprepini{$testnum}, $testnum);
|
|
}
|
|
}
|
|
|
|
{
|
|
no warnings 'numeric';
|
|
@timesrvr = sort { $b <=> $a } @timesrvr;
|
|
@timeprep = sort { $b <=> $a } @timeprep;
|
|
@timetool = sort { $b <=> $a } @timetool;
|
|
@timelock = sort { $b <=> $a } @timelock;
|
|
@timevrfy = sort { $b <=> $a } @timevrfy;
|
|
@timetest = sort { $b <=> $a } @timetest;
|
|
}
|
|
|
|
logmsg "Spent ". sprintf("%08.3f ", $timesrvrtot) .
|
|
"seconds starting and verifying test harness servers.\n";
|
|
logmsg "Spent ". sprintf("%08.3f ", $timepreptot) .
|
|
"seconds reading definitions and doing test preparations.\n";
|
|
logmsg "Spent ". sprintf("%08.3f ", $timetooltot) .
|
|
"seconds actually running test tools.\n";
|
|
logmsg "Spent ". sprintf("%08.3f ", $timelocktot) .
|
|
"seconds awaiting server logs lock removal.\n";
|
|
logmsg "Spent ". sprintf("%08.3f ", $timevrfytot) .
|
|
"seconds verifying test results.\n";
|
|
logmsg "Spent ". sprintf("%08.3f ", $timetesttot) .
|
|
"seconds doing all of the above.\n";
|
|
|
|
$counter = 25;
|
|
logmsg "\nTest server starting and verification time per test ".
|
|
sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
|
|
logmsg "-time- test\n";
|
|
logmsg "------ ----\n";
|
|
foreach my $txt (@timesrvr) {
|
|
last if((not $fullstats) && (not $counter--));
|
|
logmsg "$txt\n";
|
|
}
|
|
|
|
$counter = 10;
|
|
logmsg "\nTest definition reading and preparation time per test ".
|
|
sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
|
|
logmsg "-time- test\n";
|
|
logmsg "------ ----\n";
|
|
foreach my $txt (@timeprep) {
|
|
last if((not $fullstats) && (not $counter--));
|
|
logmsg "$txt\n";
|
|
}
|
|
|
|
$counter = 25;
|
|
logmsg "\nTest tool execution time per test ".
|
|
sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
|
|
logmsg "-time- test\n";
|
|
logmsg "------ ----\n";
|
|
foreach my $txt (@timetool) {
|
|
last if((not $fullstats) && (not $counter--));
|
|
logmsg "$txt\n";
|
|
}
|
|
|
|
$counter = 15;
|
|
logmsg "\nTest server logs lock removal time per test ".
|
|
sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
|
|
logmsg "-time- test\n";
|
|
logmsg "------ ----\n";
|
|
foreach my $txt (@timelock) {
|
|
last if((not $fullstats) && (not $counter--));
|
|
logmsg "$txt\n";
|
|
}
|
|
|
|
$counter = 10;
|
|
logmsg "\nTest results verification time per test ".
|
|
sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
|
|
logmsg "-time- test\n";
|
|
logmsg "------ ----\n";
|
|
foreach my $txt (@timevrfy) {
|
|
last if((not $fullstats) && (not $counter--));
|
|
logmsg "$txt\n";
|
|
}
|
|
|
|
$counter = 50;
|
|
logmsg "\nTotal time per test ".
|
|
sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
|
|
logmsg "-time- test\n";
|
|
logmsg "------ ----\n";
|
|
foreach my $txt (@timetest) {
|
|
last if((not $fullstats) && (not $counter--));
|
|
logmsg "$txt\n";
|
|
}
|
|
|
|
logmsg "\n";
|
|
}
|
|
|
|
#######################################################################
|
|
# returns code indicating why a test was skipped
|
|
# 0=unknown test, 1=use test result, 2=ignore test result
|
|
#
|
|
sub ignoreresultcode {
|
|
my ($testnum)=@_;
|
|
if(defined $ignoretestcodes{$testnum}) {
|
|
return $ignoretestcodes{$testnum};
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
#######################################################################
|
|
# Put the given runner ID onto the queue of runners ready for a new task
|
|
#
|
|
sub runnerready {
|
|
my ($runnerid)=@_;
|
|
push @runnersidle, $runnerid;
|
|
}
|
|
|
|
#######################################################################
|
|
# Create test runners
|
|
#
|
|
sub createrunners {
|
|
my ($numrunners)=@_;
|
|
if(! $numrunners) {
|
|
$numrunners++;
|
|
}
|
|
# create $numrunners runners with minimum 1
|
|
for my $runnernum (1..$numrunners) {
|
|
my $dir = getrunnernumlogdir($runnernum);
|
|
cleardir($dir);
|
|
mkdir($dir, 0777);
|
|
$runnerids{$runnernum} = runner_init($dir, $jobs);
|
|
runnerready($runnerids{$runnernum});
|
|
}
|
|
}
|
|
|
|
#######################################################################
|
|
# Pick a test runner for the given test
|
|
#
|
|
sub pickrunner {
|
|
my ($testnum)=@_;
|
|
scalar(@runnersidle) || die "No runners available";
|
|
|
|
return pop @runnersidle;
|
|
}
|
|
|
|
#######################################################################
|
|
# Check options to this test program
|
|
#
|
|
|
|
# Special case for CMake: replace '$TFLAGS' by the contents of the
|
|
# environment variable (if any).
|
|
if(@ARGV && $ARGV[-1] eq '$TFLAGS') {
|
|
pop @ARGV;
|
|
push(@ARGV, split(' ', $ENV{'TFLAGS'})) if defined($ENV{'TFLAGS'});
|
|
}
|
|
|
|
$valgrind = checktestcmd("valgrind");
|
|
my $number=0;
|
|
my $fromnum=-1;
|
|
my @testthis;
|
|
while(@ARGV) {
|
|
if ($ARGV[0] eq "-v") {
|
|
# verbose output
|
|
$verbose=1;
|
|
}
|
|
elsif ($ARGV[0] eq "-c") {
|
|
# use this path to curl instead of default
|
|
$DBGCURL=$CURL=$ARGV[1];
|
|
shift @ARGV;
|
|
}
|
|
elsif ($ARGV[0] eq "-vc") {
|
|
# use this path to a curl used to verify servers
|
|
|
|
# Particularly useful when you introduce a crashing bug somewhere in
|
|
# the development version as then it won't be able to run any tests
|
|
# since it can't verify the servers!
|
|
|
|
$VCURL=shell_quote($ARGV[1]);
|
|
shift @ARGV;
|
|
}
|
|
elsif ($ARGV[0] eq "-ac") {
|
|
# use this curl only to talk to APIs (currently only CI test APIs)
|
|
$ACURL=shell_quote($ARGV[1]);
|
|
shift @ARGV;
|
|
}
|
|
elsif ($ARGV[0] eq "-d") {
|
|
# have the servers display protocol output
|
|
$debugprotocol=1;
|
|
}
|
|
elsif($ARGV[0] eq "-e") {
|
|
# run the tests cases event based if possible
|
|
$run_event_based=1;
|
|
}
|
|
elsif($ARGV[0] eq "-f") {
|
|
# force - run the test case even if listed in DISABLED
|
|
$run_disabled=1;
|
|
}
|
|
elsif($ARGV[0] eq "-E") {
|
|
# load additional reasons to skip tests
|
|
shift @ARGV;
|
|
my $exclude_file = $ARGV[0];
|
|
open(my $fd, "<", $exclude_file) or die "Couldn't open '$exclude_file': $!";
|
|
while(my $line = <$fd>) {
|
|
next if ($line =~ /^#/);
|
|
chomp $line;
|
|
my ($type, $patterns, $skip_reason) = split(/\s*:\s*/, $line, 3);
|
|
|
|
die "Unsupported type: $type\n" if($type !~ /^keyword|test|tool$/);
|
|
|
|
foreach my $pattern (split(/,/, $patterns)) {
|
|
if($type eq "test") {
|
|
# Strip leading zeros in the test number
|
|
$pattern = int($pattern);
|
|
}
|
|
$custom_skip_reasons{$type}{$pattern} = $skip_reason;
|
|
}
|
|
}
|
|
close($fd);
|
|
}
|
|
elsif ($ARGV[0] eq "-g") {
|
|
# run this test with gdb
|
|
$gdbthis=1;
|
|
}
|
|
elsif ($ARGV[0] eq "-gw") {
|
|
# run this test with windowed gdb
|
|
$gdbthis=1;
|
|
$gdbxwin=1;
|
|
}
|
|
elsif($ARGV[0] eq "-s") {
|
|
# short output
|
|
$short=1;
|
|
}
|
|
elsif($ARGV[0] eq "-am") {
|
|
# automake-style output
|
|
$short=1;
|
|
$automakestyle=1;
|
|
}
|
|
elsif($ARGV[0] eq "-n") {
|
|
# no valgrind
|
|
undef $valgrind;
|
|
}
|
|
elsif($ARGV[0] eq "--no-debuginfod") {
|
|
# disable the valgrind debuginfod functionality
|
|
$no_debuginfod = 1;
|
|
}
|
|
elsif ($ARGV[0] eq "-R") {
|
|
# execute in scrambled order
|
|
$scrambleorder=1;
|
|
}
|
|
elsif($ARGV[0] =~ /^-t(.*)/) {
|
|
# torture
|
|
$torture=1;
|
|
my $xtra = $1;
|
|
|
|
if($xtra =~ s/(\d+)$//) {
|
|
$tortalloc = $1;
|
|
}
|
|
}
|
|
elsif($ARGV[0] =~ /--shallow=(\d+)/) {
|
|
# Fail no more than this amount per tests when running
|
|
# torture.
|
|
my ($num)=($1);
|
|
$shallow=$num;
|
|
}
|
|
elsif($ARGV[0] =~ /--repeat=(\d+)/) {
|
|
# Repeat-run the given tests this many times
|
|
$repeat = $1;
|
|
}
|
|
elsif($ARGV[0] =~ /--seed=(\d+)/) {
|
|
# Set a fixed random seed (used for -R and --shallow)
|
|
$randseed = $1;
|
|
}
|
|
elsif($ARGV[0] eq "-a") {
|
|
# continue anyway, even if a test fail
|
|
$anyway=1;
|
|
}
|
|
elsif($ARGV[0] eq "-o") {
|
|
shift @ARGV;
|
|
if ($ARGV[0] =~ /^(\w+)=([\w.:\/\[\]-]+)$/) {
|
|
my ($variable, $value) = ($1, $2);
|
|
eval "\$$variable='$value'" or die "Failed to set \$$variable to $value: $@";
|
|
} else {
|
|
die "Failed to parse '-o $ARGV[0]'. May contain unexpected characters.\n";
|
|
}
|
|
}
|
|
elsif($ARGV[0] eq "-p") {
|
|
$postmortem=1;
|
|
}
|
|
elsif($ARGV[0] eq "-P") {
|
|
shift @ARGV;
|
|
$proxy_address=$ARGV[0];
|
|
}
|
|
elsif($ARGV[0] eq "-L") {
|
|
# require additional library file
|
|
shift @ARGV;
|
|
require $ARGV[0];
|
|
}
|
|
elsif($ARGV[0] eq "-l") {
|
|
# lists the test case names only
|
|
$listonly=1;
|
|
}
|
|
elsif($ARGV[0] =~ /^-j(.*)/) {
|
|
# parallel jobs
|
|
$jobs=1;
|
|
my $xtra = $1;
|
|
if($xtra =~ s/(\d+)$//) {
|
|
$jobs = $1;
|
|
}
|
|
}
|
|
elsif($ARGV[0] eq "-k") {
|
|
# keep stdout and stderr files after tests
|
|
$keepoutfiles=1;
|
|
}
|
|
elsif($ARGV[0] eq "-r") {
|
|
# run time statistics needs Time::HiRes
|
|
if($Time::HiRes::VERSION) {
|
|
# presize hashes appropriately to hold an entire test run
|
|
keys(%timeprepini) = 2000;
|
|
keys(%timesrvrini) = 2000;
|
|
keys(%timesrvrend) = 2000;
|
|
keys(%timetoolini) = 2000;
|
|
keys(%timetoolend) = 2000;
|
|
keys(%timesrvrlog) = 2000;
|
|
keys(%timevrfyend) = 2000;
|
|
$timestats=1;
|
|
$fullstats=0;
|
|
}
|
|
}
|
|
elsif($ARGV[0] eq "-rf") {
|
|
# run time statistics needs Time::HiRes
|
|
if($Time::HiRes::VERSION) {
|
|
# presize hashes appropriately to hold an entire test run
|
|
keys(%timeprepini) = 2000;
|
|
keys(%timesrvrini) = 2000;
|
|
keys(%timesrvrend) = 2000;
|
|
keys(%timetoolini) = 2000;
|
|
keys(%timetoolend) = 2000;
|
|
keys(%timesrvrlog) = 2000;
|
|
keys(%timevrfyend) = 2000;
|
|
$timestats=1;
|
|
$fullstats=1;
|
|
}
|
|
}
|
|
elsif($ARGV[0] eq "-rm") {
|
|
# force removal of files by killing locking processes
|
|
$clearlocks=1;
|
|
}
|
|
elsif($ARGV[0] eq "-u") {
|
|
# error instead of warning on server unexpectedly alive
|
|
$err_unexpected=1;
|
|
}
|
|
elsif(($ARGV[0] eq "-h") || ($ARGV[0] eq "--help")) {
|
|
# show help text
|
|
print <<"EOHELP"
|
|
Usage: runtests.pl [options] [test selection(s)]
|
|
-a continue even if a test fails
|
|
-ac path use this curl only to talk to APIs (currently only CI test APIs)
|
|
-am automake style output PASS/FAIL: [number] [name]
|
|
-c path use this curl executable
|
|
-d display server debug info
|
|
-e event-based execution
|
|
-E file load the specified file to exclude certain tests
|
|
-f forcibly run even if disabled
|
|
-g run the test case with gdb
|
|
-gw run the test case with gdb as a windowed application
|
|
-h this help text
|
|
-j[N] spawn this number of processes to run tests (default 0)
|
|
-k keep stdout and stderr files present after tests
|
|
-L path require an additional perl library file to replace certain functions
|
|
-l list all test case names/descriptions
|
|
-n no valgrind
|
|
--no-debuginfod disable the valgrind debuginfod functionality
|
|
-o variable=value set internal variable to the specified value
|
|
-P proxy use the specified proxy
|
|
-p print log file contents when a test fails
|
|
-R scrambled order (uses the random seed, see --seed)
|
|
-r run time statistics
|
|
-rf full run time statistics
|
|
-rm force removal of files by killing locking processes (Windows only)
|
|
--repeat=[num] run the given tests this many times
|
|
-s short output
|
|
--seed=[num] set the random seed to a fixed number
|
|
--shallow=[num] randomly makes the torture tests "thinner"
|
|
-t[N] torture (simulate function failures); N means fail Nth function
|
|
-u error instead of warning on server unexpectedly alive
|
|
-v verbose output
|
|
-vc path use this curl only to verify the existing servers
|
|
[num] like "5 6 9" or " 5 to 22 " to run those tests only
|
|
[!num] like "!5 !6 !9" to disable those tests
|
|
[~num] like "~5 ~6 ~9" to ignore the result of those tests
|
|
[keyword] like "IPv6" to select only tests containing the key word
|
|
[!keyword] like "!cookies" to disable any tests containing the key word
|
|
[~keyword] like "~cookies" to ignore results of tests containing key word
|
|
EOHELP
|
|
;
|
|
exit;
|
|
}
|
|
elsif($ARGV[0] =~ /^(\d+)/) {
|
|
$number = $1;
|
|
if($fromnum >= 0) {
|
|
for my $n ($fromnum .. $number) {
|
|
push @testthis, $n;
|
|
}
|
|
$fromnum = -1;
|
|
}
|
|
else {
|
|
push @testthis, $1;
|
|
}
|
|
}
|
|
elsif($ARGV[0] =~ /^to$/i) {
|
|
$fromnum = $number+1;
|
|
}
|
|
elsif($ARGV[0] =~ /^!(\d+)/) {
|
|
$fromnum = -1;
|
|
$disabled{$1}=$1;
|
|
}
|
|
elsif($ARGV[0] =~ /^~(\d+)/) {
|
|
$fromnum = -1;
|
|
$ignored{$1}=$1;
|
|
}
|
|
elsif($ARGV[0] =~ /^!(.+)/) {
|
|
$disabled_keywords{lc($1)}=$1;
|
|
}
|
|
elsif($ARGV[0] =~ /^~(.+)/) {
|
|
$ignored_keywords{lc($1)}=$1;
|
|
}
|
|
elsif($ARGV[0] =~ /^([-[{a-zA-Z].*)/) {
|
|
$enabled_keywords{lc($1)}=$1;
|
|
}
|
|
else {
|
|
print "Unknown option: $ARGV[0]\n";
|
|
exit;
|
|
}
|
|
shift @ARGV;
|
|
}
|
|
|
|
delete $ENV{'DEBUGINFOD_URLS'} if($ENV{'DEBUGINFOD_URLS'} && $no_debuginfod);
|
|
|
|
if(!$randseed) {
|
|
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
|
|
localtime(time);
|
|
# seed of the month. December 2019 becomes 201912
|
|
$randseed = ($year+1900)*100 + $mon+1;
|
|
print "Using curl: $CURL\n";
|
|
open(my $curlvh, "-|", shell_quote($CURL) . " --version 2>/dev/null") ||
|
|
die "could not get curl version!";
|
|
my @c = <$curlvh>;
|
|
close($curlvh) || die "could not get curl version!";
|
|
# use the first line of output and get the md5 out of it
|
|
my $str = md5($c[0]);
|
|
$randseed += unpack('S', $str); # unsigned 16 bit value
|
|
}
|
|
srand $randseed;
|
|
|
|
if(@testthis && ($testthis[0] ne "")) {
|
|
$TESTCASES=join(" ", @testthis);
|
|
}
|
|
|
|
if($valgrind) {
|
|
# we have found valgrind on the host, use it
|
|
|
|
# verify that we can invoke it fine
|
|
my $code = runclient("valgrind >/dev/null 2>&1");
|
|
|
|
if(($code>>8) != 1) {
|
|
#logmsg "Valgrind failure, disable it\n";
|
|
undef $valgrind;
|
|
} else {
|
|
|
|
# since valgrind 2.1.x, '--tool' option is mandatory
|
|
# use it, if it is supported by the version installed on the system
|
|
# (this happened in 2003, so we could probably don't need to care about
|
|
# that old version any longer and just delete this check)
|
|
runclient("valgrind --help 2>&1 | grep -- --tool > /dev/null 2>&1");
|
|
if (($? >> 8)) {
|
|
$valgrind_tool="";
|
|
}
|
|
open(my $curlh, "<", "$CURL");
|
|
my $l = <$curlh>;
|
|
if($l =~ /^\#\!/) {
|
|
# A shell script. This is typically when built with libtool,
|
|
$valgrind="../libtool --mode=execute $valgrind";
|
|
}
|
|
close($curlh);
|
|
|
|
# valgrind 3 renamed the --logfile option to --log-file!!!
|
|
# (this happened in 2005, so we could probably don't need to care about
|
|
# that old version any longer and just delete this check)
|
|
my $ver=join(' ', runclientoutput("valgrind --version"));
|
|
# cut off all but digits and dots
|
|
$ver =~ s/[^0-9.]//g;
|
|
|
|
if($ver =~ /^(\d+)/) {
|
|
$ver = $1;
|
|
if($ver < 3) {
|
|
$valgrind_logfile="--logfile";
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
if ($gdbthis) {
|
|
# open the executable curl and read the first 4 bytes of it
|
|
open(my $check, "<", "$CURL");
|
|
my $c;
|
|
sysread $check, $c, 4;
|
|
close($check);
|
|
if($c eq "#! /") {
|
|
# A shell script. This is typically when built with libtool,
|
|
$libtool = 1;
|
|
$gdb = "../libtool --mode=execute gdb";
|
|
}
|
|
}
|
|
|
|
#######################################################################
|
|
# clear and create logging directory:
|
|
#
|
|
|
|
# TODO: figure how to get around this. This dir is needed for checksystemfeatures()
|
|
# Maybe create & use & delete a temporary directory in that function
|
|
cleardir($LOGDIR);
|
|
mkdir($LOGDIR, 0777);
|
|
mkdir("$LOGDIR/$LOCKDIR", 0777);
|
|
|
|
#######################################################################
|
|
# initialize some variables
|
|
#
|
|
|
|
get_disttests();
|
|
if(!$jobs) {
|
|
# Disable buffered logging with only one test job
|
|
setlogfunc(\&logmsg);
|
|
}
|
|
|
|
#######################################################################
|
|
# Output curl version and host info being tested
|
|
#
|
|
|
|
if(!$listonly) {
|
|
checksystemfeatures();
|
|
}
|
|
|
|
#######################################################################
|
|
# initialize configuration needed to set up servers
|
|
# TODO: rearrange things so this can be called only in runner_init()
|
|
#
|
|
initserverconfig();
|
|
|
|
if(!$listonly) {
|
|
# these can only be displayed after initserverconfig() has been called
|
|
displayserverfeatures();
|
|
|
|
# globally disabled tests
|
|
disabledtests("$TESTDIR/DISABLED");
|
|
}
|
|
|
|
#######################################################################
|
|
# Fetch all disabled tests, if there are any
|
|
#
|
|
|
|
sub disabledtests {
|
|
my ($file) = @_;
|
|
my @input;
|
|
|
|
if(open(my $disabledh, "<", "$file")) {
|
|
while(<$disabledh>) {
|
|
if(/^ *\#/) {
|
|
# allow comments
|
|
next;
|
|
}
|
|
push @input, $_;
|
|
}
|
|
close($disabledh);
|
|
|
|
# preprocess the input to make conditionally disabled tests depending
|
|
# on variables
|
|
my @pp = prepro(0, @input);
|
|
for my $t (@pp) {
|
|
if($t =~ /(\d+)/) {
|
|
my ($n) = $1;
|
|
$disabled{$n}=$n; # disable this test number
|
|
if(! -f "$srcdir/data/test$n") {
|
|
print STDERR "WARNING! Non-existing test $n in $file!\n";
|
|
# fail hard to make user notice
|
|
exit 1;
|
|
}
|
|
logmsg "DISABLED: test $n\n" if ($verbose);
|
|
}
|
|
else {
|
|
print STDERR "$file: rubbish content: $t\n";
|
|
exit 2;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
#######################################################################
|
|
# If 'all' tests are requested, find out all test numbers
|
|
#
|
|
|
|
if ( $TESTCASES eq "all") {
|
|
# Get all commands and find out their test numbers
|
|
opendir(DIR, $TESTDIR) || die "can't opendir $TESTDIR: $!";
|
|
my @cmds = grep { /^test([0-9]+)$/ && -f "$TESTDIR/$_" } readdir(DIR);
|
|
closedir(DIR);
|
|
|
|
$TESTCASES=""; # start with no test cases
|
|
|
|
# cut off everything but the digits
|
|
for(@cmds) {
|
|
$_ =~ s/[a-z\/\.]*//g;
|
|
}
|
|
# sort the numbers from low to high
|
|
foreach my $n (sort { $a <=> $b } @cmds) {
|
|
if($disabled{$n}) {
|
|
# skip disabled test cases
|
|
my $why = "configured as DISABLED";
|
|
$skipped{$why}++;
|
|
$teststat[$n]=$why; # store reason for this test case
|
|
next;
|
|
}
|
|
$TESTCASES .= " $n";
|
|
}
|
|
}
|
|
else {
|
|
my $verified="";
|
|
for(split(" ", $TESTCASES)) {
|
|
if (-e "$TESTDIR/test$_") {
|
|
$verified.="$_ ";
|
|
}
|
|
}
|
|
if($verified eq "") {
|
|
print "No existing test cases were specified\n";
|
|
exit;
|
|
}
|
|
$TESTCASES = $verified;
|
|
}
|
|
if($repeat) {
|
|
my $s;
|
|
for(1 .. $repeat) {
|
|
$s .= $TESTCASES;
|
|
}
|
|
$TESTCASES = $s;
|
|
}
|
|
|
|
if($scrambleorder) {
|
|
# scramble the order of the test cases
|
|
my @rand;
|
|
while($TESTCASES) {
|
|
my @all = split(/ +/, $TESTCASES);
|
|
if(!$all[0]) {
|
|
# if the first is blank, shift away it
|
|
shift @all;
|
|
}
|
|
my $r = rand @all;
|
|
push @rand, $all[$r];
|
|
$all[$r]="";
|
|
$TESTCASES = join(" ", @all);
|
|
}
|
|
$TESTCASES = join(" ", @rand);
|
|
}
|
|
|
|
# Display the contents of the given file. Line endings are canonicalized
|
|
# and excessively long files are elided
|
|
sub displaylogcontent {
|
|
my ($file)=@_;
|
|
if(open(my $single, "<", "$file")) {
|
|
my $linecount = 0;
|
|
my $truncate;
|
|
my @tail;
|
|
while(my $string = <$single>) {
|
|
$string =~ s/\r\n/\n/g;
|
|
$string =~ s/[\r\f\032]/\n/g;
|
|
$string .= "\n" unless ($string =~ /\n$/);
|
|
$string =~ tr/\n//;
|
|
for my $line (split(m/\n/, $string)) {
|
|
$line =~ s/\s*\!$//;
|
|
if ($truncate) {
|
|
push @tail, " $line\n";
|
|
} else {
|
|
logmsg " $line\n";
|
|
}
|
|
$linecount++;
|
|
$truncate = $linecount > 1200;
|
|
}
|
|
}
|
|
close($single);
|
|
if(@tail) {
|
|
my $tailshow = 200;
|
|
my $tailskip = 0;
|
|
my $tailtotal = scalar @tail;
|
|
if($tailtotal > $tailshow) {
|
|
$tailskip = $tailtotal - $tailshow;
|
|
logmsg "=== File too long: $tailskip lines omitted here\n";
|
|
}
|
|
for($tailskip .. $tailtotal-1) {
|
|
logmsg "$tail[$_]";
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
sub displaylogs {
|
|
my ($runnerid, $testnum)=@_;
|
|
my $logdir = getrunnerlogdir($runnerid);
|
|
opendir(DIR, "$logdir") ||
|
|
die "can't open dir: $!";
|
|
my @logs = readdir(DIR);
|
|
closedir(DIR);
|
|
|
|
logmsg "== Contents of files in the $logdir/ dir after test $testnum\n";
|
|
foreach my $log (sort @logs) {
|
|
if($log =~ /\.(\.|)$/) {
|
|
next; # skip "." and ".."
|
|
}
|
|
if($log =~ /^\.nfs/) {
|
|
next; # skip ".nfs"
|
|
}
|
|
if(($log eq "memdump") || ($log eq "core")) {
|
|
next; # skip "memdump" and "core"
|
|
}
|
|
if((-d "$logdir/$log") || (! -s "$logdir/$log")) {
|
|
next; # skip directory and empty files
|
|
}
|
|
if(($log =~ /^stdout\d+/) && ($log !~ /^stdout$testnum/)) {
|
|
next; # skip stdoutNnn of other tests
|
|
}
|
|
if(($log =~ /^stderr\d+/) && ($log !~ /^stderr$testnum/)) {
|
|
next; # skip stderrNnn of other tests
|
|
}
|
|
if(($log =~ /^upload\d+/) && ($log !~ /^upload$testnum/)) {
|
|
next; # skip uploadNnn of other tests
|
|
}
|
|
if(($log =~ /^curl\d+\.out/) && ($log !~ /^curl$testnum\.out/)) {
|
|
next; # skip curlNnn.out of other tests
|
|
}
|
|
if(($log =~ /^test\d+\.txt/) && ($log !~ /^test$testnum\.txt/)) {
|
|
next; # skip testNnn.txt of other tests
|
|
}
|
|
if(($log =~ /^file\d+\.txt/) && ($log !~ /^file$testnum\.txt/)) {
|
|
next; # skip fileNnn.txt of other tests
|
|
}
|
|
if(($log =~ /^netrc\d+/) && ($log !~ /^netrc$testnum/)) {
|
|
next; # skip netrcNnn of other tests
|
|
}
|
|
if(($log =~ /^trace\d+/) && ($log !~ /^trace$testnum/)) {
|
|
next; # skip traceNnn of other tests
|
|
}
|
|
if(($log =~ /^valgrind\d+/) && ($log !~ /^valgrind$testnum(?:\..*)?$/)) {
|
|
next; # skip valgrindNnn of other tests
|
|
}
|
|
if(($log =~ /^test$testnum$/)) {
|
|
next; # skip test$testnum since it can be very big
|
|
}
|
|
logmsg "=== Start of file $log\n";
|
|
displaylogcontent("$logdir/$log");
|
|
logmsg "=== End of file $log\n";
|
|
}
|
|
}
|
|
|
|
#######################################################################
|
|
# Scan tests to find suitable candidates
|
|
#
|
|
|
|
my $failed;
|
|
my $failedign;
|
|
my $ok=0;
|
|
my $ign=0;
|
|
my $total=0;
|
|
my $lasttest=0;
|
|
my @at = split(" ", $TESTCASES);
|
|
my $count=0;
|
|
my $endwaitcnt=0;
|
|
|
|
$start = time();
|
|
|
|
# scan all tests to find ones we should try to run
|
|
my @runtests;
|
|
foreach my $testnum (@at) {
|
|
$lasttest = $testnum if($testnum > $lasttest);
|
|
my ($why, $errorreturncode) = singletest_shouldrun($testnum);
|
|
if($why || $listonly) {
|
|
# Display test name now--test will be completely skipped later
|
|
my $error = singletest_count($testnum, $why);
|
|
next;
|
|
}
|
|
$ignoretestcodes{$testnum} = $errorreturncode;
|
|
push(@runtests, $testnum);
|
|
}
|
|
my $totaltests = scalar(@runtests);
|
|
|
|
if($listonly) {
|
|
exit(0);
|
|
}
|
|
|
|
#######################################################################
|
|
# Setup CI Test Run
|
|
citest_starttestrun();
|
|
|
|
#######################################################################
|
|
# Start test runners
|
|
#
|
|
my $numrunners = $jobs < scalar(@runtests) ? $jobs : scalar(@runtests);
|
|
createrunners($numrunners);
|
|
|
|
#######################################################################
|
|
# The main test-loop
|
|
#
|
|
# Every iteration through the loop consists of these steps:
|
|
# - if the global abort flag is set, exit the loop; we are done
|
|
# - if a runner is idle, start a new test on it
|
|
# - if all runners are idle, exit the loop; we are done
|
|
# - if a runner has a response for us, process the response
|
|
|
|
# run through each candidate test and execute it
|
|
while () {
|
|
# check the abort flag
|
|
if($globalabort) {
|
|
logmsg singletest_dumplogs();
|
|
logmsg "Aborting tests\n";
|
|
logmsg "Waiting for " . scalar((keys %runnersrunning)) . " outstanding test(s) to finish...\n";
|
|
# Wait for the last requests to complete and throw them away so
|
|
# that IPC calls & responses stay in sync
|
|
# TODO: send a signal to the runners to interrupt a long test
|
|
foreach my $rid (keys %runnersrunning) {
|
|
runnerar($rid);
|
|
delete $runnersrunning{$rid};
|
|
logmsg ".";
|
|
$| = 1;
|
|
}
|
|
logmsg "\n";
|
|
last;
|
|
}
|
|
|
|
# Start a new test if possible
|
|
if(scalar(@runnersidle) && scalar(@runtests)) {
|
|
# A runner is ready to run a test, and tests are still available to run
|
|
# so start a new test.
|
|
$count++;
|
|
my $testnum = shift(@runtests);
|
|
|
|
# pick a runner for this new test
|
|
my $runnerid = pickrunner($testnum);
|
|
$countforrunner{$runnerid} = $count;
|
|
|
|
# Start the test
|
|
my ($error, $again) = singletest($runnerid, $testnum, $countforrunner{$runnerid}, $totaltests);
|
|
if($again) {
|
|
# this runner is busy running a test
|
|
$runnersrunning{$runnerid} = $testnum;
|
|
} else {
|
|
runnerready($runnerid);
|
|
if($error >= 0) {
|
|
# We make this simplifying assumption to avoid having to handle
|
|
# $error properly here, but we must handle the case of runner
|
|
# death without abending here.
|
|
die "Internal error: test must not complete on first call";
|
|
}
|
|
}
|
|
}
|
|
|
|
# See if we've completed all the tests
|
|
if(!scalar(%runnersrunning)) {
|
|
# No runners are running; we must be done
|
|
scalar(@runtests) && die 'Internal error: still have tests to run';
|
|
last;
|
|
}
|
|
|
|
# See if a test runner needs attention
|
|
# If we could be running more tests, don't wait so we can schedule a new
|
|
# one immediately. If all runners are busy, wait a fraction of a second
|
|
# for one to finish so we can still loop around to check the abort flag.
|
|
my $runnerwait = scalar(@runnersidle) && scalar(@runtests) ? 0 : 0.5;
|
|
my ($ridready, $riderror) = runnerar_ready($runnerwait);
|
|
if($ridready && ! defined $runnersrunning{$ridready}) {
|
|
# On Linux, a closed pipe still shows up as ready instead of error.
|
|
# Detect this here by seeing if we are expecting it to be ready and
|
|
# treat it as an error if not.
|
|
logmsg "ERROR: Runner $ridready is unexpectedly ready; is probably actually dead\n";
|
|
$riderror = $ridready;
|
|
undef $ridready;
|
|
}
|
|
if($ridready) {
|
|
# This runner is ready to be serviced
|
|
my $testnum = $runnersrunning{$ridready};
|
|
defined $testnum || die "Internal error: test for runner $ridready unknown";
|
|
delete $runnersrunning{$ridready};
|
|
my ($error, $again) = singletest($ridready, $testnum, $countforrunner{$ridready}, $totaltests);
|
|
if($again) {
|
|
# this runner is busy running a test
|
|
$runnersrunning{$ridready} = $testnum;
|
|
} else {
|
|
# Test is complete
|
|
runnerready($ridready);
|
|
|
|
if($error < 0) {
|
|
# not a test we can run
|
|
next;
|
|
}
|
|
|
|
$total++; # number of tests we've run
|
|
|
|
if($error>0) {
|
|
if($error==2) {
|
|
# ignored test failures
|
|
$failedign .= "$testnum ";
|
|
}
|
|
else {
|
|
$failed.= "$testnum ";
|
|
}
|
|
if($postmortem) {
|
|
# display all files in $LOGDIR/ in a nice way
|
|
displaylogs($ridready, $testnum);
|
|
}
|
|
if($error==2) {
|
|
$ign++; # ignored test result counter
|
|
}
|
|
elsif(!$anyway) {
|
|
# a test failed, abort
|
|
logmsg "\n - abort tests\n";
|
|
undef @runtests; # empty out the remaining tests
|
|
}
|
|
}
|
|
elsif(!$error) {
|
|
$ok++; # successful test counter
|
|
}
|
|
}
|
|
}
|
|
if($riderror) {
|
|
logmsg "ERROR: runner $riderror is dead! aborting test run\n";
|
|
delete $runnersrunning{$riderror} if(defined $runnersrunning{$riderror});
|
|
$globalabort = 1;
|
|
}
|
|
if(!scalar(@runtests) && ++$endwaitcnt == (240 + $jobs)) {
|
|
# Once all tests have been scheduled on a runner at the end of a test
|
|
# run, we just wait for their results to come in. If we're still
|
|
# waiting after a couple of minutes ($endwaitcnt multiplied by
|
|
# $runnerwait, plus $jobs because that number won't time out), display
|
|
# the same test runner status as we give with a SIGUSR1. This will
|
|
# likely point to a single test that has hung.
|
|
logmsg "Hmmm, the tests are taking a while to finish. Here is the status:\n";
|
|
catch_usr1();
|
|
}
|
|
}
|
|
|
|
my $sofar = time() - $start;
|
|
|
|
#######################################################################
|
|
# Finish CI Test Run
|
|
citest_finishtestrun();
|
|
|
|
# Tests done, stop the servers
|
|
foreach my $runnerid (values %runnerids) {
|
|
runnerac_stopservers($runnerid);
|
|
}
|
|
|
|
# Wait for servers to stop
|
|
my $unexpected;
|
|
foreach my $runnerid (values %runnerids) {
|
|
my ($rid, $unexpect, $logs) = runnerar($runnerid);
|
|
$unexpected ||= $unexpect;
|
|
logmsg $logs;
|
|
}
|
|
|
|
# Kill the runners
|
|
# There is a race condition here since we don't know exactly when the runners
|
|
# have each finished shutting themselves down, but we're about to exit so it
|
|
# doesn't make much difference.
|
|
foreach my $runnerid (values %runnerids) {
|
|
runnerac_shutdown($runnerid);
|
|
sleep 0; # give runner a context switch so it can shut itself down
|
|
}
|
|
|
|
my $numskipped = %skipped ? sum values %skipped : 0;
|
|
my $all = $total + $numskipped;
|
|
|
|
runtimestats($lasttest);
|
|
|
|
if($all) {
|
|
logmsg "TESTDONE: $all tests were considered during ".
|
|
sprintf("%.0f", $sofar) ." seconds.\n";
|
|
}
|
|
|
|
if(%skipped && !$short) {
|
|
my $s=0;
|
|
# Temporary hash to print the restraints sorted by the number
|
|
# of their occurrences
|
|
my %restraints;
|
|
logmsg "TESTINFO: $numskipped tests were skipped due to these restraints:\n";
|
|
|
|
for(keys %skipped) {
|
|
my $r = $_;
|
|
my $skip_count = $skipped{$r};
|
|
my $log_line = sprintf("TESTINFO: \"%s\" %d time%s (", $r, $skip_count,
|
|
($skip_count == 1) ? "" : "s");
|
|
|
|
# now gather all test case numbers that had this reason for being
|
|
# skipped
|
|
my $c=0;
|
|
my $max = 9;
|
|
for(0 .. scalar @teststat) {
|
|
my $t = $_;
|
|
if($teststat[$t] && ($teststat[$t] eq $r)) {
|
|
if($c < $max) {
|
|
$log_line .= ", " if($c);
|
|
$log_line .= $t;
|
|
}
|
|
$c++;
|
|
}
|
|
}
|
|
if($c > $max) {
|
|
$log_line .= " and ".($c-$max)." more";
|
|
}
|
|
$log_line .= ")\n";
|
|
$restraints{$log_line} = $skip_count;
|
|
}
|
|
foreach my $log_line (sort {$restraints{$b} <=> $restraints{$a}} keys %restraints) {
|
|
logmsg $log_line;
|
|
}
|
|
}
|
|
|
|
if($total) {
|
|
if($failedign) {
|
|
logmsg "IGNORED: failed tests: $failedign\n";
|
|
}
|
|
logmsg sprintf("TESTDONE: $ok tests out of $total reported OK: %d%%\n",
|
|
$ok/$total*100);
|
|
|
|
if($failed && ($ok != $total)) {
|
|
logmsg "\nTESTFAIL: These test cases failed: $failed\n\n";
|
|
}
|
|
}
|
|
else {
|
|
logmsg "\nTESTFAIL: No tests were performed\n\n";
|
|
if(scalar(keys %enabled_keywords)) {
|
|
logmsg "TESTFAIL: Nothing matched these keywords: ";
|
|
for(keys %enabled_keywords) {
|
|
logmsg "$_ ";
|
|
}
|
|
logmsg "\n";
|
|
}
|
|
}
|
|
|
|
if(($total && (($ok+$ign) != $total)) || !$total || $unexpected) {
|
|
exit 1;
|
|
}
|