ubuntu: Add extra suppressions for libnl.1 leaks.
[libguestfs.git] / generator / generator_bindtests.ml
1 (* libguestfs
2  * Copyright (C) 2009-2010 Red Hat Inc.
3  *
4  * This program is free software; you can redistribute it and/or modify
5  * it under the terms of the GNU General Public License as published by
6  * the Free Software Foundation; either version 2 of the License, or
7  * (at your option) any later version.
8  *
9  * This program is distributed in the hope that it will be useful,
10  * but WITHOUT ANY WARRANTY; without even the implied warranty of
11  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12  * GNU General Public License for more details.
13  *
14  * You should have received a copy of the GNU General Public License
15  * along with this program; if not, write to the Free Software
16  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
17  *)
18
19 (* Please read generator/README first. *)
20
21 open Printf
22
23 open Generator_types
24 open Generator_utils
25 open Generator_pr
26 open Generator_docstrings
27 open Generator_optgroups
28 open Generator_actions
29 open Generator_structs
30 open Generator_c
31
32 let rec generate_bindtests () =
33   generate_header CStyle LGPLv2plus;
34
35   pr "\
36 #include <stdio.h>
37 #include <stdlib.h>
38 #include <inttypes.h>
39 #include <string.h>
40
41 #include \"guestfs.h\"
42 #include \"guestfs-internal.h\"
43 #include \"guestfs-internal-actions.h\"
44 #include \"guestfs_protocol.h\"
45
46 static void
47 print_strings (char *const *argv)
48 {
49   size_t argc;
50
51   printf (\"[\");
52   for (argc = 0; argv[argc] != NULL; ++argc) {
53     if (argc > 0) printf (\", \");
54     printf (\"\\\"%%s\\\"\", argv[argc]);
55   }
56   printf (\"]\\n\");
57 }
58
59 /* The test0 function prints its parameters to stdout. */
60 ";
61
62   let test0, tests =
63     match test_functions with
64     | [] -> assert false
65     | test0 :: tests -> test0, tests in
66
67   let () =
68     let (name, (ret, args, _ as style), _, _, _, _, _) = test0 in
69     generate_prototype ~extern:false ~semicolon:false ~newline:true
70       ~handle:"g" ~prefix:"guestfs__" name style;
71     pr "{\n";
72     List.iter (
73       function
74       | Pathname n
75       | Device n | Dev_or_Path n
76       | String n
77       | FileIn n
78       | FileOut n
79       | Key n -> pr "  printf (\"%%s\\n\", %s);\n" n
80       | BufferIn n ->
81           pr "  {\n";
82           pr "    size_t i;\n";
83           pr "    for (i = 0; i < %s_size; ++i)\n" n;
84           pr "      printf (\"<%%02x>\", %s[i]);\n" n;
85           pr "    printf (\"\\n\");\n";
86           pr "  }\n";
87       | OptString n -> pr "  printf (\"%%s\\n\", %s ? %s : \"null\");\n" n n
88       | StringList n | DeviceList n -> pr "  print_strings (%s);\n" n
89       | Bool n -> pr "  printf (\"%%s\\n\", %s ? \"true\" : \"false\");\n" n
90       | Int n -> pr "  printf (\"%%d\\n\", %s);\n" n
91       | Int64 n -> pr "  printf (\"%%\" PRIi64 \"\\n\", %s);\n" n
92       | Pointer _ -> assert false
93     ) args;
94     pr "  /* Java changes stdout line buffering so we need this: */\n";
95     pr "  fflush (stdout);\n";
96     pr "  return 0;\n";
97     pr "}\n";
98     pr "\n" in
99
100   List.iter (
101     fun (name, (ret, args, _ as style), _, _, _, _, _) ->
102       if String.sub name (String.length name - 3) 3 <> "err" then (
103         pr "/* Test normal return. */\n";
104         generate_prototype ~extern:false ~semicolon:false ~newline:true
105           ~handle:"g" ~prefix:"guestfs__" name style;
106         pr "{\n";
107         (match ret with
108          | RErr ->
109              pr "  return 0;\n"
110          | RInt _ ->
111              pr "  int r;\n";
112              pr "  if (sscanf (val, \"%%d\", &r) != 1) {\n";
113              pr "    error (g, \"%%s: expecting int argument\", \"%s\");\n" name;
114              pr "    return -1;\n";
115              pr "  }\n";
116              pr "  return r;\n"
117          | RInt64 _ ->
118              pr "  int64_t r;\n";
119              pr "  if (sscanf (val, \"%%\" SCNi64, &r) != 1) {\n";
120              pr "    error (g, \"%%s: expecting int64 argument\", \"%s\");\n" name;
121              pr "    return -1;\n";
122              pr "  }\n";
123              pr "  return r;\n"
124          | RBool _ ->
125              pr "  return STREQ (val, \"true\");\n"
126          | RConstString _
127          | RConstOptString _ ->
128              (* Can't return the input string here.  Return a static
129               * string so we ensure we get a segfault if the caller
130               * tries to free it.
131               *)
132              pr "  return \"static string\";\n"
133          | RString _ ->
134              pr "  return strdup (val);\n"
135          | RStringList _ ->
136              pr "  char **strs;\n";
137              pr "  int n, i;\n";
138              pr "  if (sscanf (val, \"%%d\", &n) != 1) {\n";
139              pr "    error (g, \"%%s: expecting int argument\", \"%s\");\n" name;
140              pr "    return NULL;\n";
141              pr "  }\n";
142              pr "  strs = safe_malloc (g, (n+1) * sizeof (char *));\n";
143              pr "  for (i = 0; i < n; ++i) {\n";
144              pr "    strs[i] = safe_malloc (g, 16);\n";
145              pr "    snprintf (strs[i], 16, \"%%d\", i);\n";
146              pr "  }\n";
147              pr "  strs[n] = NULL;\n";
148              pr "  return strs;\n"
149          | RStruct (_, typ) ->
150              pr "  struct guestfs_%s *r;\n" typ;
151              pr "  r = safe_calloc (g, sizeof *r, 1);\n";
152              pr "  return r;\n"
153          | RStructList (_, typ) ->
154              pr "  struct guestfs_%s_list *r;\n" typ;
155              pr "  uint32_t len;\n";
156              pr "  if (sscanf (val, \"%%\" SCNu32, &len) != 1) {\n";
157              pr "    error (g, \"%%s: expecting uint32 argument\", \"%s\");\n" name;
158              pr "    return NULL;\n";
159              pr "  }\n";
160              pr "  r = safe_calloc (g, sizeof *r, 1);\n";
161              pr "  r->len = len;\n";
162              pr "  r->val = safe_calloc (g, r->len, sizeof *r->val);\n";
163              pr "  return r;\n"
164          | RHashtable _ ->
165              pr "  char **strs;\n";
166              pr "  int n, i;\n";
167              pr "  if (sscanf (val, \"%%d\", &n) != -1) {\n";
168              pr "    error (g, \"%%s: expecting int argument\", \"%s\");\n" name;
169              pr "    return NULL;\n";
170              pr "  }\n";
171              pr "  strs = safe_malloc (g, (n*2+1) * sizeof (*strs));\n";
172              pr "  for (i = 0; i < n; ++i) {\n";
173              pr "    strs[i*2] = safe_malloc (g, 16);\n";
174              pr "    strs[i*2+1] = safe_malloc (g, 16);\n";
175              pr "    snprintf (strs[i*2], 16, \"%%d\", i);\n";
176              pr "    snprintf (strs[i*2+1], 16, \"%%d\", i);\n";
177              pr "  }\n";
178              pr "  strs[n*2] = NULL;\n";
179              pr "  return strs;\n"
180          | RBufferOut _ ->
181              pr "  return strdup (val);\n"
182         );
183         pr "}\n";
184         pr "\n"
185       ) else (
186         pr "/* Test error return. */\n";
187         generate_prototype ~extern:false ~semicolon:false ~newline:true
188           ~handle:"g" ~prefix:"guestfs__" name style;
189         pr "{\n";
190         pr "  error (g, \"error\");\n";
191         (match ret with
192          | RErr | RInt _ | RInt64 _ | RBool _ ->
193              pr "  return -1;\n"
194          | RConstString _ | RConstOptString _
195          | RString _ | RStringList _ | RStruct _
196          | RStructList _
197          | RHashtable _
198          | RBufferOut _ ->
199              pr "  return NULL;\n"
200         );
201         pr "}\n";
202         pr "\n"
203       )
204   ) tests
205
206 and generate_ocaml_bindtests () =
207   generate_header OCamlStyle GPLv2plus;
208
209   pr "\
210 let () =
211   let g = Guestfs.create () in
212 ";
213
214   let mkargs args =
215     String.concat " " (
216       List.map (
217         function
218         | CallString s -> "\"" ^ s ^ "\""
219         | CallOptString None -> "None"
220         | CallOptString (Some s) -> sprintf "(Some \"%s\")" s
221         | CallStringList xs ->
222             "[|" ^ String.concat ";" (List.map (sprintf "\"%s\"") xs) ^ "|]"
223         | CallInt i when i >= 0 -> string_of_int i
224         | CallInt i (* when i < 0 *) -> "(" ^ string_of_int i ^ ")"
225         | CallInt64 i when i >= 0L -> Int64.to_string i ^ "L"
226         | CallInt64 i (* when i < 0L *) -> "(" ^ Int64.to_string i ^ "L)"
227         | CallBool b -> string_of_bool b
228         | CallBuffer s -> sprintf "%S" s
229       ) args
230     )
231   in
232
233   generate_lang_bindtests (
234     fun f args -> pr "  Guestfs.%s g %s;\n" f (mkargs args)
235   );
236
237   pr "print_endline \"EOF\"\n"
238
239 and generate_perl_bindtests () =
240   pr "#!/usr/bin/perl -w\n";
241   generate_header HashStyle GPLv2plus;
242
243   pr "\
244 use strict;
245
246 use Sys::Guestfs;
247
248 my $g = Sys::Guestfs->new ();
249 ";
250
251   let mkargs args =
252     String.concat ", " (
253       List.map (
254         function
255         | CallString s -> "\"" ^ s ^ "\""
256         | CallOptString None -> "undef"
257         | CallOptString (Some s) -> sprintf "\"%s\"" s
258         | CallStringList xs ->
259             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
260         | CallInt i -> string_of_int i
261         | CallInt64 i -> Int64.to_string i
262         | CallBool b -> if b then "1" else "0"
263         | CallBuffer s -> "\"" ^ c_quote s ^ "\""
264       ) args
265     )
266   in
267
268   generate_lang_bindtests (
269     fun f args -> pr "$g->%s (%s);\n" f (mkargs args)
270   );
271
272   pr "print \"EOF\\n\"\n"
273
274 and generate_python_bindtests () =
275   generate_header HashStyle GPLv2plus;
276
277   pr "\
278 import guestfs
279
280 g = guestfs.GuestFS ()
281 ";
282
283   let mkargs args =
284     String.concat ", " (
285       List.map (
286         function
287         | CallString s -> "\"" ^ s ^ "\""
288         | CallOptString None -> "None"
289         | CallOptString (Some s) -> sprintf "\"%s\"" s
290         | CallStringList xs ->
291             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
292         | CallInt i -> string_of_int i
293         | CallInt64 i -> Int64.to_string i
294         | CallBool b -> if b then "1" else "0"
295         | CallBuffer s -> "\"" ^ c_quote s ^ "\""
296       ) args
297     )
298   in
299
300   generate_lang_bindtests (
301     fun f args -> pr "g.%s (%s)\n" f (mkargs args)
302   );
303
304   pr "print (\"EOF\")\n"
305
306 and generate_ruby_bindtests () =
307   generate_header HashStyle GPLv2plus;
308
309   pr "\
310 require 'guestfs'
311
312 g = Guestfs::create()
313 ";
314
315   let mkargs args =
316     String.concat ", " (
317       List.map (
318         function
319         | CallString s -> "\"" ^ s ^ "\""
320         | CallOptString None -> "nil"
321         | CallOptString (Some s) -> sprintf "\"%s\"" s
322         | CallStringList xs ->
323             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
324         | CallInt i -> string_of_int i
325         | CallInt64 i -> Int64.to_string i
326         | CallBool b -> string_of_bool b
327         | CallBuffer s -> "\"" ^ c_quote s ^ "\""
328       ) args
329     )
330   in
331
332   generate_lang_bindtests (
333     fun f args -> pr "g.%s(%s)\n" f (mkargs args)
334   );
335
336   pr "print \"EOF\\n\"\n"
337
338 and generate_java_bindtests () =
339   generate_header CStyle GPLv2plus;
340
341   pr "\
342 import com.redhat.et.libguestfs.*;
343
344 public class Bindtests {
345     public static void main (String[] argv)
346     {
347         try {
348             GuestFS g = new GuestFS ();
349 ";
350
351   let mkargs args =
352     String.concat ", " (
353       List.map (
354         function
355         | CallString s -> "\"" ^ s ^ "\""
356         | CallOptString None -> "null"
357         | CallOptString (Some s) -> sprintf "\"%s\"" s
358         | CallStringList xs ->
359             "new String[]{" ^
360               String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "}"
361         | CallInt i -> string_of_int i
362         | CallInt64 i -> Int64.to_string i
363         | CallBool b -> string_of_bool b
364         | CallBuffer s ->
365             "new byte[] { " ^ String.concat "," (
366               map_chars (fun c -> string_of_int (Char.code c)) s
367             ) ^ " }"
368       ) args
369     )
370   in
371
372   generate_lang_bindtests (
373     fun f args -> pr "            g.%s (%s);\n" f (mkargs args)
374   );
375
376   pr "
377             System.out.println (\"EOF\");
378         }
379         catch (Exception exn) {
380             System.err.println (exn);
381             System.exit (1);
382         }
383     }
384 }
385 "
386
387 and generate_haskell_bindtests () =
388   generate_header HaskellStyle GPLv2plus;
389
390   pr "\
391 module Bindtests where
392 import qualified Guestfs
393
394 main = do
395   g <- Guestfs.create
396 ";
397
398   let mkargs args =
399     String.concat " " (
400       List.map (
401         function
402         | CallString s -> "\"" ^ s ^ "\""
403         | CallOptString None -> "Nothing"
404         | CallOptString (Some s) -> sprintf "(Just \"%s\")" s
405         | CallStringList xs ->
406             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
407         | CallInt i when i < 0 -> "(" ^ string_of_int i ^ ")"
408         | CallInt i -> string_of_int i
409         | CallInt64 i when i < 0L -> "(" ^ Int64.to_string i ^ ")"
410         | CallInt64 i -> Int64.to_string i
411         | CallBool true -> "True"
412         | CallBool false -> "False"
413         | CallBuffer s -> "\"" ^ c_quote s ^ "\""
414       ) args
415     )
416   in
417
418   generate_lang_bindtests (
419     fun f args -> pr "  Guestfs.%s g %s\n" f (mkargs args)
420   );
421
422   pr "  putStrLn \"EOF\"\n"
423
424 (* Language-independent bindings tests - we do it this way to
425  * ensure there is parity in testing bindings across all languages.
426  *)
427 and generate_lang_bindtests call =
428   call "test0" [CallString "abc"; CallOptString (Some "def");
429                 CallStringList []; CallBool false;
430                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456";
431                 CallBuffer "abc\000abc"];
432   call "test0" [CallString "abc"; CallOptString None;
433                 CallStringList []; CallBool false;
434                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456";
435                 CallBuffer "abc\000abc"];
436   call "test0" [CallString ""; CallOptString (Some "def");
437                 CallStringList []; CallBool false;
438                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456";
439                 CallBuffer "abc\000abc"];
440   call "test0" [CallString ""; CallOptString (Some "");
441                 CallStringList []; CallBool false;
442                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456";
443                 CallBuffer "abc\000abc"];
444   call "test0" [CallString "abc"; CallOptString (Some "def");
445                 CallStringList ["1"]; CallBool false;
446                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456";
447                 CallBuffer "abc\000abc"];
448   call "test0" [CallString "abc"; CallOptString (Some "def");
449                 CallStringList ["1"; "2"]; CallBool false;
450                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456";
451                 CallBuffer "abc\000abc"];
452   call "test0" [CallString "abc"; CallOptString (Some "def");
453                 CallStringList ["1"]; CallBool true;
454                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456";
455                 CallBuffer "abc\000abc"];
456   call "test0" [CallString "abc"; CallOptString (Some "def");
457                 CallStringList ["1"]; CallBool false;
458                 CallInt (-1); CallInt64 (-1L); CallString "123"; CallString "456";
459                 CallBuffer "abc\000abc"];
460   call "test0" [CallString "abc"; CallOptString (Some "def");
461                 CallStringList ["1"]; CallBool false;
462                 CallInt (-2); CallInt64 (-2L); CallString "123"; CallString "456";
463                 CallBuffer "abc\000abc"];
464   call "test0" [CallString "abc"; CallOptString (Some "def");
465                 CallStringList ["1"]; CallBool false;
466                 CallInt 1; CallInt64 1L; CallString "123"; CallString "456";
467                 CallBuffer "abc\000abc"];
468   call "test0" [CallString "abc"; CallOptString (Some "def");
469                 CallStringList ["1"]; CallBool false;
470                 CallInt 2; CallInt64 2L; CallString "123"; CallString "456";
471                 CallBuffer "abc\000abc"];
472   call "test0" [CallString "abc"; CallOptString (Some "def");
473                 CallStringList ["1"]; CallBool false;
474                 CallInt 4095; CallInt64 4095L; CallString "123"; CallString "456";
475                 CallBuffer "abc\000abc"];
476   call "test0" [CallString "abc"; CallOptString (Some "def");
477                 CallStringList ["1"]; CallBool false;
478                 CallInt 0; CallInt64 0L; CallString ""; CallString "";
479                 CallBuffer "abc\000abc"]
480
481 (* XXX Add here tests of the return and error functions. *)