2
0

convsrctest.pl 7.4 KB

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