convsrctest.pl 7.5 KB

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