mirror of
https://github.com/libguestfs/libguestfs.git
synced 2026-03-22 07:03:38 +00:00
04d8209077
'src/generator.ml' is no more. Instead the generator is logically split up over many different source files. Read generator/README for help and tips. We compile the generator down to bytecode, not native code. This means it will run more slowly, but is done for maximum portability.
468 lines
15 KiB
OCaml
468 lines
15 KiB
OCaml
(* libguestfs
|
|
* Copyright (C) 2009-2010 Red Hat Inc.
|
|
*
|
|
* This program is free software; you can redistribute it and/or modify
|
|
* it under the terms of the GNU General Public License as published by
|
|
* the Free Software Foundation; either version 2 of the License, or
|
|
* (at your option) any later version.
|
|
*
|
|
* This program is distributed in the hope that it will be useful,
|
|
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
* GNU General Public License for more details.
|
|
*
|
|
* You should have received a copy of the GNU General Public License
|
|
* along with this program; if not, write to the Free Software
|
|
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
|
|
*)
|
|
|
|
(* Please read generator/README first. *)
|
|
|
|
open Printf
|
|
|
|
open Generator_types
|
|
open Generator_utils
|
|
open Generator_pr
|
|
open Generator_docstrings
|
|
open Generator_optgroups
|
|
open Generator_actions
|
|
open Generator_structs
|
|
open Generator_c
|
|
|
|
let rec generate_bindtests () =
|
|
generate_header CStyle LGPLv2plus;
|
|
|
|
pr "\
|
|
#include <stdio.h>
|
|
#include <stdlib.h>
|
|
#include <inttypes.h>
|
|
#include <string.h>
|
|
|
|
#include \"guestfs.h\"
|
|
#include \"guestfs-internal.h\"
|
|
#include \"guestfs-internal-actions.h\"
|
|
#include \"guestfs_protocol.h\"
|
|
|
|
#define error guestfs_error
|
|
#define safe_calloc guestfs_safe_calloc
|
|
#define safe_malloc guestfs_safe_malloc
|
|
|
|
static void
|
|
print_strings (char *const *argv)
|
|
{
|
|
size_t argc;
|
|
|
|
printf (\"[\");
|
|
for (argc = 0; argv[argc] != NULL; ++argc) {
|
|
if (argc > 0) printf (\", \");
|
|
printf (\"\\\"%%s\\\"\", argv[argc]);
|
|
}
|
|
printf (\"]\\n\");
|
|
}
|
|
|
|
/* The test0 function prints its parameters to stdout. */
|
|
";
|
|
|
|
let test0, tests =
|
|
match test_functions with
|
|
| [] -> assert false
|
|
| test0 :: tests -> test0, tests in
|
|
|
|
let () =
|
|
let (name, style, _, _, _, _, _) = test0 in
|
|
generate_prototype ~extern:false ~semicolon:false ~newline:true
|
|
~handle:"g" ~prefix:"guestfs__" name style;
|
|
pr "{\n";
|
|
List.iter (
|
|
function
|
|
| Pathname n
|
|
| Device n | Dev_or_Path n
|
|
| String n
|
|
| FileIn n
|
|
| FileOut n
|
|
| Key n -> pr " printf (\"%%s\\n\", %s);\n" n
|
|
| BufferIn n ->
|
|
pr " {\n";
|
|
pr " size_t i;\n";
|
|
pr " for (i = 0; i < %s_size; ++i)\n" n;
|
|
pr " printf (\"<%%02x>\", %s[i]);\n" n;
|
|
pr " printf (\"\\n\");\n";
|
|
pr " }\n";
|
|
| OptString n -> pr " printf (\"%%s\\n\", %s ? %s : \"null\");\n" n n
|
|
| StringList n | DeviceList n -> pr " print_strings (%s);\n" n
|
|
| Bool n -> pr " printf (\"%%s\\n\", %s ? \"true\" : \"false\");\n" n
|
|
| Int n -> pr " printf (\"%%d\\n\", %s);\n" n
|
|
| Int64 n -> pr " printf (\"%%\" PRIi64 \"\\n\", %s);\n" n
|
|
) (snd style);
|
|
pr " /* Java changes stdout line buffering so we need this: */\n";
|
|
pr " fflush (stdout);\n";
|
|
pr " return 0;\n";
|
|
pr "}\n";
|
|
pr "\n" in
|
|
|
|
List.iter (
|
|
fun (name, style, _, _, _, _, _) ->
|
|
if String.sub name (String.length name - 3) 3 <> "err" then (
|
|
pr "/* Test normal return. */\n";
|
|
generate_prototype ~extern:false ~semicolon:false ~newline:true
|
|
~handle:"g" ~prefix:"guestfs__" name style;
|
|
pr "{\n";
|
|
(match fst style with
|
|
| RErr ->
|
|
pr " return 0;\n"
|
|
| RInt _ ->
|
|
pr " int r;\n";
|
|
pr " sscanf (val, \"%%d\", &r);\n";
|
|
pr " return r;\n"
|
|
| RInt64 _ ->
|
|
pr " int64_t r;\n";
|
|
pr " sscanf (val, \"%%\" SCNi64, &r);\n";
|
|
pr " return r;\n"
|
|
| RBool _ ->
|
|
pr " return STREQ (val, \"true\");\n"
|
|
| RConstString _
|
|
| RConstOptString _ ->
|
|
(* Can't return the input string here. Return a static
|
|
* string so we ensure we get a segfault if the caller
|
|
* tries to free it.
|
|
*)
|
|
pr " return \"static string\";\n"
|
|
| RString _ ->
|
|
pr " return strdup (val);\n"
|
|
| RStringList _ ->
|
|
pr " char **strs;\n";
|
|
pr " int n, i;\n";
|
|
pr " sscanf (val, \"%%d\", &n);\n";
|
|
pr " strs = safe_malloc (g, (n+1) * sizeof (char *));\n";
|
|
pr " for (i = 0; i < n; ++i) {\n";
|
|
pr " strs[i] = safe_malloc (g, 16);\n";
|
|
pr " snprintf (strs[i], 16, \"%%d\", i);\n";
|
|
pr " }\n";
|
|
pr " strs[n] = NULL;\n";
|
|
pr " return strs;\n"
|
|
| RStruct (_, typ) ->
|
|
pr " struct guestfs_%s *r;\n" typ;
|
|
pr " r = safe_calloc (g, sizeof *r, 1);\n";
|
|
pr " return r;\n"
|
|
| RStructList (_, typ) ->
|
|
pr " struct guestfs_%s_list *r;\n" typ;
|
|
pr " r = safe_calloc (g, sizeof *r, 1);\n";
|
|
pr " sscanf (val, \"%%d\", &r->len);\n";
|
|
pr " r->val = safe_calloc (g, r->len, sizeof *r->val);\n";
|
|
pr " return r;\n"
|
|
| RHashtable _ ->
|
|
pr " char **strs;\n";
|
|
pr " int n, i;\n";
|
|
pr " sscanf (val, \"%%d\", &n);\n";
|
|
pr " strs = safe_malloc (g, (n*2+1) * sizeof (*strs));\n";
|
|
pr " for (i = 0; i < n; ++i) {\n";
|
|
pr " strs[i*2] = safe_malloc (g, 16);\n";
|
|
pr " strs[i*2+1] = safe_malloc (g, 16);\n";
|
|
pr " snprintf (strs[i*2], 16, \"%%d\", i);\n";
|
|
pr " snprintf (strs[i*2+1], 16, \"%%d\", i);\n";
|
|
pr " }\n";
|
|
pr " strs[n*2] = NULL;\n";
|
|
pr " return strs;\n"
|
|
| RBufferOut _ ->
|
|
pr " return strdup (val);\n"
|
|
);
|
|
pr "}\n";
|
|
pr "\n"
|
|
) else (
|
|
pr "/* Test error return. */\n";
|
|
generate_prototype ~extern:false ~semicolon:false ~newline:true
|
|
~handle:"g" ~prefix:"guestfs__" name style;
|
|
pr "{\n";
|
|
pr " error (g, \"error\");\n";
|
|
(match fst style with
|
|
| RErr | RInt _ | RInt64 _ | RBool _ ->
|
|
pr " return -1;\n"
|
|
| RConstString _ | RConstOptString _
|
|
| RString _ | RStringList _ | RStruct _
|
|
| RStructList _
|
|
| RHashtable _
|
|
| RBufferOut _ ->
|
|
pr " return NULL;\n"
|
|
);
|
|
pr "}\n";
|
|
pr "\n"
|
|
)
|
|
) tests
|
|
|
|
and generate_ocaml_bindtests () =
|
|
generate_header OCamlStyle GPLv2plus;
|
|
|
|
pr "\
|
|
let () =
|
|
let g = Guestfs.create () in
|
|
";
|
|
|
|
let mkargs args =
|
|
String.concat " " (
|
|
List.map (
|
|
function
|
|
| CallString s -> "\"" ^ s ^ "\""
|
|
| CallOptString None -> "None"
|
|
| CallOptString (Some s) -> sprintf "(Some \"%s\")" s
|
|
| CallStringList xs ->
|
|
"[|" ^ String.concat ";" (List.map (sprintf "\"%s\"") xs) ^ "|]"
|
|
| CallInt i when i >= 0 -> string_of_int i
|
|
| CallInt i (* when i < 0 *) -> "(" ^ string_of_int i ^ ")"
|
|
| CallInt64 i when i >= 0L -> Int64.to_string i ^ "L"
|
|
| CallInt64 i (* when i < 0L *) -> "(" ^ Int64.to_string i ^ "L)"
|
|
| CallBool b -> string_of_bool b
|
|
| CallBuffer s -> sprintf "%S" s
|
|
) args
|
|
)
|
|
in
|
|
|
|
generate_lang_bindtests (
|
|
fun f args -> pr " Guestfs.%s g %s;\n" f (mkargs args)
|
|
);
|
|
|
|
pr "print_endline \"EOF\"\n"
|
|
|
|
and generate_perl_bindtests () =
|
|
pr "#!/usr/bin/perl -w\n";
|
|
generate_header HashStyle GPLv2plus;
|
|
|
|
pr "\
|
|
use strict;
|
|
|
|
use Sys::Guestfs;
|
|
|
|
my $g = Sys::Guestfs->new ();
|
|
";
|
|
|
|
let mkargs args =
|
|
String.concat ", " (
|
|
List.map (
|
|
function
|
|
| CallString s -> "\"" ^ s ^ "\""
|
|
| CallOptString None -> "undef"
|
|
| CallOptString (Some s) -> sprintf "\"%s\"" s
|
|
| CallStringList xs ->
|
|
"[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
|
|
| CallInt i -> string_of_int i
|
|
| CallInt64 i -> Int64.to_string i
|
|
| CallBool b -> if b then "1" else "0"
|
|
| CallBuffer s -> "\"" ^ c_quote s ^ "\""
|
|
) args
|
|
)
|
|
in
|
|
|
|
generate_lang_bindtests (
|
|
fun f args -> pr "$g->%s (%s);\n" f (mkargs args)
|
|
);
|
|
|
|
pr "print \"EOF\\n\"\n"
|
|
|
|
and generate_python_bindtests () =
|
|
generate_header HashStyle GPLv2plus;
|
|
|
|
pr "\
|
|
import guestfs
|
|
|
|
g = guestfs.GuestFS ()
|
|
";
|
|
|
|
let mkargs args =
|
|
String.concat ", " (
|
|
List.map (
|
|
function
|
|
| CallString s -> "\"" ^ s ^ "\""
|
|
| CallOptString None -> "None"
|
|
| CallOptString (Some s) -> sprintf "\"%s\"" s
|
|
| CallStringList xs ->
|
|
"[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
|
|
| CallInt i -> string_of_int i
|
|
| CallInt64 i -> Int64.to_string i
|
|
| CallBool b -> if b then "1" else "0"
|
|
| CallBuffer s -> "\"" ^ c_quote s ^ "\""
|
|
) args
|
|
)
|
|
in
|
|
|
|
generate_lang_bindtests (
|
|
fun f args -> pr "g.%s (%s)\n" f (mkargs args)
|
|
);
|
|
|
|
pr "print \"EOF\"\n"
|
|
|
|
and generate_ruby_bindtests () =
|
|
generate_header HashStyle GPLv2plus;
|
|
|
|
pr "\
|
|
require 'guestfs'
|
|
|
|
g = Guestfs::create()
|
|
";
|
|
|
|
let mkargs args =
|
|
String.concat ", " (
|
|
List.map (
|
|
function
|
|
| CallString s -> "\"" ^ s ^ "\""
|
|
| CallOptString None -> "nil"
|
|
| CallOptString (Some s) -> sprintf "\"%s\"" s
|
|
| CallStringList xs ->
|
|
"[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
|
|
| CallInt i -> string_of_int i
|
|
| CallInt64 i -> Int64.to_string i
|
|
| CallBool b -> string_of_bool b
|
|
| CallBuffer s -> "\"" ^ c_quote s ^ "\""
|
|
) args
|
|
)
|
|
in
|
|
|
|
generate_lang_bindtests (
|
|
fun f args -> pr "g.%s(%s)\n" f (mkargs args)
|
|
);
|
|
|
|
pr "print \"EOF\\n\"\n"
|
|
|
|
and generate_java_bindtests () =
|
|
generate_header CStyle GPLv2plus;
|
|
|
|
pr "\
|
|
import com.redhat.et.libguestfs.*;
|
|
|
|
public class Bindtests {
|
|
public static void main (String[] argv)
|
|
{
|
|
try {
|
|
GuestFS g = new GuestFS ();
|
|
";
|
|
|
|
let mkargs args =
|
|
String.concat ", " (
|
|
List.map (
|
|
function
|
|
| CallString s -> "\"" ^ s ^ "\""
|
|
| CallOptString None -> "null"
|
|
| CallOptString (Some s) -> sprintf "\"%s\"" s
|
|
| CallStringList xs ->
|
|
"new String[]{" ^
|
|
String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "}"
|
|
| CallInt i -> string_of_int i
|
|
| CallInt64 i -> Int64.to_string i
|
|
| CallBool b -> string_of_bool b
|
|
| CallBuffer s ->
|
|
"new byte[] { " ^ String.concat "," (
|
|
map_chars (fun c -> string_of_int (Char.code c)) s
|
|
) ^ " }"
|
|
) args
|
|
)
|
|
in
|
|
|
|
generate_lang_bindtests (
|
|
fun f args -> pr " g.%s (%s);\n" f (mkargs args)
|
|
);
|
|
|
|
pr "
|
|
System.out.println (\"EOF\");
|
|
}
|
|
catch (Exception exn) {
|
|
System.err.println (exn);
|
|
System.exit (1);
|
|
}
|
|
}
|
|
}
|
|
"
|
|
|
|
and generate_haskell_bindtests () =
|
|
generate_header HaskellStyle GPLv2plus;
|
|
|
|
pr "\
|
|
module Bindtests where
|
|
import qualified Guestfs
|
|
|
|
main = do
|
|
g <- Guestfs.create
|
|
";
|
|
|
|
let mkargs args =
|
|
String.concat " " (
|
|
List.map (
|
|
function
|
|
| CallString s -> "\"" ^ s ^ "\""
|
|
| CallOptString None -> "Nothing"
|
|
| CallOptString (Some s) -> sprintf "(Just \"%s\")" s
|
|
| CallStringList xs ->
|
|
"[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
|
|
| CallInt i when i < 0 -> "(" ^ string_of_int i ^ ")"
|
|
| CallInt i -> string_of_int i
|
|
| CallInt64 i when i < 0L -> "(" ^ Int64.to_string i ^ ")"
|
|
| CallInt64 i -> Int64.to_string i
|
|
| CallBool true -> "True"
|
|
| CallBool false -> "False"
|
|
| CallBuffer s -> "\"" ^ c_quote s ^ "\""
|
|
) args
|
|
)
|
|
in
|
|
|
|
generate_lang_bindtests (
|
|
fun f args -> pr " Guestfs.%s g %s\n" f (mkargs args)
|
|
);
|
|
|
|
pr " putStrLn \"EOF\"\n"
|
|
|
|
(* Language-independent bindings tests - we do it this way to
|
|
* ensure there is parity in testing bindings across all languages.
|
|
*)
|
|
and generate_lang_bindtests call =
|
|
call "test0" [CallString "abc"; CallOptString (Some "def");
|
|
CallStringList []; CallBool false;
|
|
CallInt 0; CallInt64 0L; CallString "123"; CallString "456";
|
|
CallBuffer "abc\000abc"];
|
|
call "test0" [CallString "abc"; CallOptString None;
|
|
CallStringList []; CallBool false;
|
|
CallInt 0; CallInt64 0L; CallString "123"; CallString "456";
|
|
CallBuffer "abc\000abc"];
|
|
call "test0" [CallString ""; CallOptString (Some "def");
|
|
CallStringList []; CallBool false;
|
|
CallInt 0; CallInt64 0L; CallString "123"; CallString "456";
|
|
CallBuffer "abc\000abc"];
|
|
call "test0" [CallString ""; CallOptString (Some "");
|
|
CallStringList []; CallBool false;
|
|
CallInt 0; CallInt64 0L; CallString "123"; CallString "456";
|
|
CallBuffer "abc\000abc"];
|
|
call "test0" [CallString "abc"; CallOptString (Some "def");
|
|
CallStringList ["1"]; CallBool false;
|
|
CallInt 0; CallInt64 0L; CallString "123"; CallString "456";
|
|
CallBuffer "abc\000abc"];
|
|
call "test0" [CallString "abc"; CallOptString (Some "def");
|
|
CallStringList ["1"; "2"]; CallBool false;
|
|
CallInt 0; CallInt64 0L; CallString "123"; CallString "456";
|
|
CallBuffer "abc\000abc"];
|
|
call "test0" [CallString "abc"; CallOptString (Some "def");
|
|
CallStringList ["1"]; CallBool true;
|
|
CallInt 0; CallInt64 0L; CallString "123"; CallString "456";
|
|
CallBuffer "abc\000abc"];
|
|
call "test0" [CallString "abc"; CallOptString (Some "def");
|
|
CallStringList ["1"]; CallBool false;
|
|
CallInt (-1); CallInt64 (-1L); CallString "123"; CallString "456";
|
|
CallBuffer "abc\000abc"];
|
|
call "test0" [CallString "abc"; CallOptString (Some "def");
|
|
CallStringList ["1"]; CallBool false;
|
|
CallInt (-2); CallInt64 (-2L); CallString "123"; CallString "456";
|
|
CallBuffer "abc\000abc"];
|
|
call "test0" [CallString "abc"; CallOptString (Some "def");
|
|
CallStringList ["1"]; CallBool false;
|
|
CallInt 1; CallInt64 1L; CallString "123"; CallString "456";
|
|
CallBuffer "abc\000abc"];
|
|
call "test0" [CallString "abc"; CallOptString (Some "def");
|
|
CallStringList ["1"]; CallBool false;
|
|
CallInt 2; CallInt64 2L; CallString "123"; CallString "456";
|
|
CallBuffer "abc\000abc"];
|
|
call "test0" [CallString "abc"; CallOptString (Some "def");
|
|
CallStringList ["1"]; CallBool false;
|
|
CallInt 4095; CallInt64 4095L; CallString "123"; CallString "456";
|
|
CallBuffer "abc\000abc"];
|
|
call "test0" [CallString "abc"; CallOptString (Some "def");
|
|
CallStringList ["1"]; CallBool false;
|
|
CallInt 0; CallInt64 0L; CallString ""; CallString "";
|
|
CallBuffer "abc\000abc"]
|
|
|
|
(* XXX Add here tests of the return and error functions. *)
|