runtests: allow tests written as perl scripts

If a command is set type="perl", it can now specify a perl program that will
be run instead of an ordinary curl or built tool.

A perl test automatically disables memory and valgrind debugging.

diff --git a/tests/FILEFORMAT b/tests/FILEFORMAT
index fb162a358138c97735cd26165d67d1fdc43e0858..6a61dd0001ebc6cdc39c52fd1b0c8e42a9213421 100644 (file)
--- a/tests/FILEFORMAT
+++ b/tests/FILEFORMAT
@@ -224,7 +224,7 @@ command is run. They are cleared again after the command has been run.
 Variables are first substituted as in the <command> section.
 </setenv>
 
-<command [option="no-output"] [timeout="secs"] [delay="secs"]>
+<command [option="no-output"] [timeout="secs"] [delay="secs"] [type="perl"]>
 command line to run, there's a bunch of %variables that get replaced
 accordingly.
 
@@ -237,6 +237,9 @@ If a CONNECT is used to the server (to emulate HTTPS etc over proxy), the port
 number given in the CONNECT request will be used to identify which test that
 is being run, if the proxy host name is said to start with 'test'.
 
+Set type="perl" to write the test case as a perl script. It implies that
+there's no memory debugging and valgrind gets shut off for this test.
+
 Set option="no-output" to prevent the test script to slap on the --output
 argument that directs the output to a file. The --output is also not added if
 the verify/stdout section is used.

diff --git a/tests/runtests.pl b/tests/runtests.pl
index 347adf7ef7aae488d39cc54d3fe57e7f736a277e..2eb65fd9ec0533406d5b61ebe9194321b70ce610 100755 (executable)
--- a/tests/runtests.pl
+++ b/tests/runtests.pl
@@ -2246,6 +2246,7 @@ sub singletest {
     my $why;
     my %feature;
     my $cmd;
+    my $disablevalgrind;
 
     # copy test number to a global scope var, this allows
     # testnum checking when starting test harness servers.
@@ -2485,9 +2486,6 @@ sub singletest {
         @reply=@replycheck;
     }
 
-    # curl command to run
-    my @curlcmd= fixarray ( getpart("client", "command") );
-
     # this is the valid protocol blurb curl should generate
     my @protocol= fixarray ( getpart("verify", "protocol") );
 
@@ -2541,12 +2539,12 @@ sub singletest {
     my @blaha;
     ($cmd, @blaha)= getpart("client", "command");
 
-    # make some nice replace operations
-    $cmd =~ s/\n//g; # no newlines please
-
-    # substitute variables in the command line
-    subVariables \$cmd;
-
+    if($cmd) {
+        # make some nice replace operations
+        $cmd =~ s/\n//g; # no newlines please
+        # substitute variables in the command line
+        subVariables \$cmd;
+    }
     if($curl_debug) {
         unlink($memdump);
     }
@@ -2597,14 +2595,31 @@ sub singletest {
         }
     }
 
+    my $CMDLINE;
     my $cmdargs;
-    if(!$tool) {
+    my $cmdtype = $cmdhash{'type'} || "default";
+    if($cmdtype eq "perl") {
+        # run the command line prepended with "perl"
+        $cmdargs ="$cmd";
+        $CMDLINE = "perl ";
+        $tool=$CMDLINE;
+        $disablevalgrind=1;
+    }
+    elsif(!$tool) {
         # run curl, add --verbose for debug information output
         $cmdargs ="$out --include --verbose --trace-time $cmd";
     }
     else {
         $cmdargs = " $cmd"; # $cmd is the command line for the test file
         $CURLOUT = $STDOUT; # sends received data to stdout
+
+        $CMDLINE="$LIBDIR/$tool";
+        if(! -f $CMDLINE) {
+            print "The tool set in the test case for this: '$tool' does not exist\n";
+            timestampskippedevents($testnum);
+            return -1;
+        }
+        $DBGCURL=$CMDLINE;
     }
 
     my @stdintest = getpart("client", "stdin");
@@ -2615,23 +2630,13 @@ sub singletest {
 
         $cmdargs .= " <$stdinfile";
     }
-    my $CMDLINE;
 
     if(!$tool) {
         $CMDLINE="$CURL";
     }
-    else {
-        $CMDLINE="$LIBDIR/$tool";
-        if(! -f $CMDLINE) {
-            print "The tool set in the test case for this: '$tool' does not exist\n";
-            timestampskippedevents($testnum);
-            return -1;
-        }
-        $DBGCURL=$CMDLINE;
-    }
 
     my $usevalgrind;
-    if($valgrind) {
+    if($valgrind && !$disablevalgrind) {
         my @valgrindoption = getpart("verify", "valgrind");
         if((!@valgrindoption) || ($valgrindoption[0] !~ /disable/)) {
             $usevalgrind = 1;
@@ -3069,7 +3074,8 @@ sub singletest {
 
     if($curl_debug) {
         if(! -f $memdump) {
-            logmsg "\n** ALERT! memory debugging with no output file?\n";
+            logmsg "\n** ALERT! memory debugging with no output file?\n"
+                if(!$cmdtype eq "perl");
         }
         else {
             my @memdata=`$memanalyze $memdump`;
@@ -3131,7 +3137,7 @@ sub singletest {
             $ok .= "v";
         }
         else {
-            if(!$short) {
+            if(!$short && !$disablevalgrind) {
                 logmsg " valgrind SKIPPED\n";
             }
             $ok .= "-"; # skipped