From 0a7b734d2f54d4e98882532da9887feb66c9824a Mon Sep 17 00:00:00 2001 From: Matthew Booth Date: Mon, 9 Jan 2012 10:16:35 +0000 Subject: [PATCH] generator: Create a separate type for optional arguments 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. RWMJ: - removed redundant parens - readded the check for > 64 optargs, but changed it to > 63 - changed the new function to args_of_optargs --- generator/generator_actions.ml | 30 +++++++++--------- generator/generator_c.ml | 63 +++++++++++++++++--------------------- generator/generator_checks.ml | 18 +++-------- 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, 179 insertions(+), 199 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 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 for more details. See also C, C."); - ("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."); - ("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 returned in this list. Call C 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."); - ("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 does not exist, then a new file is created. See also C."); - ("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 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. See also C."); - ("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 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 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, C and C 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. For precise details of how tune2fs works, see the L 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..4324ec0 100644 --- a/generator/generator_c.ml +++ b/generator/generator_c.ml @@ -193,15 +193,14 @@ and generate_actions_pod () = pr "See L.\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.\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 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..f828c81 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 7537716..9f15abd 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 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..125347b 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 10a2387..8418f86 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 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..98b54a8 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 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..e35842e 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 5dc4da2..29f23f2 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 07f3ff9..c78a132 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; -- 1.8.3.1