Newer
Older
}
if(!$short) {
print " upload OK";
if(@protocol) {
# verify the sent request
my @out = loadarray($SERVERIN);
# what to cut off from the live protocol sent by curl
my @strip = getpart("verify", "strip");
# 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($protstrip[$#protstrip]);
}
for(@strip) {
# strip all patterns from both arrays
@out = striparray( $_, \@out);
@protstrip= striparray( $_, \@protstrip);
}
$res = compare("protocol", \@out, \@protstrip);
if($res) {
return 1;
}
if(!$short) {
print " protocol OK";
}
my @outfile=getpart("verify", "file");
if(@outfile) {
# we're supposed to verify a dynamicly generated file!
my %hash = getpartattr("verify", "file");
my $filename=$hash{'name'};
if(!$filename) {
print "ERROR: section verify=>file has no name attribute!\n";
exit;
}
my @generated=loadarray($filename);
$res = compare("output", \@generated, \@outfile);
if($res) {
return 1;
}
if(!$short) {
print " output OK";
}
}
if(!$keepoutfiles) {
# remove the stdout and stderr files
unlink($STDOUT);
unlink($STDERR);
unlink($CURLOUT); # remove the downloaded results
unlink("$LOGDIR/upload.$testnum"); # remove upload leftovers
unlink($FTPDCMD); # remove the instructions for this test
@what = getpart("client", "killserver");
for(@what) {
my $serv = $_;
chomp $serv;
if($run{$serv}) {
stopserver($run{$serv}); # the pid file is in the hash table
$run{$serv}=0; # clear pid
}
else {
print STDERR "RUN: The $serv server is not running\n";
}
}
if($curl_debug) {
if(! -f $memdump) {
print "\n** ALERT! memory debuggin without any output file?\n";
}
else {
my @memdata=`$memanalyze $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) {
print "\n** MEMORY FAILURE\n";
print @memdata;
return 1;
}
else {
if(!$short) {
print " memory OK";
}
}
}
print "\n";
#######################################################################
# Stop all running test servers
sub stopservers {
print "Shutting down test suite servers:\n" if ($verbose);
for(keys %run) {
printf ("* kill pid for %-5s => %-5d\n", $_, $run{$_}) if($verbose);
stopserver($run{$_}); # the pid file is in the hash table
}
#######################################################################
# startservers() starts all the named servers
#
sub startservers {
my @what = @_;
my $pid;
for(@what) {
my $what = lc($_);
$what =~ s/[^a-z]//g;
if($what eq "ftp") {
if(!$run{'ftp'}) {
$pid = runftpserver($verbose);
if($pid <= 0) {
Daniel Stenberg
committed
return 2; # error starting it
}
printf ("* pid ftp => %-5d\n", $pid) if($verbose);
$run{'ftp'}=$pid;
}
}
elsif($what eq "http") {
if(!$run{'http'}) {
$pid = runhttpserver($verbose);
if($pid <= 0) {
Daniel Stenberg
committed
return 2; # error starting
}
printf ("* pid http => %-5d\n", $pid) if($verbose);
$run{'http'}=$pid;
}
}
elsif($what eq "ftps") {
if(!$checkstunnel || !$ssl_version) {
# we can't run https tests without stunnel
# or if libcurl is SSL-less
return 1;
}
$pid = runftpserver($verbose);
if($pid <= 0) {
Daniel Stenberg
committed
return 2; # error starting it
}
$run{'ftp'}=$pid;
$pid = runftpsserver($verbose);
if($pid <= 0) {
return 2;
}
printf ("* pid ftps => %-5d\n", $pid) if($verbose);
$run{'ftps'}=$pid;
elsif($what eq "file") {
# we support it but have no server!
}
elsif($what eq "https") {
if(!$checkstunnel || !$ssl_version) {
# we can't run https tests without stunnel
# or if libcurl is SSL-less
return 1;
}
if(!$run{'http'}) {
$pid = runhttpserver($verbose);
if($pid <= 0) {
Daniel Stenberg
committed
return 2; # problems starting server
}
$run{'http'}=$pid;
$pid = runhttpsserver($verbose);
if($pid <= 0) {
return 2;
}
printf ("* pid https => %-5d\n", $pid) if($verbose);
$run{'https'}=$pid;
else {
warn "we don't support a server for $what";
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
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!
#
# Returns:
# 100 if this is not a test case
# 99 if this test case has no servers specified
# 2 if one of the required servers couldn't be started
# 1 if this test is skipped due to unfulfilled SSL/stunnel-requirements
sub serverfortest {
my ($testnum)=@_;
# load the test case file definition
if(loadtest("${TESTDIR}/test${testnum}")) {
if($verbose) {
# this is not a test
print "$testnum doesn't look like a test case!\n";
}
return 100;
}
my @what = getpart("client", "server");
if(!$what[0]) {
warn "Test case $testnum has no server(s) specified!";
return 99;
}
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
$CURL=$ARGV[1];
shift @ARGV;
}
elsif ($ARGV[0] eq "-d") {
# have the servers display protocol output
$debugprotocol=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] =~ /^-t(.*)/) {
# torture
$torture=1;
my $xtra = $1;
if($xtra =~ s/^(\d+)//) {
$tortnum = $1;
}
if($xtra =~ s/(\d+)$//) {
$tortalloc = $1;
}
}
elsif($ARGV[0] eq "-a") {
# continue anyway, even if a test fail
$anyway=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
-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);
}
#######################################################################
# Output curl version and host info being tested
#
checkcurl();
#######################################################################
# clear and create logging directory:
cleardir($LOGDIR);
mkdir($LOGDIR, 0777);
#######################################################################
# 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;
}
# the the numbers from low to high
for(sort { $a <=> $b } @cmds) {
$TESTCASES .= " $_";
}
#######################################################################
# Start the command line log
#
open(CMDLOG, ">$CURLLOG") ||
print "can't log command lines to $CURLLOG\n";
#######################################################################
# Torture the memory allocation system and checks
#
if($torture) {
&torture();
}
#######################################################################
# The main test-loop
#
my $ok=0;
my $total=0;
my $lasttest;
foreach $testnum (split(" ", $TESTCASES)) {
$lasttest = $testnum if($testnum > $lasttest);
my $error = singletest($testnum);
if($error < 0) {
# not a test we can run
$total++; # number of tests we've run
if($error>0) {
if(!$anyway) {
# a test failed, abort
print "\n - abort tests\n";
last;
}
elsif(!$error) {
$ok++; # successful test counter
#######################################################################
# Close command log
#
close(CMDLOG);
# Tests done, stop the servers
stopservers();
Daniel Stenberg
committed
my $all = $total + $skipped;
if($total) {
printf("TESTDONE: $ok tests out of $total reported OK: %d%%\n",
if($ok != $total) {
print "TESTFAIL: These test cases failed: $failed\n";
}
else {
print "TESTFAIL: No tests were performed!\n";
Daniel Stenberg
committed
if($all) {
print "TESTDONE: $all tests were considered.\n";
}
my $s=0;
print "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) {
print ", " if($c);
print $_;
$c++;
}
}
print ")\n";
}
Daniel Stenberg
committed
}
if($total && ($ok != $total)) {
exit 1;
}