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 #define error guestfs_error
  47 #define safe_calloc guestfs_safe_calloc
  48 #define safe_malloc guestfs_safe_malloc
  49
  50 static void
  51 print_strings (char *const *argv)
  52 {
  53   size_t argc;
  54
  55   printf (\"[\");
  56   for (argc = 0; argv[argc] != NULL; ++argc) {
  57     if (argc > 0) printf (\", \");
  58     printf (\"\\\"%%s\\\"\", argv[argc]);
  59   }
  60   printf (\"]\\n\");
  61 }
  62
  63 /* The test0 function prints its parameters to stdout. */
  64 ";
  65
  66   let test0, tests =
  67     match test_functions with
  68     | [] -> assert false
  69     | test0 :: tests -> test0, tests in
  70
  71   let () =
  72     let (name, (ret, args, _ as style), _, _, _, _, _) = test0 in
  73     generate_prototype ~extern:false ~semicolon:false ~newline:true
  74       ~handle:"g" ~prefix:"guestfs__" name style;
  75     pr "{\n";
  76     List.iter (
  77       function
  78       | Pathname n
  79       | Device n | Dev_or_Path n
  80       | String n
  81       | FileIn n
  82       | FileOut n
  83       | Key n -> pr "  printf (\"%%s\\n\", %s);\n" n
  84       | BufferIn n ->
  85           pr "  {\n";
  86           pr "    size_t i;\n";
  87           pr "    for (i = 0; i < %s_size; ++i)\n" n;
  88           pr "      printf (\"<%%02x>\", %s[i]);\n" n;
  89           pr "    printf (\"\\n\");\n";
  90           pr "  }\n";
  91       | OptString n -> pr "  printf (\"%%s\\n\", %s ? %s : \"null\");\n" n n
  92       | StringList n | DeviceList n -> pr "  print_strings (%s);\n" n
  93       | Bool n -> pr "  printf (\"%%s\\n\", %s ? \"true\" : \"false\");\n" n
  94       | Int n -> pr "  printf (\"%%d\\n\", %s);\n" n
  95       | Int64 n -> pr "  printf (\"%%\" PRIi64 \"\\n\", %s);\n" n
  96     ) args;
  97     pr "  /* Java changes stdout line buffering so we need this: */\n";
  98     pr "  fflush (stdout);\n";
  99     pr "  return 0;\n";
 100     pr "}\n";
 101     pr "\n" in
 102
 103   List.iter (
 104     fun (name, (ret, args, _ as style), _, _, _, _, _) ->
 105       if String.sub name (String.length name - 3) 3 <> "err" then (
 106         pr "/* Test normal return. */\n";
 107         generate_prototype ~extern:false ~semicolon:false ~newline:true
 108           ~handle:"g" ~prefix:"guestfs__" name style;
 109         pr "{\n";
 110         (match ret with
 111          | RErr ->
 112              pr "  return 0;\n"
 113          | RInt _ ->
 114              pr "  int r;\n";
 115              pr "  sscanf (val, \"%%d\", &r);\n";
 116              pr "  return r;\n"
 117          | RInt64 _ ->
 118              pr "  int64_t r;\n";
 119              pr "  sscanf (val, \"%%\" SCNi64, &r);\n";
 120              pr "  return r;\n"
 121          | RBool _ ->
 122              pr "  return STREQ (val, \"true\");\n"
 123          | RConstString _
 124          | RConstOptString _ ->
 125              (* Can't return the input string here.  Return a static
 126               * string so we ensure we get a segfault if the caller
 127               * tries to free it.
 128               *)
 129              pr "  return \"static string\";\n"
 130          | RString _ ->
 131              pr "  return strdup (val);\n"
 132          | RStringList _ ->
 133              pr "  char **strs;\n";
 134              pr "  int n, i;\n";
 135              pr "  sscanf (val, \"%%d\", &n);\n";
 136              pr "  strs = safe_malloc (g, (n+1) * sizeof (char *));\n";
 137              pr "  for (i = 0; i < n; ++i) {\n";
 138              pr "    strs[i] = safe_malloc (g, 16);\n";
 139              pr "    snprintf (strs[i], 16, \"%%d\", i);\n";
 140              pr "  }\n";
 141              pr "  strs[n] = NULL;\n";
 142              pr "  return strs;\n"
 143          | RStruct (_, typ) ->
 144              pr "  struct guestfs_%s *r;\n" typ;
 145              pr "  r = safe_calloc (g, sizeof *r, 1);\n";
 146              pr "  return r;\n"
 147          | RStructList (_, typ) ->
 148              pr "  struct guestfs_%s_list *r;\n" typ;
 149              pr "  r = safe_calloc (g, sizeof *r, 1);\n";
 150              pr "  sscanf (val, \"%%d\", &r->len);\n";
 151              pr "  r->val = safe_calloc (g, r->len, sizeof *r->val);\n";
 152              pr "  return r;\n"
 153          | RHashtable _ ->
 154              pr "  char **strs;\n";
 155              pr "  int n, i;\n";
 156              pr "  sscanf (val, \"%%d\", &n);\n";
 157              pr "  strs = safe_malloc (g, (n*2+1) * sizeof (*strs));\n";
 158              pr "  for (i = 0; i < n; ++i) {\n";
 159              pr "    strs[i*2] = safe_malloc (g, 16);\n";
 160              pr "    strs[i*2+1] = safe_malloc (g, 16);\n";
 161              pr "    snprintf (strs[i*2], 16, \"%%d\", i);\n";
 162              pr "    snprintf (strs[i*2+1], 16, \"%%d\", i);\n";
 163              pr "  }\n";
 164              pr "  strs[n*2] = NULL;\n";
 165              pr "  return strs;\n"
 166          | RBufferOut _ ->
 167              pr "  return strdup (val);\n"
 168         );
 169         pr "}\n";
 170         pr "\n"
 171       ) else (
 172         pr "/* Test error return. */\n";
 173         generate_prototype ~extern:false ~semicolon:false ~newline:true
 174           ~handle:"g" ~prefix:"guestfs__" name style;
 175         pr "{\n";
 176         pr "  error (g, \"error\");\n";
 177         (match ret with
 178          | RErr | RInt _ | RInt64 _ | RBool _ ->
 179              pr "  return -1;\n"
 180          | RConstString _ | RConstOptString _
 181          | RString _ | RStringList _ | RStruct _
 182          | RStructList _
 183          | RHashtable _
 184          | RBufferOut _ ->
 185              pr "  return NULL;\n"
 186         );
 187         pr "}\n";
 188         pr "\n"
 189       )
 190   ) tests
 191
 192 and generate_ocaml_bindtests () =
 193   generate_header OCamlStyle GPLv2plus;
 194
 195   pr "\
 196 let () =
 197   let g = Guestfs.create () in
 198 ";
 199
 200   let mkargs args =
 201     String.concat " " (
 202       List.map (
 203         function
 204         | CallString s -> "\"" ^ s ^ "\""
 205         | CallOptString None -> "None"
 206         | CallOptString (Some s) -> sprintf "(Some \"%s\")" s
 207         | CallStringList xs ->
 208             "[|" ^ String.concat ";" (List.map (sprintf "\"%s\"") xs) ^ "|]"
 209         | CallInt i when i >= 0 -> string_of_int i
 210         | CallInt i (* when i < 0 *) -> "(" ^ string_of_int i ^ ")"
 211         | CallInt64 i when i >= 0L -> Int64.to_string i ^ "L"
 212         | CallInt64 i (* when i < 0L *) -> "(" ^ Int64.to_string i ^ "L)"
 213         | CallBool b -> string_of_bool b
 214         | CallBuffer s -> sprintf "%S" s
 215       ) args
 216     )
 217   in
 218
 219   generate_lang_bindtests (
 220     fun f args -> pr "  Guestfs.%s g %s;\n" f (mkargs args)
 221   );
 222
 223   pr "print_endline \"EOF\"\n"
 224
 225 and generate_perl_bindtests () =
 226   pr "#!/usr/bin/perl -w\n";
 227   generate_header HashStyle GPLv2plus;
 228
 229   pr "\
 230 use strict;
 231
 232 use Sys::Guestfs;
 233
 234 my $g = Sys::Guestfs->new ();
 235 ";
 236
 237   let mkargs args =
 238     String.concat ", " (
 239       List.map (
 240         function
 241         | CallString s -> "\"" ^ s ^ "\""
 242         | CallOptString None -> "undef"
 243         | CallOptString (Some s) -> sprintf "\"%s\"" s
 244         | CallStringList xs ->
 245             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
 246         | CallInt i -> string_of_int i
 247         | CallInt64 i -> Int64.to_string i
 248         | CallBool b -> if b then "1" else "0"
 249         | CallBuffer s -> "\"" ^ c_quote s ^ "\""
 250       ) args
 251     )
 252   in
 253
 254   generate_lang_bindtests (
 255     fun f args -> pr "$g->%s (%s);\n" f (mkargs args)
 256   );
 257
 258   pr "print \"EOF\\n\"\n"
 259
 260 and generate_python_bindtests () =
 261   generate_header HashStyle GPLv2plus;
 262
 263   pr "\
 264 import guestfs
 265
 266 g = guestfs.GuestFS ()
 267 ";
 268
 269   let mkargs args =
 270     String.concat ", " (
 271       List.map (
 272         function
 273         | CallString s -> "\"" ^ s ^ "\""
 274         | CallOptString None -> "None"
 275         | CallOptString (Some s) -> sprintf "\"%s\"" s
 276         | CallStringList xs ->
 277             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
 278         | CallInt i -> string_of_int i
 279         | CallInt64 i -> Int64.to_string i
 280         | CallBool b -> if b then "1" else "0"
 281         | CallBuffer s -> "\"" ^ c_quote s ^ "\""
 282       ) args
 283     )
 284   in
 285
 286   generate_lang_bindtests (
 287     fun f args -> pr "g.%s (%s)\n" f (mkargs args)
 288   );
 289
 290   pr "print \"EOF\"\n"
 291
 292 and generate_ruby_bindtests () =
 293   generate_header HashStyle GPLv2plus;
 294
 295   pr "\
 296 require 'guestfs'
 297
 298 g = Guestfs::create()
 299 ";
 300
 301   let mkargs args =
 302     String.concat ", " (
 303       List.map (
 304         function
 305         | CallString s -> "\"" ^ s ^ "\""
 306         | CallOptString None -> "nil"
 307         | CallOptString (Some s) -> sprintf "\"%s\"" s
 308         | CallStringList xs ->
 309             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
 310         | CallInt i -> string_of_int i
 311         | CallInt64 i -> Int64.to_string i
 312         | CallBool b -> string_of_bool b
 313         | CallBuffer s -> "\"" ^ c_quote s ^ "\""
 314       ) args
 315     )
 316   in
 317
 318   generate_lang_bindtests (
 319     fun f args -> pr "g.%s(%s)\n" f (mkargs args)
 320   );
 321
 322   pr "print \"EOF\\n\"\n"
 323
 324 and generate_java_bindtests () =
 325   generate_header CStyle GPLv2plus;
 326
 327   pr "\
 328 import com.redhat.et.libguestfs.*;
 329
 330 public class Bindtests {
 331     public static void main (String[] argv)
 332     {
 333         try {
 334             GuestFS g = new GuestFS ();
 335 ";
 336
 337   let mkargs args =
 338     String.concat ", " (
 339       List.map (
 340         function
 341         | CallString s -> "\"" ^ s ^ "\""
 342         | CallOptString None -> "null"
 343         | CallOptString (Some s) -> sprintf "\"%s\"" s
 344         | CallStringList xs ->
 345             "new String[]{" ^
 346               String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "}"
 347         | CallInt i -> string_of_int i
 348         | CallInt64 i -> Int64.to_string i
 349         | CallBool b -> string_of_bool b
 350         | CallBuffer s ->
 351             "new byte[] { " ^ String.concat "," (
 352               map_chars (fun c -> string_of_int (Char.code c)) s
 353             ) ^ " }"
 354       ) args
 355     )
 356   in
 357
 358   generate_lang_bindtests (
 359     fun f args -> pr "            g.%s (%s);\n" f (mkargs args)
 360   );
 361
 362   pr "
 363             System.out.println (\"EOF\");
 364         }
 365         catch (Exception exn) {
 366             System.err.println (exn);
 367             System.exit (1);
 368         }
 369     }
 370 }
 371 "
 372
 373 and generate_haskell_bindtests () =
 374   generate_header HaskellStyle GPLv2plus;
 375
 376   pr "\
 377 module Bindtests where
 378 import qualified Guestfs
 379
 380 main = do
 381   g <- Guestfs.create
 382 ";
 383
 384   let mkargs args =
 385     String.concat " " (
 386       List.map (
 387         function
 388         | CallString s -> "\"" ^ s ^ "\""
 389         | CallOptString None -> "Nothing"
 390         | CallOptString (Some s) -> sprintf "(Just \"%s\")" s
 391         | CallStringList xs ->
 392             "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
 393         | CallInt i when i < 0 -> "(" ^ string_of_int i ^ ")"
 394         | CallInt i -> string_of_int i
 395         | CallInt64 i when i < 0L -> "(" ^ Int64.to_string i ^ ")"
 396         | CallInt64 i -> Int64.to_string i
 397         | CallBool true -> "True"
 398         | CallBool false -> "False"
 399         | CallBuffer s -> "\"" ^ c_quote s ^ "\""
 400       ) args
 401     )
 402   in
 403
 404   generate_lang_bindtests (
 405     fun f args -> pr "  Guestfs.%s g %s\n" f (mkargs args)
 406   );
 407
 408   pr "  putStrLn \"EOF\"\n"
 409
 410 (* Language-independent bindings tests - we do it this way to
 411  * ensure there is parity in testing bindings across all languages.
 412  *)
 413 and generate_lang_bindtests call =
 414   call "test0" [CallString "abc"; CallOptString (Some "def");
 415                 CallStringList []; CallBool false;
 416                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456";
 417                 CallBuffer "abc\000abc"];
 418   call "test0" [CallString "abc"; CallOptString None;
 419                 CallStringList []; CallBool false;
 420                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456";
 421                 CallBuffer "abc\000abc"];
 422   call "test0" [CallString ""; CallOptString (Some "def");
 423                 CallStringList []; CallBool false;
 424                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456";
 425                 CallBuffer "abc\000abc"];
 426   call "test0" [CallString ""; CallOptString (Some "");
 427                 CallStringList []; CallBool false;
 428                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456";
 429                 CallBuffer "abc\000abc"];
 430   call "test0" [CallString "abc"; CallOptString (Some "def");
 431                 CallStringList ["1"]; CallBool false;
 432                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456";
 433                 CallBuffer "abc\000abc"];
 434   call "test0" [CallString "abc"; CallOptString (Some "def");
 435                 CallStringList ["1"; "2"]; CallBool false;
 436                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456";
 437                 CallBuffer "abc\000abc"];
 438   call "test0" [CallString "abc"; CallOptString (Some "def");
 439                 CallStringList ["1"]; CallBool true;
 440                 CallInt 0; CallInt64 0L; CallString "123"; CallString "456";
 441                 CallBuffer "abc\000abc"];
 442   call "test0" [CallString "abc"; CallOptString (Some "def");
 443                 CallStringList ["1"]; CallBool false;
 444                 CallInt (-1); CallInt64 (-1L); CallString "123"; CallString "456";
 445                 CallBuffer "abc\000abc"];
 446   call "test0" [CallString "abc"; CallOptString (Some "def");
 447                 CallStringList ["1"]; CallBool false;
 448                 CallInt (-2); CallInt64 (-2L); CallString "123"; CallString "456";
 449                 CallBuffer "abc\000abc"];
 450   call "test0" [CallString "abc"; CallOptString (Some "def");
 451                 CallStringList ["1"]; CallBool false;
 452                 CallInt 1; CallInt64 1L; CallString "123"; CallString "456";
 453                 CallBuffer "abc\000abc"];
 454   call "test0" [CallString "abc"; CallOptString (Some "def");
 455                 CallStringList ["1"]; CallBool false;
 456                 CallInt 2; CallInt64 2L; CallString "123"; CallString "456";
 457                 CallBuffer "abc\000abc"];
 458   call "test0" [CallString "abc"; CallOptString (Some "def");
 459                 CallStringList ["1"]; CallBool false;
 460                 CallInt 4095; CallInt64 4095L; CallString "123"; CallString "456";
 461                 CallBuffer "abc\000abc"];
 462   call "test0" [CallString "abc"; CallOptString (Some "def");
 463                 CallStringList ["1"]; CallBool false;
 464                 CallInt 0; CallInt64 0L; CallString ""; CallString "";
 465                 CallBuffer "abc\000abc"]
 466
 467 (* XXX Add here tests of the return and error functions. *)