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. *)