tests/convsrctest.pl

   1 #!/usr/bin/env perl
   2 #***************************************************************************
   3 #                                  _   _ ____  _
   4 #  Project                     ___| | | |  _ \| |
   5 #                             / __| | | | |_) | |
   6 #                            | (__| |_| |  _ <| |___
   7 #                             \___|\___/|_| \_\_____|
   8 #
   9 # Copyright (C) 1998 - 2011, Daniel Stenberg, <daniel@haxx.se>, et al.
  10 #
  11 # This software is licensed as described in the file COPYING, which
  12 # you should have received as part of this distribution. The terms
  13 # are also available at http://curl.haxx.se/docs/copyright.html.
  14 #
  15 # You may opt to use, copy, modify, merge, publish, distribute and/or sell
  16 # copies of the Software, and permit persons to whom the Software is
  17 # furnished to do so, under the terms of the COPYING file.
  18 #
  19 # This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
  20 # KIND, either express or implied.
  21 #
  22 #***************************************************************************
  23
  24 #=======================================================================
  25 # Read a test definition which exercises curl's --libcurl option.
  26 # Generate either compilable source code for a new test tool,
  27 # or a new test definition which runs the tool and expects the
  28 # same output.
  29 # This should verify that the --libcurl code really does perform
  30 # the same actions as the original curl invocation.
  31 #-----------------------------------------------------------------------
  32 # The output of curl's --libcurl option differs in several ways from
  33 # the code needed to integrate with the test tool environment:
  34 # - #include "test.h"
  35 # - no call of curl_global_init & curl_global_cleanup
  36 # - main() function vs. test() function
  37 # - no checking of curl_easy_setopt calls vs. test_setopt wrapper
  38 # - handling of stdout
  39 # - variable names ret & hnd vs. res & curl
  40 # - URL as literal string vs. passed as argument
  41 #=======================================================================
  42 use strict;
  43 require "getpart.pm";
  44
  45 # Boilerplate code for test tool
  46 my $head =
  47 '#include "test.h"
  48 #include "memdebug.h"
  49
  50 int test(char *URL)
  51 {
  52   CURLcode res;
  53   CURL *curl;
  54 ';
  55 # Other declarations from --libcurl come here
  56 # e.g. curl_slist
  57 my $init =
  58 '
  59   if (curl_global_init(CURL_GLOBAL_ALL) != CURLE_OK) {
  60     fprintf(stderr, "curl_global_init() failed\n");
  61     return TEST_ERR_MAJOR_BAD;
  62   }
  63
  64   if ((curl = curl_easy_init()) == NULL) {
  65     fprintf(stderr, "curl_easy_init() failed\n");
  66     curl_global_cleanup();
  67     return TEST_ERR_MAJOR_BAD;
  68   }
  69 ';
  70 # Option setting, perform and cleanup come here
  71 my $exit =
  72 '  curl_global_cleanup();
  73
  74   return (int)res;
  75 }
  76 ';
  77
  78 my $myname = leaf($0);
  79 sub usage {die "Usage: $myname -c|-test=num testfile\n";}
  80
  81 sub main {
  82     @ARGV == 2
  83         or usage;
  84     my($opt,$testfile) = @ARGV;
  85
  86     if(loadtest($testfile)) {
  87         die "$myname: $testfile doesn't look like a test case\n";
  88     }
  89
  90     my $comment = sprintf("DO NOT EDIT - generated from %s by %s",
  91                           leaf($testfile), $myname);
  92     if($opt eq '-c') {
  93         generate_c($comment);
  94     }
  95     elsif(my($num) = $opt =~ /^-test=(\d+)$/) {
  96         generate_test($comment, $num);
  97     }
  98     else {
  99         usage;
 100     }
 101 }
 102
 103 sub generate_c {
 104     my($comment) = @_;
 105     # Fetch the generated code, which is the output file checked by
 106     # the old test.
 107     my @libcurl = getpart("verify", "file")
 108         or die "$myname: no <verify><file> section found\n";
 109
 110     # Mangle the code into a suitable form for a test tool.
 111     # We want to extract the important parts (declarations,
 112     # URL, setopt calls, cleanup code) from the --libcurl
 113     # boilerplate and insert them into a new boilerplate.
 114     my(@decl,@code);
 115     # First URL passed in as argument, others as global
 116     my @urlvars = ('URL', 'libtest_arg2', 'libtest_arg3');
 117     my($seen_main,$seen_setopt,$seen_return);
 118     foreach (@libcurl) {
 119         # Check state changes first (even though it
 120         # duplicates some matches) so that the other tests
 121         # are in a logical order).
 122         if(/^int main/) {
 123             $seen_main = 1;
 124         }
 125         if($seen_main and /curl_easy_setopt/) {
 126             # Don't match 'curl_easy_setopt' in comment!
 127             $seen_setopt = 1;
 128         }
 129         if(/^\s*return/) {
 130             $seen_return = 1;
 131         }
 132
 133         # Now filter the code according to purpose
 134         if(! $seen_main) {
 135             next;
 136         }
 137         elsif(! $seen_setopt) {
 138             if(/^\s*(int main|\{|CURLcode |CURL |hnd = curl_easy_init)/) {
 139                 # Initialisations handled by boilerplate
 140                 next;
 141             }
 142             else {
 143                 push @decl, $_;
 144             }
 145         }
 146         elsif(! $seen_return) {
 147             if(/CURLOPT_URL/) {
 148                 # URL is passed in as argument or by global
 149                 my $var = shift @urlvars;
 150                 s/\"[^\"]*\"/$var/;
 151             }
 152             s/\bhnd\b/curl/;
 153             # Convert to macro wrapper
 154             s/curl_easy_setopt/test_setopt/;
 155             if(/curl_easy_perform/) {
 156                 s/\bret\b/res/;
 157                 push @code, $_;
 158                 push @code, "test_cleanup:\n";
 159             }
 160             else {
 161                 push @code, $_;
 162             }
 163         }
 164     }
 165
 166     print ("/* $comment */\n",
 167            $head,
 168            @decl,
 169            $init,
 170            @code,
 171            $exit);
 172 }
 173
 174 # Read the original test data file and transform it
 175 # - add a "DO NOT EDIT comment"
 176 # - replace CURLOPT_URL string with URL variable
 177 # - remove <verify><file> section (was the --libcurl output)
 178 # - insert a <client><tool> section with our new C program name
 179 # - replace <client><command> section with the URL
 180 sub generate_test {
 181     my($comment,$newnumber) = @_;
 182     my @libcurl = getpart("verify", "file")
 183         or die "$myname: no <verify><file> section found\n";
 184     # Scan the --libcurl code to find the URL used.
 185     my $url;
 186     foreach (@libcurl) {
 187         if(my($u) = /CURLOPT_URL, \"([^\"]*)\"/) {
 188             $url = $u;
 189         }
 190     }
 191     die "$myname: CURLOPT_URL not found\n"
 192         unless defined $url;
 193
 194     # Traverse the pseudo-XML transforming as required
 195     my @new;
 196     my(@path,$path,$skip);
 197     foreach (getall()) {
 198         if(my($end) = /\s*<(\/?)testcase>/) {
 199             push @new, $_;
 200             push @new, "# $comment\n"
 201                 unless $end;
 202         }
 203         elsif(my($tag) = /^\s*<(\w+)/) {
 204             push @path, $tag;
 205             $path = join '/', @path;
 206             if($path eq 'verify/file') {
 207                 $skip = 1;
 208             }
 209             push @new, $_
 210                 unless $skip;
 211             if($path eq 'client') {
 212                 push @new, ("<tool>\n",
 213                             "lib$newnumber\n",
 214                             "</tool>\n");
 215             }
 216             elsif($path eq 'client/command') {
 217                 push @new, sh_quote($url)."\n";
 218             }
 219         }
 220         elsif(my($etag) = /^\s*<\/(\w+)/) {
 221             my $tag = pop @path;
 222             die "$myname: mismatched </$etag>\n"
 223                 unless $tag eq $etag;
 224             push @new, $_
 225                 unless $skip;
 226             $skip --
 227                 if $path eq 'verify/file';
 228             $path = join '/', @path;
 229         }
 230         else {
 231             if($path eq 'client/command') {
 232                 # Replaced above
 233             }
 234             else {
 235                 push @new, $_
 236                     unless $skip;
 237             }
 238         }
 239     }
 240     print @new;
 241 }
 242
 243 sub leaf {
 244     # Works for POSIX filenames
 245     (my $path = shift) =~ s!.*/!!;
 246     return $path;
 247 }
 248
 249 sub sh_quote {
 250     my $word = shift;
 251     $word =~ s/[\$\"\'\\]/\\$&/g;
 252     return '"' . $word . '"';
 253 }
 254
 255 main;