| #!/usr/bin/env perl |
| #*************************************************************************** |
| # _ _ ____ _ |
| # Project ___| | | | _ \| | |
| # / __| | | | |_) | | |
| # | (__| |_| | _ <| |___ |
| # \___|\___/|_| \_\_____| |
| # |
| # Copyright (C) 1998 - 2020, 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; |