4:16 a.m.
Previously, optional arguments had the same type as regular arguments, but were
constrained by various runtime tests to be only Bool, Int, Int64 or String. This
change makes the type of optional arguments stronger by giving them their own
type.
A convenience function, optargs_to_args is defined to convert optargs in the few
places where they are genuinely treated identically to mandatory arguments.
It also allows for future changes to optional arguments which do not affect
mandatory arguments.
---
generator/generator_actions.ml | 30 ++++++++--------
generator/generator_c.ml | 63 ++++++++++++++++--------------------
generator/generator_checks.ml | 19 +----------
generator/generator_daemon.ml | 10 +++---
generator/generator_erlang.ml | 18 ++++------
generator/generator_fish.ml | 25 ++++++--------
generator/generator_java.ml | 43 ++++++++++---------------
generator/generator_ocaml.ml | 30 +++++++----------
generator/generator_perl.ml | 15 ++++----
generator/generator_php.ml | 28 +++++++---------
generator/generator_python.ml | 34 ++++++++-----------
generator/generator_ruby.ml | 11 +++---
generator/generator_tests_c_api.ml | 23 ++++++-------
generator/generator_types.ml | 10 +++++-
generator/generator_utils.ml | 12 +++++++
generator/generator_utils.mli | 6 +++
generator/generator_xdr.ml | 2 +-
17 files changed, 176 insertions(+), 203 deletions(-)
diff --git a/generator/generator_actions.ml b/generator/generator_actions.ml
index 7a5d786..fb82bb6 100644
--- a/generator/generator_actions.ml
+++ b/generator/generator_actions.ml
@@ -1011,7 +1011,7 @@ be mountable but require special options. Filesystems may
not all belong to a single logical operating system
(use C<guestfs_inspect_os> to look for OSes).");
- ("add_drive_opts", (RErr, [String "filename"], [Bool
"readonly"; String "format"; String "iface"; String
"name"]), -1, [FishAlias "add"],
+ ("add_drive_opts", (RErr, [String "filename"], [OBool
"readonly"; OString "format"; OString "iface"; OString
"name"]), -1, [FishAlias "add"],
[],
"add an image to examine or modify",
"\
@@ -1101,7 +1101,7 @@ not part of the formal API and can be removed or changed at any
time.");
This returns the internal list of drives. 'debug' commands are
not part of the formal API and can be removed or changed at any time.");
- ("add_domain", (RInt "nrdisks", [String "dom"], [String
"libvirturi"; Bool "readonly"; String "iface"; Bool
"live"; Bool "allowuuid"; String "readonlydisk"]), -1,
[FishAlias "domain"],
+ ("add_domain", (RInt "nrdisks", [String "dom"], [OString
"libvirturi"; OBool "readonly"; OString "iface"; OBool
"live"; OBool "allowuuid"; OString "readonlydisk"]), -1,
[FishAlias "domain"],
[],
"add the disk(s) from a named libvirt domain",
"\
@@ -1545,7 +1545,7 @@ Please read L<guestfs(3)/INSPECTION> for more details.
See also C<guestfs_inspect_get_mountpoints>,
C<guestfs_inspect_get_filesystems>.");
- ("inspect_get_icon", (RBufferOut "icon", [Device "root"],
[Bool "favicon"; Bool "highquality"]), -1, [],
+ ("inspect_get_icon", (RBufferOut "icon", [Device "root"],
[OBool "favicon"; OBool "highquality"]), -1, [],
[],
"get the icon corresponding to this operating system",
"\
@@ -6029,7 +6029,7 @@ not refer to a logical volume.
See also C<guestfs_is_lv>.");
- ("mkfs_opts", (RErr, [String "fstype"; Device "device"],
[Int "blocksize"; String "features"; Int "inode"; Int
"sectorsize"]), 278, [],
+ ("mkfs_opts", (RErr, [String "fstype"; Device "device"],
[OInt "blocksize"; OString "features"; OInt "inode"; OInt
"sectorsize"]), 278, [],
[InitEmpty, Always, TestOutput (
[["part_disk"; "/dev/sda"; "mbr"];
["mkfs_opts"; "ext2"; "/dev/sda1"; "";
"NOARG"; ""; ""];
@@ -6172,7 +6172,7 @@ Note that for large devices this can take a long time to
run.");
List all 9p filesystems attached to the guest. A list of
mount tags is returned.");
- ("mount_9p", (RErr, [String "mounttag"; String
"mountpoint"], [String "options"]), 286, [],
+ ("mount_9p", (RErr, [String "mounttag"; String
"mountpoint"], [OString "options"]), 286, [],
[],
"mount 9p filesystem",
"\
@@ -6196,7 +6196,7 @@ Device mapper devices which correspond to logical volumes are
I<not>
returned in this list. Call C<guestfs_lvs> if you want to list logical
volumes.");
- ("ntfsresize_opts", (RErr, [Device "device"], [Int64
"size"; Bool "force"]), 288, [Optional "ntfsprogs"],
+ ("ntfsresize_opts", (RErr, [Device "device"], [OInt64
"size"; OBool "force"]), 288, [Optional "ntfsprogs"],
[],
"resize an NTFS filesystem",
"\
@@ -6228,7 +6228,7 @@ single filesystem without booting into Windows between each resize.
See also L<ntfsresize(8)>.");
- ("btrfs_filesystem_resize", (RErr, [Pathname "mountpoint"], [Int64
"size"]), 289, [Optional "btrfs"],
+ ("btrfs_filesystem_resize", (RErr, [Pathname "mountpoint"], [OInt64
"size"]), 289, [Optional "btrfs"],
[],
"resize a btrfs filesystem",
"\
@@ -6265,7 +6265,7 @@ C<path> does not exist, then a new file is created.
See also C<guestfs_write>.");
- ("compress_out", (RErr, [String "ctype"; Pathname "file";
FileOut "zfile"], [Int "level"]), 291, [],
+ ("compress_out", (RErr, [String "ctype"; Pathname "file";
FileOut "zfile"], [OInt "level"]), 291, [],
[],
"output compressed file",
"\
@@ -6282,7 +6282,7 @@ The optional C<level> parameter controls compression level.
The
meaning and default for this parameter depends on the compression
program being used.");
- ("compress_device_out", (RErr, [String "ctype"; Device
"device"; FileOut "zdevice"], [Int "level"]), 292, [],
+ ("compress_device_out", (RErr, [String "ctype"; Device
"device"; FileOut "zdevice"], [OInt "level"]), 292, [],
[],
"output compressed device",
"\
@@ -6307,7 +6307,7 @@ from C<guestfs_list_partitions>.
See also C<guestfs_part_to_dev>.");
- ("copy_device_to_device", (RErr, [Device "src"; Device
"dest"], [Int64 "srcoffset"; Int64 "destoffset"; Int64
"size"]), 294, [Progress],
+ ("copy_device_to_device", (RErr, [Device "src"; Device
"dest"], [OInt64 "srcoffset"; OInt64 "destoffset"; OInt64
"size"]), 294, [Progress],
[],
"copy from source device to destination device",
"\
@@ -6330,21 +6330,21 @@ overlapping regions may not be copied correctly.
If the destination is a file, it is created if required. If
the destination file is not large enough, it is extended.");
- ("copy_device_to_file", (RErr, [Device "src"; Pathname
"dest"], [Int64 "srcoffset"; Int64 "destoffset"; Int64
"size"]), 295, [Progress],
+ ("copy_device_to_file", (RErr, [Device "src"; Pathname
"dest"], [OInt64 "srcoffset"; OInt64 "destoffset"; OInt64
"size"]), 295, [Progress],
[],
"copy from source device to destination file",
"\
See C<guestfs_copy_device_to_device> for a general overview
of this call.");
- ("copy_file_to_device", (RErr, [Pathname "src"; Device
"dest"], [Int64 "srcoffset"; Int64 "destoffset"; Int64
"size"]), 296, [Progress],
+ ("copy_file_to_device", (RErr, [Pathname "src"; Device
"dest"], [OInt64 "srcoffset"; OInt64 "destoffset"; OInt64
"size"]), 296, [Progress],
[],
"copy from source file to destination device",
"\
See C<guestfs_copy_device_to_device> for a general overview
of this call.");
- ("copy_file_to_file", (RErr, [Pathname "src"; Pathname
"dest"], [Int64 "srcoffset"; Int64 "destoffset"; Int64
"size"]), 297, [Progress],
+ ("copy_file_to_file", (RErr, [Pathname "src"; Pathname
"dest"], [OInt64 "srcoffset"; OInt64 "destoffset"; OInt64
"size"]), 297, [Progress],
[InitScratchFS, Always, TestOutputBuffer (
[["mkdir"; "/copyff"];
["write"; "/copyff/src"; "hello, world"];
@@ -6360,7 +6360,7 @@ is for copying blocks within existing files. See
C<guestfs_cp>,
C<guestfs_cp_a> and C<guestfs_mv> for general file copying and
moving functions.");
- ("tune2fs", (RErr, [Device "device"], [Bool "force"; Int
"maxmountcount"; Int "mountcount"; String "errorbehavior";
Int64 "group"; Int "intervalbetweenchecks"; Int
"reservedblockspercentage"; String "lastmounteddirectory"; Int64
"reservedblockscount"; Int64 "user"]), 298, [],
+ ("tune2fs", (RErr, [Device "device"], [OBool "force";
OInt "maxmountcount"; OInt "mountcount"; OString
"errorbehavior"; OInt64 "group"; OInt
"intervalbetweenchecks"; OInt "reservedblockspercentage"; OString
"lastmounteddirectory"; OInt64 "reservedblockscount"; OInt64
"user"]), 298, [],
[InitScratchFS, Always, TestOutputHashtable (
[["tune2fs"; "/dev/sdb1"; "false"; "0";
""; "NOARG"; ""; "0"; "";
"NOARG"; ""; ""];
["tune2fs_l"; "/dev/sdb1"]],
@@ -6457,7 +6457,7 @@ To get the current values of filesystem parameters, see
C<guestfs_tune2fs_l>. For precise details of how tune2fs
works, see the L<tune2fs(8)> man page.");
- ("md_create", (RErr, [String "name"; DeviceList
"devices"], [Int64 "missingbitmap"; Int "nrdevices"; Int
"spare"; Int64 "chunk"; String "level"]), 299, [Optional
"mdadm"],
+ ("md_create", (RErr, [String "name"; DeviceList
"devices"], [OInt64 "missingbitmap"; OInt "nrdevices"; OInt
"spare"; OInt64 "chunk"; OString "level"]), 299, [Optional
"mdadm"],
[],
"create a Linux md (RAID) device",
"\
diff --git a/generator/generator_c.ml b/generator/generator_c.ml
index b392809..8fa3486 100644
--- a/generator/generator_c.ml
+++ b/generator/generator_c.ml
@@ -193,15 +193,14 @@ and generate_actions_pod () =
pr "See L</CALLS WITH OPTIONAL ARGUMENTS>.\n\n";
List.iter (
fun argt ->
- let n = name_of_argt argt in
+ let n = name_of_optargt argt in
let uc_n = String.uppercase n in
pr " GUESTFS_%s_%s, " uc_shortname uc_n;
match argt with
- | Bool n -> pr "int %s,\n" n
- | Int n -> pr "int %s,\n" n
- | Int64 n -> pr "int64_t %s,\n" n
- | String n -> pr "const char *%s,\n" n
- | _ -> assert false
+ | OBool n -> pr "int %s,\n" n
+ | OInt n -> pr "int %s,\n" n
+ | OInt64 n -> pr "int64_t %s,\n" n
+ | OString n -> pr "const char *%s,\n" n
) optargs;
pr "\n";
);
@@ -254,7 +253,7 @@ I<The caller must free the returned buffer after
use>.\n\n"
pr "%s\n\n" progress_message;
if List.mem ProtocolLimitWarning flags then
pr "%s\n\n" protocol_limit_warning;
- if List.exists (function Key _ -> true | _ -> false) (args@optargs) then
+ if List.exists (function Key _ -> true | _ -> false) (args) then
pr "This function takes a key or passphrase parameter which
could contain sensitive material. Read the section
L</KEYS AND PASSPHRASES> for more information.\n\n";
@@ -564,7 +563,7 @@ extern void *guestfs_next_private (guestfs_h *g, const char
**key_rtn);
iteri (
fun i argt ->
let uc_shortname = String.uppercase shortname in
- let n = name_of_argt argt in
+ let n = name_of_optargt argt in
let uc_n = String.uppercase n in
pr "#define GUESTFS_%s_%s %d\n" uc_shortname uc_n i;
) optargs;
@@ -589,13 +588,12 @@ extern void *guestfs_next_private (guestfs_h *g, const char
**key_rtn);
fun i argt ->
let c_type =
match argt with
- | Bool n -> "int "
- | Int n -> "int "
- | Int64 n -> "int64_t "
- | String n -> "const char *"
- | _ -> assert false (* checked in generator_checks *) in
+ | OBool n -> "int "
+ | OInt n -> "int "
+ | OInt64 n -> "int64_t "
+ | OString n -> "const char *" in
let uc_shortname = String.uppercase shortname in
- let n = name_of_argt argt in
+ let n = name_of_optargt argt in
let uc_n = String.uppercase n in
pr "\n";
pr "# define GUESTFS_%s_%s_BITMASK (UINT64_C(1)<<%d)\n"
uc_shortname uc_n i;
@@ -811,7 +809,7 @@ trace_send_line (guestfs_h *g)
(* For optional arguments. *)
List.iter (
function
- | String n ->
+ | OString n ->
pr " if ((optargs->bitmask & GUESTFS_%s_%s_BITMASK)
&&\n"
(String.uppercase shortname) (String.uppercase n);
pr " optargs->%s == NULL) {\n" n;
@@ -826,9 +824,7 @@ trace_send_line (guestfs_h *g)
pr_newline := true
(* not applicable *)
- | Bool _ | Int _ | Int64 _ -> ()
-
- | _ -> assert false
+ | OBool _ | OInt _ | OInt64 _ -> ()
) optargs;
if !pr_newline then pr "\n";
@@ -911,21 +907,20 @@ trace_send_line (guestfs_h *g)
(* Optional arguments. *)
List.iter (
fun argt ->
- let n = name_of_argt argt in
+ let n = name_of_optargt argt in
let uc_shortname = String.uppercase shortname in
let uc_n = String.uppercase n in
pr " if (optargs->bitmask & GUESTFS_%s_%s_BITMASK)\n"
uc_shortname uc_n;
(match argt with
- | String n ->
+ | OString n ->
pr " fprintf (trace_fp, \" \\\"%%s:%%s\\\"\",
\"%s\", optargs->%s);\n" n n
- | Bool n ->
+ | OBool n ->
pr " fprintf (trace_fp, \" \\\"%%s:%%s\\\"\",
\"%s\", optargs->%s ? \"true\" : \"false\");\n" n n
- | Int n ->
+ | OInt n ->
pr " fprintf (trace_fp, \" \\\"%%s:%%d\\\"\",
\"%s\", optargs->%s);\n" n n
- | Int64 n ->
+ | OInt64 n ->
pr " fprintf (trace_fp, \" \\\"%%s:%%\" PRIi64
\"\\\"\", \"%s\", optargs->%s);\n" n n
- | _ -> assert false
);
) optargs;
@@ -1189,23 +1184,22 @@ trace_send_line (guestfs_h *g)
List.iter (
fun argt ->
- let n = name_of_argt argt in
+ let n = name_of_optargt argt in
let uc_shortname = String.uppercase shortname in
let uc_n = String.uppercase n in
pr " if ((optargs->bitmask & GUESTFS_%s_%s_BITMASK))\n"
uc_shortname uc_n;
(match argt with
- | Bool n
- | Int n
- | Int64 n ->
+ | OBool n
+ | OInt n
+ | OInt64 n ->
pr " args.%s = optargs->%s;\n" n n;
pr " else\n";
pr " args.%s = 0;\n" n
- | String n ->
+ | OString n ->
pr " args.%s = (char *) optargs->%s;\n" n n;
pr " else\n";
pr " args.%s = (char *) \"\";\n" n
- | _ -> assert false
)
) optargs;
@@ -1432,15 +1426,14 @@ trace_send_line (guestfs_h *g)
List.iter (
fun argt ->
- let n = name_of_argt argt in
+ let n = name_of_optargt argt in
let uc_n = String.uppercase n in
pr " case GUESTFS_%s_%s:\n" uc_shortname uc_n;
pr " optargs_s.%s = va_arg (args, " n;
(match argt with
- | Bool _ | Int _ -> pr "int"
- | Int64 _ -> pr "int64_t"
- | String _ -> pr "const char *"
- | _ -> assert false
+ | OBool _ | OInt _ -> pr "int"
+ | OInt64 _ -> pr "int64_t"
+ | OString _ -> pr "const char *"
);
pr ");\n";
pr " break;\n";
diff --git a/generator/generator_checks.ml b/generator/generator_checks.ml
index 11fc9cb..e651c75 100644
--- a/generator/generator_checks.ml
+++ b/generator/generator_checks.ml
@@ -112,26 +112,12 @@ let () =
check_arg_ret_name n
);
List.iter (fun arg -> check_arg_ret_name (name_of_argt arg)) args;
- List.iter (fun arg -> check_arg_ret_name (name_of_argt arg)) optargs;
- ) all_functions;
-
- (* Check only certain types allowed in optargs. *)
- List.iter (
- fun (name, (_, _, optargs), _, _, _, _, _) ->
- if List.length optargs > 64 then
- failwithf "maximum of 64 optional args allowed for %s" name;
-
- List.iter (
- function
- | Bool _ | Int _ | Int64 _ | String _ -> ()
- | _ ->
- failwithf "optional args of %s can only have type
Bool|Int|Int64|String" name
- ) optargs
+ List.iter (fun arg -> check_arg_ret_name (name_of_optargt arg)) optargs;
) all_functions;
(* Some parameter types not supported for daemon functions. *)
List.iter (
- fun (name, (_, args, optargs), _, _, _, _, _) ->
+ fun (name, (_, args, _), _, _, _, _, _) ->
let check_arg_type = function
| Pointer _ ->
failwithf "Pointer is not supported for daemon function %s."
@@ -139,7 +125,6 @@ let () =
| _ -> ()
in
List.iter check_arg_type args;
- List.iter check_arg_type optargs;
) daemon_functions;
(* Check short descriptions. *)
diff --git a/generator/generator_daemon.ml b/generator/generator_daemon.ml
index 7537716..cec596c 100644
--- a/generator/generator_daemon.ml
+++ b/generator/generator_daemon.ml
@@ -42,7 +42,7 @@ let generate_daemon_actions_h () =
iteri (
fun i arg ->
let uc_shortname = String.uppercase shortname in
- let n = name_of_argt arg in
+ let n = name_of_optargt arg in
let uc_n = String.uppercase n in
pr "#define GUESTFS_%s_%s_BITMASK (UINT64_C(1)<<%d)\n"
uc_shortname uc_n i
@@ -52,7 +52,7 @@ let generate_daemon_actions_h () =
List.iter (
fun (name, (ret, args, optargs), _, _, _, _, _) ->
- let style = ret, args @ optargs, [] in
+ let style = ret, args @ (optargs_to_args optargs), [] in
generate_prototype
~single_line:true ~newline:true ~in_daemon:true ~prefix:"do_"
name style;
@@ -115,7 +115,7 @@ and generate_daemon_actions () =
pr " const char *%s;\n" n;
pr " size_t %s_size;\n" n
| Pointer _ -> assert false
- ) (args @ optargs)
+ ) (args @ (optargs_to_args optargs))
);
pr "\n";
@@ -208,7 +208,7 @@ and generate_daemon_actions () =
pr " %s = args.%s.%s_val;\n" n n n;
pr " %s_size = args.%s.%s_len;\n" n n n
| Pointer _ -> assert false
- ) (args @ optargs);
+ ) (args @ (optargs_to_args optargs));
pr "\n"
);
@@ -227,7 +227,7 @@ and generate_daemon_actions () =
let args' =
List.filter
(function FileIn _ | FileOut _ -> false | _ -> true) args in
- let style = ret, args' @ optargs, [] in
+ let style = ret, args' @ (optargs_to_args optargs), [] in
pr " r = do_%s " name;
generate_c_call_args style;
pr ";\n" in
diff --git a/generator/generator_erlang.ml b/generator/generator_erlang.ml
index d166ef2..6f8cd4b 100644
--- a/generator/generator_erlang.ml
+++ b/generator/generator_erlang.ml
@@ -284,17 +284,16 @@ extern void free_strings (char **r);
pr "\n";
List.iter (
fun argt ->
- let n = name_of_argt argt in
+ let n = name_of_optargt argt in
let uc_n = String.uppercase n in
pr " if (atom_equals (hd_name, \"%s\")) {\n" n;
pr " optargs_s.bitmask |= GUESTFS_%s_%s_BITMASK;\n" uc_name
uc_n;
pr " optargs_s.%s = " n;
(match argt with
- | Bool _ -> pr "get_bool (hd_value)"
- | Int _ -> pr "ERL_INT_VALUE (hd_value)"
- | Int64 _ -> pr "ERL_LL_VALUE (hd_value)"
- | String _ -> pr "erl_iolist_to_string (hd_value)"
- | _ -> assert false
+ | OBool _ -> pr "get_bool (hd_value)"
+ | OInt _ -> pr "ERL_INT_VALUE (hd_value)"
+ | OInt64 _ -> pr "ERL_LL_VALUE (hd_value)"
+ | OString _ -> pr "erl_iolist_to_string (hd_value)"
);
pr ";\n";
pr " }\n";
@@ -349,15 +348,12 @@ extern void free_strings (char **r);
) args;
List.iter (
function
- | String n ->
+ | OBool _ | OInt _ | OInt64 _ -> ()
+ | OString n ->
let uc_n = String.uppercase n in
pr " if ((optargs_s.bitmask & GUESTFS_%s_%s_BITMASK))\n"
uc_name uc_n;
pr " free ((char *) optargs_s.%s);\n" n
- | Bool _ | Int _ | Int64 _
- | Pathname _ | Device _ | Dev_or_Path _ | OptString _
- | FileIn _ | FileOut _ | BufferIn _ | Key _
- | StringList _ | DeviceList _ | Pointer _ -> ()
) optargs;
(match errcode_of_ret ret with
diff --git a/generator/generator_fish.ml b/generator/generator_fish.ml
index 53e4fd5..175f8dc 100644
--- a/generator/generator_fish.ml
+++ b/generator/generator_fish.ml
@@ -32,11 +32,10 @@ open Generator_c
open Generator_events
let doc_opttype_of = function
- | Bool n -> "true|false"
- | Int n
- | Int64 n -> "N"
- | String n -> ".."
- | _ -> assert false
+ | OBool n -> "true|false"
+ | OInt n
+ | OInt64 n -> "N"
+ | OString n -> ".."
(* Generate a lot of different functions for guestfish. *)
let generate_fish_cmds () =
@@ -131,7 +130,7 @@ let generate_fish_cmds () =
(List.map (fun arg -> " " ^ name_of_argt arg) args))
(String.concat ""
(List.map (fun arg ->
- sprintf " [%s:%s]" (name_of_argt arg) (doc_opttype_of arg)
+ sprintf " [%s:%s]" (name_of_optargt arg) (doc_opttype_of
arg)
) optargs)) in
let warnings =
@@ -457,15 +456,15 @@ Guestfish will prompt for these separately."
pr " ";
List.iter (
fun argt ->
- let n = name_of_argt argt in
+ let n = name_of_optargt argt in
let uc_n = String.uppercase n in
let len = String.length n in
pr "if (STRPREFIX (argv[i], \"%s:\")) {\n" n;
(match argt with
- | Bool n ->
+ | OBool n ->
pr " optargs_s.%s = is_true (&argv[i][%d]) ? 1 :
0;\n"
n (len+1);
- | Int n ->
+ | OInt n ->
let range =
let min = "(-(2LL<<30))"
and max = "((2LL<<30)-1)"
@@ -475,13 +474,12 @@ Guestfish will prompt for these separately."
let expr = sprintf "&argv[i][%d]" (len+1) in
parse_integer expr "xstrtoll" "long long"
"int" range
(sprintf "optargs_s.%s" n)
- | Int64 n ->
+ | OInt64 n ->
let expr = sprintf "&argv[i][%d]" (len+1) in
parse_integer expr "xstrtoll" "long long"
"int64_t" None
(sprintf "optargs_s.%s" n)
- | String n ->
+ | OString n ->
pr " optargs_s.%s = &argv[i][%d];\n" n (len+1);
- | _ -> assert false
);
pr " this_mask = GUESTFS_%s_%s_BITMASK;\n" uc_name uc_n;
pr " this_arg = \"%s\";\n" n;
@@ -851,9 +849,8 @@ and generate_fish_actions_pod () =
) args;
List.iter (
function
- | (Bool n | Int n | Int64 n | String n) as arg ->
+ | (OBool n | OInt n | OInt64 n | OString n) as arg ->
pr " [%s:%s]" n (doc_opttype_of arg)
- | _ -> assert false
) optargs;
pr "\n";
pr "\n";
diff --git a/generator/generator_java.ml b/generator/generator_java.ml
index 69d5e24..16fb853 100644
--- a/generator/generator_java.ml
+++ b/generator/generator_java.ml
@@ -147,11 +147,10 @@ public class GuestFS {
fun i argt ->
let t, boxed_t, convert, n, default =
match argt with
- | Bool n -> "boolean", "Boolean",
".booleanValue()", n, "false"
- | Int n -> "int", "Integer",
".intValue()", n, "0"
- | Int64 n -> "long", "Long",
".longValue()", n, "0"
- | String n -> "String", "String", "", n,
"\"\""
- | _ -> assert false in
+ | OBool n -> "boolean", "Boolean",
".booleanValue()", n, "false"
+ | OInt n -> "int", "Integer",
".intValue()", n, "0"
+ | OInt64 n -> "long", "Long",
".longValue()", n, "0"
+ | OString n -> "String", "String", "", n,
"\"\"" in
pr " %s %s = %s;\n" t n default;
pr " _optobj = null;\n";
pr " if (optargs != null)\n";
@@ -199,7 +198,7 @@ and generate_java_call_args ~handle (_, args, optargs) =
List.iter (fun arg -> pr ", %s" (name_of_argt arg)) args;
if optargs <> [] then (
pr ", _optargs_bitmask";
- List.iter (fun arg -> pr ", %s" (name_of_argt arg)) optargs
+ List.iter (fun arg -> pr ", %s" (name_of_optargt arg)) optargs
);
pr ")"
@@ -277,11 +276,10 @@ and generate_java_prototype ?(public=false) ?(privat=false)
?(native=false)
List.iter (
fun argt ->
match argt with
- | Bool n -> pr ", boolean %s" n
- | Int n -> pr ", int %s" n
- | Int64 n -> pr ", long %s" n
- | String n -> pr ", String %s" n
- | _ -> assert false
+ | OBool n -> pr ", boolean %s" n
+ | OInt n -> pr ", int %s" n
+ | OInt64 n -> pr ", long %s" n
+ | OString n -> pr ", String %s" n
) optargs
)
);
@@ -412,11 +410,10 @@ Java_com_redhat_et_libguestfs_GuestFS__1close
pr ", jlong joptargs_bitmask";
List.iter (
function
- | Bool n -> pr ", jboolean j%s" n
- | Int n -> pr ", jint j%s" n
- | Int64 n -> pr ", jlong j%s" n
- | String n -> pr ", jstring j%s" n
- | _ -> assert false
+ | OBool n -> pr ", jboolean j%s" n
+ | OInt n -> pr ", jint j%s" n
+ | OInt64 n -> pr ", jlong j%s" n
+ | OString n -> pr ", jstring j%s" n
) optargs
);
pr ")\n";
@@ -540,14 +537,11 @@ Java_com_redhat_et_libguestfs_GuestFS__1close
pr " optargs_s.bitmask = joptargs_bitmask;\n";
List.iter (
function
- | Bool n
- | Int n
- | Int64 n ->
+ | OBool n | OInt n | OInt64 n ->
pr " optargs_s.%s = j%s;\n" n n
- | String n ->
+ | OString n ->
pr " optargs_s.%s = (*env)->GetStringUTFChars (env, j%s,
NULL);\n"
n n
- | _ -> assert false
) optargs;
);
@@ -593,12 +587,9 @@ Java_com_redhat_et_libguestfs_GuestFS__1close
List.iter (
function
- | Bool n
- | Int n
- | Int64 n -> ()
- | String n ->
+ | OBool n | OInt n | OInt64 n -> ()
+ | OString n ->
pr " (*env)->ReleaseStringUTFChars (env, j%s, optargs_s.%s);\n"
n n
- | _ -> assert false
) optargs;
pr "\n";
diff --git a/generator/generator_ocaml.ml b/generator/generator_ocaml.ml
index 10c18e3..f1f5896 100644
--- a/generator/generator_ocaml.ml
+++ b/generator/generator_ocaml.ml
@@ -424,7 +424,8 @@ copy_table (char * const * argv)
let params =
"gv" ::
- List.map (fun arg -> name_of_argt arg ^ "v") (optargs @ args) in
+ List.map (fun arg -> name_of_argt arg ^ "v")
+ ((optargs_to_args optargs) @ args) in
let needs_extra_vs =
match ret with RConstOptString _ -> true | _ -> false in
@@ -507,18 +508,17 @@ copy_table (char * const * argv)
let uc_name = String.uppercase name in
List.iter (
fun argt ->
- let n = name_of_argt argt in
+ let n = name_of_optargt argt in
let uc_n = String.uppercase n in
pr " if (%sv != Val_int (0)) {\n" n;
pr " optargs_s.bitmask |= GUESTFS_%s_%s_BITMASK;\n" uc_name
uc_n;
pr " optargs_s.%s = " n;
(match argt with
- | Bool _ -> pr "Bool_val (Field (%sv, 0))" n
- | Int _ -> pr "Int_val (Field (%sv, 0))" n
- | Int64 _ -> pr "Int64_val (Field (%sv, 0))" n
- | String _ ->
+ | OBool _ -> pr "Bool_val (Field (%sv, 0))" n
+ | OInt _ -> pr "Int_val (Field (%sv, 0))" n
+ | OInt64 _ -> pr "Int64_val (Field (%sv, 0))" n
+ | OString _ ->
pr "guestfs_safe_strdup (g, String_val (Field (%sv, 0)))" n
- | _ -> assert false
);
pr ";\n";
pr " }\n";
@@ -570,13 +570,10 @@ copy_table (char * const * argv)
) args;
List.iter (
function
- | String n ->
+ | OBool _ | OInt _ | OInt64 _ -> ()
+ | OString n ->
pr " if (%sv != Val_int (0))\n" n;
pr " free ((char *) optargs_s.%s);\n" n
- | Bool _ | Int _ | Int64 _
- | Pathname _ | Device _ | Dev_or_Path _ | OptString _
- | FileIn _ | FileOut _ | BufferIn _ | Key _
- | StringList _ | DeviceList _ | Pointer _ -> ()
) optargs;
(match errcode_of_ret ret with
@@ -682,11 +679,10 @@ and generate_ocaml_prototype ?(is_external = false) name style =
and generate_ocaml_function_type (ret, args, optargs) =
List.iter (
function
- | Bool n -> pr "?%s:bool -> " n
- | Int n -> pr "?%s:int -> " n
- | Int64 n -> pr "?%s:int64 -> " n
- | String n -> pr "?%s:string -> " n
- | _ -> assert false
+ | OBool n -> pr "?%s:bool -> " n
+ | OInt n -> pr "?%s:int -> " n
+ | OInt64 n -> pr "?%s:int64 -> " n
+ | OString n -> pr "?%s:string -> " n
) optargs;
List.iter (
function
diff --git a/generator/generator_perl.ml b/generator/generator_perl.ml
index 10a2387..64299ae 100644
--- a/generator/generator_perl.ml
+++ b/generator/generator_perl.ml
@@ -412,16 +412,15 @@ user_cancel (g)
pr " ";
List.iter (
fun argt ->
- let n = name_of_argt argt in
+ let n = name_of_optargt argt in
let uc_n = String.uppercase n in
pr "if (strcmp (this_arg, \"%s\") == 0) {\n" n;
pr " optargs_s.%s = " n;
(match argt with
- | Bool _
- | Int _
- | Int64 _ -> pr "SvIV (ST (items_i+1))"
- | String _ -> pr "SvPV_nolen (ST (items_i+1))"
- | _ -> assert false
+ | OBool _
+ | OInt _
+ | OInt64 _ -> pr "SvIV (ST (items_i+1))"
+ | OString _ -> pr "SvPV_nolen (ST (items_i+1))"
);
pr ";\n";
pr " this_mask = GUESTFS_%s_%s_BITMASK;\n" uc_name uc_n;
@@ -865,7 +864,7 @@ handlers and threads.
pr " %s => " (name_of_argt arg);
pr_type i arg;
pr ",\n"
- ) optargs;
+ ) (optargs_to_args optargs);
pr " },\n";
);
pr " name => \"%s\",\n" name;
@@ -1007,7 +1006,7 @@ and generate_perl_prototype name (ret, args, optargs) =
fun arg ->
if !comma then pr " [, " else pr "[";
comma := true;
- let n = name_of_argt arg in
+ let n = name_of_optargt arg in
pr "%s => $%s]" n n
) optargs;
pr ");"
diff --git a/generator/generator_php.ml b/generator/generator_php.ml
index 4431147..28bd668 100644
--- a/generator/generator_php.ml
+++ b/generator/generator_php.ml
@@ -216,12 +216,11 @@ PHP_FUNCTION (guestfs_last_error)
*)
List.iter (
function
- | Bool n -> pr " zend_bool optargs_t_%s = -1;\n" n
- | Int n | Int64 n -> pr " long optargs_t_%s = -1;\n" n
- | String n ->
+ | OBool n -> pr " zend_bool optargs_t_%s = -1;\n" n
+ | OInt n | OInt64 n -> pr " long optargs_t_%s = -1;\n" n
+ | OString n ->
pr " char *optargs_t_%s = NULL;\n" n;
pr " int optargs_t_%s_size = -1;\n" n
- | _ -> assert false
) optargs
);
@@ -246,10 +245,9 @@ PHP_FUNCTION (guestfs_last_error)
String.concat "" (
List.map (
function
- | Bool _ -> "b"
- | Int _ | Int64 _ -> "l"
- | String _ -> "s"
- | _ -> assert false
+ | OBool _ -> "b"
+ | OInt _ | OInt64 _ -> "l"
+ | OString _ -> "s"
) optargs
)
else param_string in
@@ -272,11 +270,10 @@ PHP_FUNCTION (guestfs_last_error)
) args;
List.iter (
function
- | Bool n | Int n | Int64 n ->
+ | OBool n | OInt n | OInt64 n ->
pr ", &optargs_t_%s" n
- | String n ->
+ | OString n ->
pr ", &optargs_t_%s, &optargs_t_%s_size" n n
- | _ -> assert false
) optargs;
pr ") == FAILURE) {\n";
pr " RETURN_FALSE;\n";
@@ -338,14 +335,13 @@ PHP_FUNCTION (guestfs_last_error)
let uc_shortname = String.uppercase shortname in
List.iter (
fun argt ->
- let n = name_of_argt argt in
+ let n = name_of_optargt argt in
let uc_n = String.uppercase n in
pr " if (optargs_t_%s != " n;
(match argt with
- | Bool _ -> pr "((zend_bool)-1)"
- | Int _ | Int64 _ -> pr "-1"
- | String _ -> pr "NULL"
- | _ -> assert false
+ | OBool _ -> pr "((zend_bool)-1)"
+ | OInt _ | OInt64 _ -> pr "-1"
+ | OString _ -> pr "NULL"
);
pr ") {\n";
pr " optargs_s.%s = optargs_t_%s;\n" n n;
diff --git a/generator/generator_python.ml b/generator/generator_python.ml
index 6d22c18..36c7e01 100644
--- a/generator/generator_python.ml
+++ b/generator/generator_python.ml
@@ -306,11 +306,10 @@ free_strings (char **argv)
*)
List.iter (
function
- | Bool n
- | Int n -> pr " int optargs_t_%s = -1;\n" n
- | Int64 n -> pr " long long optargs_t_%s = -1;\n" n
- | String n -> pr " const char *optargs_t_%s = NULL;\n" n
- | _ -> assert false
+ | OBool n
+ | OInt n -> pr " int optargs_t_%s = -1;\n" n
+ | OInt64 n -> pr " long long optargs_t_%s = -1;\n" n
+ | OString n -> pr " const char *optargs_t_%s = NULL;\n" n
) optargs
);
@@ -343,10 +342,9 @@ free_strings (char **argv)
if optargs <> [] then (
List.iter (
function
- | Bool _ | Int _ -> pr "i"
- | Int64 _ -> pr "L"
- | String _ -> pr "z" (* because we use None to mean not set *)
- | _ -> assert false
+ | OBool _ | OInt _ -> pr "i"
+ | OInt64 _ -> pr "L"
+ | OString _ -> pr "z" (* because we use None to mean not set *)
) optargs;
);
@@ -367,8 +365,7 @@ free_strings (char **argv)
List.iter (
function
- | Bool n | Int n | Int64 n | String n -> pr ", &optargs_t_%s" n
- | _ -> assert false
+ | OBool n | OInt n | OInt64 n | OString n -> pr ",
&optargs_t_%s" n
) optargs;
pr "))\n";
@@ -393,13 +390,12 @@ free_strings (char **argv)
let uc_name = String.uppercase name in
List.iter (
fun argt ->
- let n = name_of_argt argt in
+ let n = name_of_optargt argt in
let uc_n = String.uppercase n in
pr " if (optargs_t_%s != " n;
(match argt with
- | Bool _ | Int _ | Int64 _ -> pr "-1"
- | String _ -> pr "NULL"
- | _ -> assert false
+ | OBool _ | OInt _ | OInt64 _ -> pr "-1"
+ | OString _ -> pr "NULL"
);
pr ") {\n";
pr " optargs_s.%s = optargs_t_%s;\n" n n;
@@ -706,9 +702,8 @@ class GuestFS:
List.iter (fun arg -> pr ", %s" (name_of_argt arg)) args;
List.iter (
function
- | Bool n | Int n | Int64 n -> pr ", %s=-1" n
- | String n -> pr ", %s=None" n
- | _ -> assert false
+ | OBool n | OInt n | OInt64 n -> pr ", %s=-1" n
+ | OString n -> pr ", %s=None" n
) optargs;
pr "):\n";
@@ -754,6 +749,7 @@ class GuestFS:
) args;
pr " self._check_not_closed ()\n";
pr " return libguestfsmod.%s (self._o" name;
- List.iter (fun arg -> pr ", %s" (name_of_argt arg)) (args@optargs);
+ List.iter (fun arg -> pr ", %s" (name_of_argt arg))
+ (args @ (optargs_to_args optargs));
pr ")\n\n";
) all_functions
diff --git a/generator/generator_ruby.ml b/generator/generator_ruby.ml
index 82d0018..1f75b46 100644
--- a/generator/generator_ruby.ml
+++ b/generator/generator_ruby.ml
@@ -467,20 +467,19 @@ ruby_user_cancel (VALUE gv)
pr " VALUE v;\n";
List.iter (
fun argt ->
- let n = name_of_argt argt in
+ let n = name_of_optargt argt in
let uc_n = String.uppercase n in
pr " v = rb_hash_lookup (optargsv, ID2SYM (rb_intern
(\"%s\")));\n" n;
pr " if (v != Qnil) {\n";
(match argt with
- | Bool n ->
+ | OBool n ->
pr " optargs_s.%s = RTEST (v);\n" n;
- | Int n ->
+ | OInt n ->
pr " optargs_s.%s = NUM2INT (v);\n" n;
- | Int64 n ->
+ | OInt64 n ->
pr " optargs_s.%s = NUM2LL (v);\n" n;
- | String _ ->
+ | OString _ ->
pr " optargs_s.%s = StringValueCStr (v);\n" n
- | _ -> assert false
);
pr " optargs_s.bitmask |= GUESTFS_%s_%s_BITMASK;\n" uc_name
uc_n;
pr " }\n";
diff --git a/generator/generator_tests_c_api.ml b/generator/generator_tests_c_api.ml
index 5d2d20a..0df9cd4 100644
--- a/generator/generator_tests_c_api.ml
+++ b/generator/generator_tests_c_api.ml
@@ -818,29 +818,28 @@ and generate_test_command_call ?(expect_error = false) ?test
test_name cmd =
fun (shift, bitmask) optarg ->
let is_set =
match optarg with
- | Bool n, "" -> false
- | Bool n, "true" ->
+ | OBool n, "" -> false
+ | OBool n, "true" ->
pr " optargs.%s = 1;\n" n; true
- | Bool n, "false" ->
+ | OBool n, "false" ->
pr " optargs.%s = 0;\n" n; true
- | Bool n, arg ->
+ | OBool n, arg ->
failwithf "boolean optional arg '%s' should be empty
string or \"true\" or \"false\"" n
- | Int n, "" -> false
- | Int n, i ->
+ | OInt n, "" -> false
+ | OInt n, i ->
let i =
try int_of_string i
with Failure _ -> failwithf "integer optional arg
'%s' should be empty string or number" n in
pr " optargs.%s = %d;\n" n i; true
- | Int64 n, "" -> false
- | Int64 n, i ->
+ | OInt64 n, "" -> false
+ | OInt64 n, i ->
let i =
try Int64.of_string i
with Failure _ -> failwithf "int64 optional arg '%s'
should be empty string or number" n in
pr " optargs.%s = %Ld;\n" n i; true
- | String n, "NOARG" -> false
- | String n, arg ->
- pr " optargs.%s = \"%s\";\n" n (c_quote arg);
true
- | _ -> assert false in
+ | OString n, "NOARG" -> false
+ | OString n, arg ->
+ pr " optargs.%s = \"%s\";\n" n (c_quote arg);
true in
let bit = if is_set then Int64.shift_left 1L shift else 0L in
let bitmask = Int64.logor bitmask bit in
let shift = shift + 1 in
diff --git a/generator/generator_types.ml b/generator/generator_types.ml
index 9459299..16cb089 100644
--- a/generator/generator_types.ml
+++ b/generator/generator_types.ml
@@ -20,7 +20,7 @@
(* Types used to describe the API. *)
-type style = ret * args * args
+type style = ret * args * optargs
(* The [style] is a tuple which describes the return value and
* arguments of a function.
*
@@ -203,6 +203,14 @@ and argt =
*)
| Pointer of (string * string)
+and optargs = optargt list
+
+and optargt =
+ | OBool of string (* boolean *)
+ | OInt of string (* int (smallish ints, signed, <= 31 bits) *)
+ | OInt64 of string (* any 64 bit int *)
+ | OString of string (* const char *name, cannot be NULL *)
+
type errcode = [ `CannotReturnError | `ErrorIsMinusOne | `ErrorIsNULL ]
type flags =
diff --git a/generator/generator_utils.ml b/generator/generator_utils.ml
index aa7fcba..d0380b3 100644
--- a/generator/generator_utils.ml
+++ b/generator/generator_utils.ml
@@ -255,6 +255,9 @@ let name_of_argt = function
| StringList n | DeviceList n | Bool n | Int n | Int64 n
| FileIn n | FileOut n | BufferIn n | Key n | Pointer (_, n) -> n
+let name_of_optargt = function
+ | OBool n | OInt n | OInt64 n | OString n -> n
+
let seq_of_test = function
| TestRun s | TestOutput (s, _) | TestOutputList (s, _)
| TestOutputListOfDevices (s, _)
@@ -345,3 +348,12 @@ let chars c n =
str
let spaces n = chars ' ' n
+
+let optargs_to_args optargs =
+ List.map (
+ function
+ | OBool n -> Bool n
+ | OInt n -> Int n
+ | OInt64 n -> Int64 n
+ | OString n -> String n
+ ) optargs;
diff --git a/generator/generator_utils.mli b/generator/generator_utils.mli
index 5dc4da2..b716ec8 100644
--- a/generator/generator_utils.mli
+++ b/generator/generator_utils.mli
@@ -96,6 +96,9 @@ val map_chars : (char -> 'a) -> string -> 'a list
val name_of_argt : Generator_types.argt -> string
(** Extract argument name. *)
+val name_of_optargt : Generator_types.optargt -> string
+(** Extract optional argument name. *)
+
val seq_of_test : Generator_types.test -> Generator_types.seq
(** Extract test sequence from a test. *)
@@ -125,3 +128,6 @@ val chars : char -> int -> string
val spaces : int -> string
(** [spaces n] creates a string of n spaces. *)
+
+val optargs_to_args : Generator_types.optargs -> Generator_types.args
+(** Convert a list of optargs into an equivalent list of args *)
diff --git a/generator/generator_xdr.ml b/generator/generator_xdr.ml
index 07f3ff9..e3e2572 100644
--- a/generator/generator_xdr.ml
+++ b/generator/generator_xdr.ml
@@ -72,7 +72,7 @@ let generate_xdr () =
* in the header controls which optional arguments are
* meaningful.
*)
- (match args @ optargs with
+ (match args @ (optargs_to_args optargs) with
| [] -> ()
| args ->
pr "struct %s_args {\n" name;
--
1.7.7.5