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