256 lines
7.4 KiB
Perl
256 lines
7.4 KiB
Perl
|
#!/usr/bin/env perl
|
||
|
|
#***************************************************************************
|
||
|
|
# _ _ ____ _
|
||
|
|
# Project ___| | | | _ \| |
|
||
|
|
# / __| | | | |_) | |
|
||
|
|
# | (__| |_| | _ <| |___
|
||
|
|
# \___|\___/|_| \_\_____|
|
||
|
|
#
|
||
|
|
# Copyright (C) 1998 - 2011, Daniel Stenberg, <daniel@haxx.se>, 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.haxx.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.
|
||
|
|
#
|
||
|
|
#***************************************************************************
|
||
|
|
|
||
|
|
#=======================================================================
|
||
|
|
# Read a test definition which exercises curl's --libcurl option.
|
||
|
|
# Generate either compilable source code for a new test tool,
|
||
|
|
# or a new test definition which runs the tool and expects the
|
||
|
|
# same output.
|
||
|
|
# This should verify that the --libcurl code really does perform
|
||
|
|
# the same actions as the original curl invocation.
|
||
|
|
#-----------------------------------------------------------------------
|
||
|
|
# The output of curl's --libcurl option differs in several ways from
|
||
|
|
# the code needed to integrate with the test tool environment:
|
||
|
|
# - #include "test.h"
|
||
|
|
# - no call of curl_global_init & curl_global_cleanup
|
||
|
|
# - main() function vs. test() function
|
||
|
|
# - no checking of curl_easy_setopt calls vs. test_setopt wrapper
|
||
|
|
# - handling of stdout
|
||
|
|
# - variable names ret & hnd vs. res & curl
|
||
|
|
# - URL as literal string vs. passed as argument
|
||
|
|
#=======================================================================
|
||
|
|
use strict;
|
||
|
|
require "getpart.pm";
|
||
|
|
|
||
|
|
# Boilerplate code for test tool
|
||
|
|
my $head =
|
||
|
|
'#include "test.h"
|
||
|
|
#include "memdebug.h"
|
||
|
|
|
||
|
|
int test(char *URL)
|
||
|
|
{
|
||
|
|
CURLcode res;
|
||
|
|
CURL *curl;
|
||
|
|
';
|
||
|
|
# Other declarations from --libcurl come here
|
||
|
|
# e.g. curl_slist
|
||
|
|
my $init =
|
||
|
|
'
|
||
|
|
if (curl_global_init(CURL_GLOBAL_ALL) != CURLE_OK) {
|
||
|
|
fprintf(stderr, "curl_global_init() failed\n");
|
||
|
|
return TEST_ERR_MAJOR_BAD;
|
||
|
|
}
|
||
|
|
|
||
|
|
if ((curl = curl_easy_init()) == NULL) {
|
||
|
|
fprintf(stderr, "curl_easy_init() failed\n");
|
||
|
|
curl_global_cleanup();
|
||
|
|
return TEST_ERR_MAJOR_BAD;
|
||
|
|
}
|
||
|
|
';
|
||
|
|
# Option setting, perform and cleanup come here
|
||
|
|
my $exit =
|
||
|
|
' curl_global_cleanup();
|
||
|
|
|
||
|
|
return (int)res;
|
||
|
|
}
|
||
|
|
';
|
||
|
|
|
||
|
|
my $myname = leaf($0);
|
||
|
|
sub usage {die "Usage: $myname -c|-test=num testfile\n";}
|
||
|
|
|
||
|
|
sub main {
|
||
|
|
@ARGV == 2
|
||
|
|
or usage;
|
||
|
|
my($opt,$testfile) = @ARGV;
|
||
|
|
|
||
|
|
if(loadtest($testfile)) {
|
||
|
|
die "$myname: $testfile doesn't look like a test case\n";
|
||
|
|
}
|
||
|
|
|
||
|
|
my $comment = sprintf("DO NOT EDIT - generated from %s by %s",
|
||
|
|
leaf($testfile), $myname);
|
||
|
|
if($opt eq '-c') {
|
||
|
|
generate_c($comment);
|
||
|
|
}
|
||
|
|
elsif(my($num) = $opt =~ /^-test=(\d+)$/) {
|
||
|
|
generate_test($comment, $num);
|
||
|
|
}
|
||
|
|
else {
|
||
|
|
usage;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
sub generate_c {
|
||
|
|
my($comment) = @_;
|
||
|
|
# Fetch the generated code, which is the output file checked by
|
||
|
|
# the old test.
|
||
|
|
my @libcurl = getpart("verify", "file")
|
||
|
|
or die "$myname: no <verify><file> section found\n";
|
||
|
|
|
||
|
|
# Mangle the code into a suitable form for a test tool.
|
||
|
|
# We want to extract the important parts (declarations,
|
||
|
|
# URL, setopt calls, cleanup code) from the --libcurl
|
||
|
|
# boilerplate and insert them into a new boilerplate.
|
||
|
|
my(@decl,@code);
|
||
|
|
# First URL passed in as argument, others as global
|
||
|
|
my @urlvars = ('URL', 'libtest_arg2', 'libtest_arg3');
|
||
|
|
my($seen_main,$seen_setopt,$seen_return);
|
||
|
|
foreach (@libcurl) {
|
||
|
|
# Check state changes first (even though it
|
||
|
|
# duplicates some matches) so that the other tests
|
||
|
|
# are in a logical order).
|
||
|
|
if(/^int main/) {
|
||
|
|
$seen_main = 1;
|
||
|
|
}
|
||
|
|
if($seen_main and /curl_easy_setopt/) {
|
||
|
|
# Don't match 'curl_easy_setopt' in comment!
|
||
|
|
$seen_setopt = 1;
|
||
|
|
}
|
||
|
|
if(/^\s*return/) {
|
||
|
|
$seen_return = 1;
|
||
|
|
}
|
||
|
|
|
||
|
|
# Now filter the code according to purpose
|
||
|
|
if(! $seen_main) {
|
||
|
|
next;
|
||
|
|
}
|
||
|
|
elsif(! $seen_setopt) {
|
||
|
|
if(/^\s*(int main|\{|CURLcode |CURL |hnd = curl_easy_init)/) {
|
||
|
|
# Initialisations handled by boilerplate
|
||
|
|
next;
|
||
|
|
}
|
||
|
|
else {
|
||
|
|
push @decl, $_;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
elsif(! $seen_return) {
|
||
|
|
if(/CURLOPT_URL/) {
|
||
|
|
# URL is passed in as argument or by global
|
||
|
|
my $var = shift @urlvars;
|
||
|
|
s/\"[^\"]*\"/$var/;
|
||
|
|
}
|
||
|
|
s/\bhnd\b/curl/;
|
||
|
|
# Convert to macro wrapper
|
||
|
|
s/curl_easy_setopt/test_setopt/;
|
||
|
|
if(/curl_easy_perform/) {
|
||
|
|
s/\bret\b/res/;
|
||
|
|
push @code, $_;
|
||
|
|
push @code, "test_cleanup:\n";
|
||
|
|
}
|
||
|
|
else {
|
||
|
|
push @code, $_;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
print ("/* $comment */\n",
|
||
|
|
$head,
|
||
|
|
@decl,
|
||
|
|
$init,
|
||
|
|
@code,
|
||
|
|
$exit);
|
||
|
|
}
|
||
|
|
|
||
|
|
# Read the original test data file and transform it
|
||
|
|
# - add a "DO NOT EDIT comment"
|
||
|
|
# - replace CURLOPT_URL string with URL variable
|
||
|
|
# - remove <verify><file> section (was the --libcurl output)
|
||
|
|
# - insert a <client><tool> section with our new C program name
|
||
|
|
# - replace <client><command> section with the URL
|
||
|
|
sub generate_test {
|
||
|
|
my($comment,$newnumber) = @_;
|
||
|
|
my @libcurl = getpart("verify", "file")
|
||
|
|
or die "$myname: no <verify><file> section found\n";
|
||
|
|
# Scan the --libcurl code to find the URL used.
|
||
|
|
my $url;
|
||
|
|
foreach (@libcurl) {
|
||
|
|
if(my($u) = /CURLOPT_URL, \"([^\"]*)\"/) {
|
||
|
|
$url = $u;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
die "$myname: CURLOPT_URL not found\n"
|
||
|
|
unless defined $url;
|
||
|
|
|
||
|
|
# Traverse the pseudo-XML transforming as required
|
||
|
|
my @new;
|
||
|
|
my(@path,$path,$skip);
|
||
|
|
foreach (getall()) {
|
||
|
|
if(my($end) = /\s*<(\/?)testcase>/) {
|
||
|
|
push @new, $_;
|
||
|
|
push @new, "# $comment\n"
|
||
|
|
unless $end;
|
||
|
|
}
|
||
|
|
elsif(my($tag) = /^\s*<(\w+)/) {
|
||
|
|
push @path, $tag;
|
||
|
|
$path = join '/', @path;
|
||
|
|
if($path eq 'verify/file') {
|
||
|
|
$skip = 1;
|
||
|
|
}
|
||
|
|
push @new, $_
|
||
|
|
unless $skip;
|
||
|
|
if($path eq 'client') {
|
||
|
|
push @new, ("<tool>\n",
|
||
|
|
"lib$newnumber\n",
|
||
|
|
"</tool>\n");
|
||
|
|
}
|
||
|
|
elsif($path eq 'client/command') {
|
||
|
|
push @new, sh_quote($url)."\n";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
elsif(my($etag) = /^\s*<\/(\w+)/) {
|
||
|
|
my $tag = pop @path;
|
||
|
|
die "$myname: mismatched </$etag>\n"
|
||
|
|
unless $tag eq $etag;
|
||
|
|
push @new, $_
|
||
|
|
unless $skip;
|
||
|
|
$skip --
|
||
|
|
if $path eq 'verify/file';
|
||
|
|
$path = join '/', @path;
|
||
|
|
}
|
||
|
|
else {
|
||
|
|
if($path eq 'client/command') {
|
||
|
|
# Replaced above
|
||
|
|
}
|
||
|
|
else {
|
||
|
|
push @new, $_
|
||
|
|
unless $skip;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
print @new;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub leaf {
|
||
|
|
# Works for POSIX filenames
|
||
|
|
(my $path = shift) =~ s!.*/!!;
|
||
|
|
return $path;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub sh_quote {
|
||
|
|
my $word = shift;
|
||
|
|
$word =~ s/[\$\"\'\\]/\\$&/g;
|
||
|
|
return '"' . $word . '"';
|
||
|
|
}
|
||
|
|
|
||
|
|
main;
|