diff options
| -rw-r--r-- | generator/generator_actions.ml | 26 | ||||
| -rw-r--r-- | generator/generator_c.ml | 63 | ||||
| -rw-r--r-- | generator/generator_capitests.ml | 23 | ||||
| -rw-r--r-- | generator/generator_checks.ml | 18 | ||||
| -rw-r--r-- | generator/generator_daemon.ml | 10 | ||||
| -rw-r--r-- | generator/generator_erlang.ml | 18 | ||||
| -rw-r--r-- | generator/generator_fish.ml | 25 | ||||
| -rw-r--r-- | generator/generator_java.ml | 43 | ||||
| -rw-r--r-- | generator/generator_ocaml.ml | 30 | ||||
| -rw-r--r-- | generator/generator_perl.ml | 15 | ||||
| -rw-r--r-- | generator/generator_php.ml | 28 | ||||
| -rw-r--r-- | generator/generator_python.ml | 34 | ||||
| -rw-r--r-- | generator/generator_ruby.ml | 11 | ||||
| -rw-r--r-- | generator/generator_types.ml | 10 | ||||
| -rw-r--r-- | generator/generator_utils.ml | 12 | ||||
| -rw-r--r-- | generator/generator_utils.mli | 6 | ||||
| -rw-r--r-- | generator/generator_xdr.ml | 2 |
17 files changed, 177 insertions, 197 deletions
diff --git a/generator/generator_actions.ml b/generator/generator_actions.ml index ece471fc..28f20ad1 100644 --- a/generator/generator_actions.ml +++ b/generator/generator_actions.ml @@ -1007,7 +1007,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", "\ @@ -1097,7 +1097,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", "\ @@ -1541,7 +1541,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", "\ @@ -6022,7 +6022,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"; ""; ""]; @@ -6165,7 +6165,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", "\ @@ -6189,7 +6189,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", "\ @@ -6221,7 +6221,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", "\ @@ -6258,7 +6258,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", "\ @@ -6275,7 +6275,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", "\ @@ -6300,7 +6300,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", "\ @@ -6323,21 +6323,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"]; diff --git a/generator/generator_c.ml b/generator/generator_c.ml index b3928093..4324ec06 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_capitests.ml b/generator/generator_capitests.ml index fefc6e22..bbfdfc7a 100644 --- a/generator/generator_capitests.ml +++ b/generator/generator_capitests.ml @@ -820,29 +820,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_checks.ml b/generator/generator_checks.ml index 11fc9cb0..f828c816 100644 --- a/generator/generator_checks.ml +++ b/generator/generator_checks.ml @@ -112,26 +112,19 @@ 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; + List.iter (fun arg -> check_arg_ret_name (name_of_optargt arg)) optargs; ) all_functions; - (* Check only certain types allowed in optargs. *) + (* Maximum of 63 optargs permitted. *) 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 + if List.length optargs > 63 then + failwithf "maximum of 63 optional args allowed for %s" name; ) 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 +132,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 75377169..9f15abdf 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 @ args_of_optargs 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 @ args_of_optargs 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 @ args_of_optargs 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' @ args_of_optargs 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 d166ef26..6f8cd4b1 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 3d52421b..5b0b59cb 100644 --- a/generator/generator_fish.ml +++ b/generator/generator_fish.ml @@ -31,11 +31,10 @@ open Generator_prepopts open Generator_c 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 () = @@ -130,7 +129,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 = @@ -456,15 +455,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)" @@ -474,13 +473,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; @@ -850,9 +848,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 69d5e24b..16fb8535 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 10c18e37..125347b4 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") + (args_of_optargs 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 10a2387e..8418f865 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; + ) (args_of_optargs 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 4431147f..28bd6683 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 6d22c187..98b54a84 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 @ args_of_optargs optargs); pr ")\n\n"; ) all_functions diff --git a/generator/generator_ruby.ml b/generator/generator_ruby.ml index 82d0018b..1f75b460 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_types.ml b/generator/generator_types.ml index 94592991..16cb0895 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 aa7fcba3..e35842e1 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 args_of_optargs 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 5dc4da25..29f23f2b 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 args_of_optargs : 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 07f3ff97..c78a1328 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 @ args_of_optargs optargs with | [] -> () | args -> pr "struct %s_args {\n" name; |