3041 lines
99 KiB
Perl
3041 lines
99 KiB
Perl
|
#!/usr/bin/env perl
|
||
|
|
#***************************************************************************
|
||
|
|
# _ _ ____ _
|
||
|
|
# Project ___| | | | _ \| |
|
||
|
|
# / __| | | | |_) | |
|
||
|
|
# | (__| |_| | _ <| |___
|
||
|
|
# \___|\___/|_| \_\_____|
|
||
|
|
#
|
||
|
|
# Copyright (C) Daniel Stenberg, <daniel@haxx.se>, et al.
|
||
|
|
#
|
||
|
|
# This software is licensed as described in the file COPYING, which
|
||
|
|
# you should have received as part of this distribution. The terms
|
||
|
|
# are also available at https://curl.se/docs/copyright.html.
|
||
|
|
#
|
||
|
|
# You may opt to use, copy, modify, merge, publish, distribute and/or sell
|
||
|
|
# copies of the Software, and permit persons to whom the Software is
|
||
|
|
# furnished to do so, under the terms of the COPYING file.
|
||
|
|
#
|
||
|
|
# This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
|
||
|
|
# KIND, either express or implied.
|
||
|
|
#
|
||
|
|
# SPDX-License-Identifier: curl
|
||
|
|
#
|
||
|
|
###########################################################################
|
||
|
|
|
||
|
|
# For documentation, run `man ./runtests.1` and see README.md.
|
||
|
|
|
||
|
|
# Experimental hooks are available to run tests remotely on machines that
|
||
|
|
# are able to run curl but are unable to run the test harness.
|
||
|
|
# The following sections need to be modified:
|
||
|
|
#
|
||
|
|
# $HOSTIP, $HOST6IP - Set to the address of the host running the test suite
|
||
|
|
# $CLIENTIP, $CLIENT6IP - Set to the address of the host running curl
|
||
|
|
# runclient, runclientoutput - Modify to copy all the files in the log/
|
||
|
|
# directory to the system running curl, run the given command remotely
|
||
|
|
# and save the return code or returned stdout (respectively), then
|
||
|
|
# copy all the files from the remote system's log/ directory back to
|
||
|
|
# the host running the test suite. This can be done a few ways, such
|
||
|
|
# as using scp & ssh, rsync & telnet, or using a NFS shared directory
|
||
|
|
# and ssh.
|
||
|
|
#
|
||
|
|
# 'make && make test' needs to be done on both machines before making the
|
||
|
|
# above changes and running runtests.pl manually. In the shared NFS case,
|
||
|
|
# the contents of the tests/server/ directory must be from the host
|
||
|
|
# running the test suite, while the rest must be from the host running curl.
|
||
|
|
#
|
||
|
|
# Note that even with these changes a number of tests 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 .= "-"; # proxy not checked
|
||
|
|
}
|
||
|
|
|
||
|
|
my $outputok;
|
||
|
|
for my $partsuffix (('', '1', '2', '3', '4')) {
|
||
|
|
my @outfile=getpart("verify", "file".$partsuffix);
|
||
|
|
if(@outfile || partexists("verify", "file".$partsuffix) ) {
|
||
|
|
# we'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;
|
||
|
|
}
|