Newer
Older
Daniel Stenberg
committed
return "no server for $what";
return 0;
}
##############################################################################
# This function makes sure the right set of server is running for the
# specified test case. This is a useful design when we run single tests as not
# all servers need to run then!
#
Daniel Stenberg
committed
# Returns: a string, blank if everything is fine or a reason why it failed
#
sub serverfortest {
my ($testnum)=@_;
# load the test case file definition
if(loadtest("${TESTDIR}/test${testnum}")) {
if($verbose) {
# this is not a test
logmsg "$testnum doesn't look like a test case!\n";
}
Daniel Stenberg
committed
return "no test";
}
my @what = getpart("client", "server");
if(!$what[0]) {
warn "Test case $testnum has no server(s) specified!";
Daniel Stenberg
committed
return "no server specified";
}
return &startservers(@what);
#######################################################################
# Check options to this test program
#
my $number=0;
my $fromnum=-1;
my @testthis;
do {
if ($ARGV[0] eq "-v") {
# verbose output
$verbose=1;
}
elsif ($ARGV[0] eq "-c") {
# use this path to curl instead of default
shift @ARGV;
}
elsif ($ARGV[0] eq "-d") {
# have the servers display protocol output
$debugprotocol=1;
}
Daniel Stenberg
committed
elsif ($ARGV[0] eq "-f") {
# run fork-servers, which makes the server fork for all new
# connections This is NOT what you wanna do without knowing exactly
# why and for what
$forkserver=1;
}
elsif ($ARGV[0] eq "-g") {
# run this test with gdb
$gdbthis=1;
}
elsif($ARGV[0] eq "-s") {
# short output
$short=1;
}
elsif($ARGV[0] eq "-n") {
# no valgrind
undef $valgrind;
}
elsif($ARGV[0] =~ /^-t(.*)/) {
# torture
$torture=1;
my $xtra = $1;
if($xtra =~ s/(\d+)$//) {
$tortalloc = $1;
}
Daniel Stenberg
committed
# we undef valgrind to make this fly in comparison
undef $valgrind;
}
elsif($ARGV[0] eq "-a") {
# continue anyway, even if a test fail
$anyway=1;
}
Daniel Stenberg
committed
elsif($ARGV[0] eq "-p") {
$postmortem=1;
}
elsif($ARGV[0] eq "-l") {
# lists the test case names only
$listonly=1;
}
elsif($ARGV[0] eq "-k") {
# keep stdout and stderr files after tests
$keepoutfiles=1;
}
elsif($ARGV[0] eq "-h") {
# show help text
print <<EOHELP
-d display server debug info
-g run the test case with gdb
-k keep stdout and stderr files present after tests
Daniel Stenberg
committed
-p Print log file contents when a test fails
-t torture
[num] like "5 6 9" or " 5 to 22 " to run those tests only
elsif($ARGV[0] =~ /^(\d+)/) {
$number = $1;
if($fromnum >= 0) {
for($fromnum .. $number) {
push @testthis, $_;
}
$fromnum = -1;
}
else {
push @testthis, $1;
}
}
elsif($ARGV[0] =~ /^to$/i) {
}
} while(shift @ARGV);
if($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 = system("valgrind >/dev/null 2>&1");
if(($code>>8) != 1) {
#logmsg "Valgrind failure, disable it\n";
# open the executable curl and read the first 4 bytes of it
open(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";
}
Daniel Stenberg
committed
$HTTPPORT = $base + 0; # HTTP server port
$HTTPSPORT = $base + 1; # HTTPS server port
$FTPPORT = $base + 2; # FTP server port
$FTPSPORT = $base + 3; # FTPS server port
$HTTP6PORT = $base + 4; # HTTP IPv6 server port (different IP protocol
# but we follow the same port scheme anyway)
Daniel Stenberg
committed
$FTP2PORT = $base + 5; # FTP server 2 port
Daniel Stenberg
committed
$FTP6PORT = $base + 6; # FTP IPv6 port
$TFTPPORT = $base + 7; # TFTP (UDP) port
$TFTP6PORT = $base + 8; # TFTP IPv6 (UDP) port
Daniel Stenberg
committed
#######################################################################
# clear and create logging directory:
#
cleardir($LOGDIR);
mkdir($LOGDIR, 0777);
#######################################################################
# Output curl version and host info being tested
#
checksystem();
#######################################################################
# 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;
Daniel Stenberg
committed
my %dis;
open(D, "$TESTDIR/DISABLED");
while(<D>) {
if(/^ *\#/) {
# allow comments
next;
}
if($_ =~ /(\d+)/) {
$dis{$1}=$1; # disable this test number
}
}
$TESTCASES=""; # start with no test cases
# cut off everything but the digits
for(@cmds) {
$_ =~ s/[a-z\/\.]*//g;
}
# the the numbers from low to high
foreach my $n (sort { $a <=> $b } @cmds) {
if($dis{$n}) {
Daniel Stenberg
committed
# skip disabled test cases
my $why = "mentioned in DISABLED";
$skipped++;
$skipped{$why}++;
$teststat[$n]=$why; # store reason for this test case
Daniel Stenberg
committed
next;
}
}
#######################################################################
# Start the command line log
#
open(CMDLOG, ">$CURLLOG") ||
logmsg "can't log command lines to $CURLLOG\n";
#######################################################################
Daniel Stenberg
committed
sub displaylogcontent {
my ($file)=@_;
open(SINGLE, "<$file");
while(<SINGLE>) {
Daniel Stenberg
committed
}
close(SINGLE);
}
sub displaylogs {
my ($testnum)=@_;
Daniel Stenberg
committed
opendir(DIR, "$LOGDIR") ||
die "can't open dir: $!";
my @logs = readdir(DIR);
closedir DIR;
my $log;
logmsg "== Contents of files in the log/ dir after test $testnum\n";
Daniel Stenberg
committed
foreach $log (sort @logs) {
# the log file is not "." or ".." and contains more than zero bytes
if(($log !~ /\.(\.|)$/) &&
($log ne "memdump") && # and not "memdump"
-s "$LOGDIR/$log") {
if($log =~ /^\.nfs/) {
next;
}
logmsg "== Start of file $log\n";
displaylogcontent("$LOGDIR/$log");
logmsg "== End of file $log\n";
Daniel Stenberg
committed
}
}
}
#######################################################################
# The main test-loop
#
my $ok=0;
my $total=0;
my $lasttest;
my @at = split(" ", $TESTCASES);
$start = time();
foreach $testnum (@at) {
$lasttest = $testnum if($testnum > $lasttest);
$count++;
my $error = singletest($testnum, $count, scalar(@at));
if($error < 0) {
# not a test we can run
$total++; # number of tests we've run
if($error>0) {
Daniel Stenberg
committed
if($postmortem) {
# display all files in log/ in a nice way
displaylogs($testnum);
Daniel Stenberg
committed
}
if(!$anyway) {
# a test failed, abort
logmsg "\n - abort tests\n";
elsif(!$error) {
$ok++; # successful test counter
#######################################################################
# Close command log
#
close(CMDLOG);
# Tests done, stop the servers
stopalltestservers();
Daniel Stenberg
committed
my $all = $total + $skipped;
if($total) {
logmsg sprintf("TESTDONE: $ok tests out of $total reported OK: %d%%\n",
$ok/$total*100);
if($ok != $total) {
logmsg "TESTFAIL: These test cases failed: $failed\n";
}
else {
logmsg "TESTFAIL: No tests were performed!\n";
Daniel Stenberg
committed
if($all) {
my $sofar = time()-$start;
logmsg "TESTDONE: $all tests were considered during $sofar seconds.\n";
Daniel Stenberg
committed
}
my $s=0;
logmsg "TESTINFO: $skipped tests were skipped due to these restraints:\n";
for(keys %skipped) {
my $r = $_;
Daniel Stenberg
committed
printf "TESTINFO: \"%s\" %d times (", $r, $skipped{$_};
# now show all test case numbers that had this reason for being
# skipped
my $c=0;
for(0 .. $lasttest) {
my $t = $_;
if($teststat[$_] eq $r) {
logmsg ", " if($c);
logmsg $_;
$c++;
}
}
}
Daniel Stenberg
committed
}
if($total && ($ok != $total)) {
exit 1;
}