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