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#=======================================================================
42use strict;
43require "getpart.pm";
44
45# Boilerplate code for test tool
46my $head =
47'#include "test.h"
48#include "memdebug.h"
49
50int test(char *URL)
51{
52  CURLcode res;
53  CURL *curl;
54';
55# Other declarations from --libcurl come here
56# e.g. curl_slist
57my $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
71my $exit =
72'  curl_global_cleanup();
73
74  return (int)res;
75}
76';
77
78my $myname = leaf($0);
79sub usage {die "Usage: $myname -c|-test=num testfile\n";}
80
81sub 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
103sub 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
180sub 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
243sub leaf {
244    # Works for POSIX filenames
245    (my $path = shift) =~ s!.*/!!;
246    return $path;
247}
248
249sub sh_quote {
250    my $word = shift;
251    $word =~ s/[\$\"\'\\]/\\$&/g;
252    return '"' . $word . '"';
253}
254
255main;
256