mirror of
https://github.com/curl/curl.git
synced 2025-04-12 16:20:35 +08:00
devtest: add a new script for testing the test harness
This is currently useful for starting a test server on its own without an associated test, which can be used for interactive curl testing or for validating parts of the test harness itself. More commands can be added to perform additional functions in the future. Ref: #10818 Closes #11008
This commit is contained in:
parent
a549e046b1
commit
20fa5b74a5
@ -27,7 +27,7 @@ PDFPAGES = testcurl.pdf runtests.pdf
|
||||
MANDISTPAGES = runtests.1.dist testcurl.1.dist
|
||||
|
||||
EXTRA_DIST = appveyor.pm azure.pm badsymbols.pl check-deprecated.pl CMakeLists.txt \
|
||||
dictserver.py directories.pm disable-scan.pl error-codes.pl extern-scan.pl FILEFORMAT.md \
|
||||
devtest.pl dictserver.py directories.pm disable-scan.pl error-codes.pl extern-scan.pl FILEFORMAT.md \
|
||||
processhelp.pm ftpserver.pl getpart.pm globalconfig.pm http-server.pl http2-server.pl \
|
||||
http3-server.pl manpage-scan.pl manpage-syntax.pl markdown-uppercase.pl mem-include-scan.pl \
|
||||
memanalyze.pl negtelnetserver.py nroff-scan.pl option-check.pl options-scan.pl \
|
||||
|
193
tests/devtest.pl
Executable file
193
tests/devtest.pl
Executable file
@ -0,0 +1,193 @@
|
||||
#!/usr/bin/env perl
|
||||
#***************************************************************************
|
||||
# _ _ ____ _
|
||||
# Project ___| | | | _ \| |
|
||||
# / __| | | | |_) | |
|
||||
# | (__| |_| | _ <| |___
|
||||
# \___|\___/|_| \_\_____|
|
||||
#
|
||||
# Copyright (C) Daniel Fandrich, 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
|
||||
#
|
||||
###########################################################################
|
||||
|
||||
# This script is intended for developers to test some internals of the
|
||||
# runtests.pl harneess. Don't try to use this unless you know what you're
|
||||
# doing!
|
||||
|
||||
# An example command-line that starts a test http server for test 11 and waits
|
||||
# for the user before stopping it:
|
||||
# ./devtest.pl --verbose serverfortest https echo "Started https" protoport https preprocess 11 pause echo Stopping stopservers echo Done
|
||||
# curl can connect to the server while it's running like this:
|
||||
# curl -vkL https://localhost:<protoport>/11
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use 5.006;
|
||||
|
||||
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'});
|
||||
}
|
||||
|
||||
use globalconfig;
|
||||
use servers;
|
||||
use runner qw(
|
||||
readtestkeywords
|
||||
singletest_preprocess
|
||||
);
|
||||
use getpart;
|
||||
|
||||
|
||||
#######################################################################
|
||||
# logmsg is our general message logging subroutine.
|
||||
# This function is currently required to be here by servers.pm
|
||||
# This is copied from runtests.pl
|
||||
#
|
||||
my $uname_release = `uname -r`;
|
||||
my $is_wsl = $uname_release =~ /Microsoft$/;
|
||||
sub logmsg {
|
||||
for(@_) {
|
||||
my $line = $_;
|
||||
if ($is_wsl) {
|
||||
# use \r\n for WSL shell
|
||||
$line =~ s/\r?\n$/\r\n/g;
|
||||
}
|
||||
print "$line";
|
||||
}
|
||||
}
|
||||
|
||||
#######################################################################
|
||||
# Parse and store the protocols in curl's Protocols: line
|
||||
# This is copied from runtests.pl
|
||||
#
|
||||
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';
|
||||
}
|
||||
|
||||
|
||||
#######################################################################
|
||||
# Initialize @protocols from the curl binary under test
|
||||
#
|
||||
sub init_protocols {
|
||||
for (`$CURL -V 2>/dev/null`) {
|
||||
if(m/^Protocols: (.*)$/) {
|
||||
parseprotocols($1);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
#######################################################################
|
||||
# Initialize the test harness to run tests
|
||||
#
|
||||
sub init_tests {
|
||||
init_protocols();
|
||||
initserverconfig();
|
||||
}
|
||||
|
||||
#######################################################################
|
||||
# Main test loop
|
||||
|
||||
init_tests();
|
||||
|
||||
#***************************************************************************
|
||||
# Parse command-line options and commands
|
||||
#
|
||||
while(@ARGV) {
|
||||
if($ARGV[0] eq "-h") {
|
||||
print "Usage: devtest.pl [--verbose] [command [arg]...]\n";
|
||||
print "command is one of:\n";
|
||||
print " echo X\n";
|
||||
print " pause\n";
|
||||
print " preprocess\n";
|
||||
print " protocols *|X[,Y...]\n";
|
||||
print " protoport X\n";
|
||||
print " serverfortest X[,Y...]\n";
|
||||
print " stopservers\n";
|
||||
print " sleep N\n";
|
||||
exit 0;
|
||||
}
|
||||
elsif($ARGV[0] eq "--verbose") {
|
||||
$verbose = 1;
|
||||
}
|
||||
elsif($ARGV[0] eq "sleep") {
|
||||
shift @ARGV;
|
||||
sleep $ARGV[0];
|
||||
}
|
||||
elsif($ARGV[0] eq "echo") {
|
||||
shift @ARGV;
|
||||
print $ARGV[0] . "\n";
|
||||
}
|
||||
elsif($ARGV[0] eq "pause") {
|
||||
print "Press Enter to continue: ";
|
||||
readline STDIN;
|
||||
}
|
||||
elsif($ARGV[0] eq "protocols") {
|
||||
shift @ARGV;
|
||||
if($ARGV[0] eq "*") {
|
||||
init_protocols();
|
||||
}
|
||||
else {
|
||||
@protocols = split(",", $ARGV[0]);
|
||||
}
|
||||
print "Set " . scalar @protocols . " protocols\n";
|
||||
}
|
||||
elsif($ARGV[0] eq "preprocess") {
|
||||
shift @ARGV;
|
||||
loadtest("${TESTDIR}/test${ARGV[0]}");
|
||||
readtestkeywords();
|
||||
singletest_preprocess($ARGV[0]);
|
||||
}
|
||||
elsif($ARGV[0] eq "protoport") {
|
||||
shift @ARGV;
|
||||
my $port = protoport($ARGV[0]);
|
||||
print "protoport: $port\n";
|
||||
}
|
||||
elsif($ARGV[0] eq "serverfortest") {
|
||||
shift @ARGV;
|
||||
my ($why, $e) = serverfortest(split(/,/, $ARGV[0]));
|
||||
print "serverfortest: $e $why\n";
|
||||
}
|
||||
elsif($ARGV[0] eq "stopservers") {
|
||||
my $err = stopservers();
|
||||
print "stopservers: $err\n";
|
||||
}
|
||||
else {
|
||||
print "Error: Unknown command: $ARGV[0]\n";
|
||||
print "Continuing anyway\n";
|
||||
}
|
||||
shift @ARGV;
|
||||
}
|
Loading…
x
Reference in New Issue
Block a user