diff options
author | Daniel Stenberg <daniel@haxx.se> | 2002-05-21 22:20:52 +0000 |
---|---|---|
committer | Daniel Stenberg <daniel@haxx.se> | 2002-05-21 22:20:52 +0000 |
commit | a928f2c4aab41db8f6fdf4ba412e6c455e4ccf96 (patch) | |
tree | e52594d65b1f0c0f27af1d2a3176a778beeaa7a2 | |
parent | 51fcee6f811c46c55cefebb726e6c4dee7dedd13 (diff) |
test suite mods for the netrc testing stuff
-rw-r--r-- | tests/getpart.pm | 7 | ||||
-rwxr-xr-x | tests/memanalyze.pl | 2 | ||||
-rwxr-xr-x | tests/runtests.pl | 80 |
3 files changed, 76 insertions, 13 deletions
diff --git a/tests/getpart.pm b/tests/getpart.pm index d28800088..7449be983 100644 --- a/tests/getpart.pm +++ b/tests/getpart.pm @@ -7,6 +7,9 @@ my $warning=0; my $trace=0; sub getpartattr { + # if $part is undefined (ie only one argument) then + # return the attributes of the section + my ($section, $part)=@_; my %hash; @@ -19,7 +22,9 @@ sub getpartattr { if(!$inside && ($_ =~ /^ *\<$section/)) { $inside++; } - elsif((1 ==$inside) && ($_ =~ /^ *\<$part([^>]*)/)) { + if((1 ==$inside) && ( ($_ =~ /^ *\<$part([^>]*)/) || + !(defined($part)) ) + ) { $inside++; my $attr=$1; my @p=split("[ \t]", $attr); diff --git a/tests/memanalyze.pl b/tests/memanalyze.pl index f16f2d8a9..73d1aa603 100755 --- a/tests/memanalyze.pl +++ b/tests/memanalyze.pl @@ -1,4 +1,4 @@ -#!/usr/bin/perl +#!/usr/bin/env perl # # Example input: # diff --git a/tests/runtests.pl b/tests/runtests.pl index 988646d4a..447d14500 100755 --- a/tests/runtests.pl +++ b/tests/runtests.pl @@ -6,7 +6,8 @@ ####################################################################### # These should be the only variables that might be needed to get edited: -use strict; +#use strict; +#use warnings; @INC=(@INC, $ENV{'srcdir'}, "."); @@ -20,6 +21,7 @@ my $HTTPSPORT=8433; # this is the HTTPS server port my $FTPPORT=8921; # this is the FTP server port my $FTPSPORT=8821; # this is the FTPS server port my $CURL="../src/curl"; # what curl executable to run on the tests +my $DBGCURL=$CURL; #"../src/.libs/curl"; # alternative for debugging my $LOGDIR="log"; my $TESTDIR="data"; my $SERVERIN="$LOGDIR/server.input"; # what curl sent the server @@ -48,6 +50,11 @@ my $perl="perl -I$srcdir"; # this gets set if curl is compiled with memory debugging: my $memory_debug=0; +# this gets set if curl is compiled with netrc debugging: +# It has to be in the global symbol table because of the way 'requires' works +$main::netrc_debug=0; +my $netrc_debug = \$main::netrc_debug; + # name of the file that the memory debugging creates: my $memdump="memdump"; @@ -58,6 +65,8 @@ my $checkstunnel = &checkstunnel; my $ssl_version; # set if libcurl is built with SSL support +my $skipped=0; # number of tests skipped; reported in main loop + ####################################################################### # variables the command line options may set # @@ -390,8 +399,14 @@ sub displaydata { # enabled and we shall verify that no memory leaks exist # after each and every test! $memory_debug=1; + + # there's only one debug control in the configure script + # so hope netrc debugging is enabled and set it up + $$netrc_debug = 1; + $ENV{'CURL_DEBUG_NETRC'} = 'log/netrc'; } printf("* Memory debugging: %s\n", $memory_debug?"ON":"OFF"); + printf("* Netrc debugging: %s\n", $$netrc_debug?"ON":"OFF"); printf("* HTTPS server: %s\n", $checkstunnel?"ON":"OFF"); printf("* FTPS server: %s\n", $checkstunnel?"ON":"OFF"); printf("* libcurl SSL: %s\n", $ssl_version?"ON":"OFF"); @@ -399,6 +414,21 @@ sub displaydata { } ####################################################################### +# substitute the variable stuff into either a joined up file or +# a command, in either case passed by reference +# +sub subVariables { + my ($thing) = @_; + $$thing =~ s/%HOSTIP/$HOSTIP/g; + $$thing =~ s/%HOSTPORT/$HOSTPORT/g; + $$thing =~ s/%HTTPSPORT/$HTTPSPORT/g; + $$thing =~ s/%FTPPORT/$FTPPORT/g; + $$thing =~ s/%FTPSPORT/$FTPSPORT/g; + $$thing =~ s/%SRCDIR/$srcdir/g; + $$thing =~ s/%PWD/$pwd/g; +} + +####################################################################### # Run a single specified test case # @@ -414,6 +444,26 @@ sub singletest { return -1; } + { + my %hash = getpartattr("client"); + my $requires = $hash{'requires'}; + + if (defined($requires)) { + my $value=${$requires}; +# print "This test requires '$requires' with value '$value' \n"; + + if (${$requires}) { + # this test is OK + ; + }else { + print "$testnum requires $requires, which is not set; skipping\n"; + $skipped++; + return 0; # look successful + } + } + } + + # extract the reply data my @reply = getpart("reply", "data"); my @replycheck = getpart("reply", "datacheck"); @@ -471,13 +521,16 @@ sub singletest { # make some nice replace operations $cmd =~ s/\n//g; # no newlines please - $cmd =~ s/%HOSTIP/$HOSTIP/g; - $cmd =~ s/%HOSTPORT/$HOSTPORT/g; - $cmd =~ s/%HTTPSPORT/$HTTPSPORT/g; - $cmd =~ s/%FTPPORT/$FTPPORT/g; - $cmd =~ s/%FTPSPORT/$FTPSPORT/g; - $cmd =~ s/%SRCDIR/$srcdir/g; - $cmd =~ s/%PWD/$pwd/g; + + subVariables \$cmd; + +# $cmd =~ s/%HOSTIP/$HOSTIP/g; +# $cmd =~ s/%HOSTPORT/$HOSTPORT/g; +# $cmd =~ s/%HTTPSPORT/$HTTPSPORT/g; +# $cmd =~ s/%FTPPORT/$FTPPORT/g; +# $cmd =~ s/%FTPSPORT/$FTPSPORT/g; +# $cmd =~ s/%SRCDIR/$srcdir/g; +# $cmd =~ s/%PWD/$pwd/g; #$cmd =~ s/%HOSTNAME/$HOSTNAME/g; @@ -491,11 +544,17 @@ sub singletest { my %hash = getpartattr("client", "file"); my $filename=$hash{'name'}; + if(!$filename) { print "ERROR: section client=>file has no name attribute!\n"; exit; } - writearray($filename, \@inputfile); + my $fileContent = join('', @inputfile); + subVariables \$fileContent; +# print "DEBUG: writing file " . $filename . "\n"; + open OUTFILE, ">$filename"; + print OUTFILE $fileContent; + close OUTFILE; } my %cmdhash = getpartattr("client", "command"); @@ -537,7 +596,7 @@ sub singletest { print GDBCMD "set args $cmdargs\n"; print GDBCMD "show args\n"; close(GDBCMD); - system("gdb $CURL -x log/gdbcmd"); + system("gdb $DBGCURL -x log/gdbcmd"); $res =0; # makes it always continue after a debugged run } else { @@ -909,7 +968,6 @@ my $failed; my $testnum; my $ok=0; my $total=0; -my $skipped=0; foreach $testnum (split(" ", $TESTCASES)) { |