Matthew Booth
2012-Jan-09 10:16 UTC
[Libguestfs] [PATCH 1/2] generator: Rename java_structs to camel_structs to better reflect their purpose
This map was originally included just for the java bindings, but is generally useful to any binding which uses camel case by requirement or convention. --- generator/generator_haskell.ml | 4 ++-- generator/generator_java.ml | 10 +++++----- generator/generator_main.ml | 2 +- generator/generator_structs.ml | 12 +++++------- generator/generator_structs.mli | 8 ++++---- 5 files changed, 17 insertions(+), 19 deletions(-) diff --git a/generator/generator_haskell.ml b/generator/generator_haskell.ml index 29b260f..a57cfd8 100644 --- a/generator/generator_haskell.ml +++ b/generator/generator_haskell.ml @@ -239,10 +239,10 @@ and generate_haskell_prototype ~handle ?(hs = false) (ret, args, optargs) | RString _ -> pr "%s" string | RStringList _ -> pr "[%s]" string | RStruct (_, typ) -> - let name = java_name_of_struct typ in + let name = camel_name_of_struct typ in pr "%s" name | RStructList (_, typ) -> - let name = java_name_of_struct typ in + let name = camel_name_of_struct typ in pr "[%s]" name | RHashtable _ -> pr "Hashtable" | RBufferOut _ -> pr "%s" string diff --git a/generator/generator_java.ml b/generator/generator_java.ml index 68972bc..69d5e24 100644 --- a/generator/generator_java.ml +++ b/generator/generator_java.ml @@ -219,10 +219,10 @@ and generate_java_prototype ?(public=false) ?(privat=false) ?(native=false) | RBufferOut _ -> pr "String "; | RStringList _ -> pr "String[] "; | RStruct (_, typ) -> - let name = java_name_of_struct typ in + let name = camel_name_of_struct typ in pr "%s " name; | RStructList (_, typ) -> - let name = java_name_of_struct typ in + let name = camel_name_of_struct typ in pr "%s[] " name; | RHashtable _ -> if not native then @@ -657,11 +657,11 @@ Java_com_redhat_et_libguestfs_GuestFS__1close pr " free (r);\n"; pr " return jr;\n" | RStruct (_, typ) -> - let jtyp = java_name_of_struct typ in + let jtyp = camel_name_of_struct typ in let cols = cols_of_struct typ in generate_java_struct_return typ jtyp cols | RStructList (_, typ) -> - let jtyp = java_name_of_struct typ in + let jtyp = camel_name_of_struct typ in let cols = cols_of_struct typ in generate_java_struct_list_return typ jtyp cols | RBufferOut _ -> @@ -767,5 +767,5 @@ and generate_java_makefile_inc () List.iter ( fun (typ, jtyp) -> pr "\tcom/redhat/et/libguestfs/%s.java \\\n" jtyp; - ) java_structs; + ) camel_structs; pr "\tcom/redhat/et/libguestfs/GuestFS.java\n" diff --git a/generator/generator_main.ml b/generator/generator_main.ml index 7e4e4ed..53a0f29 100644 --- a/generator/generator_main.ml +++ b/generator/generator_main.ml @@ -124,7 +124,7 @@ Run it from the top source directory using the command let cols = cols_of_struct typ in let filename = sprintf "java/com/redhat/et/libguestfs/%s.java" jtyp in output_to filename (generate_java_struct jtyp cols); - ) java_structs; + ) camel_structs; output_to "java/Makefile.inc" generate_java_makefile_inc; output_to "java/com_redhat_et_libguestfs_GuestFS.c" generate_java_c; diff --git a/generator/generator_structs.ml b/generator/generator_structs.ml index 8fd12e4..83442d1 100644 --- a/generator/generator_structs.ml +++ b/generator/generator_structs.ml @@ -193,10 +193,8 @@ let structs = [ ]; ] (* end of structs *) -(* Ugh, Java has to be different .. - * These names are also used by the Haskell bindings. - *) -let java_structs = [ +(* For bindings which want camel case *) +let camel_structs = [ "int_bool", "IntBool"; "lvm_pv", "PV"; "lvm_vg", "VG"; @@ -211,11 +209,11 @@ let java_structs = [ "application", "Application"; ] -let java_name_of_struct typ - try List.assoc typ java_structs +let camel_name_of_struct typ + try List.assoc typ camel_structs with Not_found -> failwithf - "java_name_of_struct: no java_structs entry corresponding to %s" typ + "camel_name_of_struct: no camel_structs entry corresponding to %s" typ let cols_of_struct typ try List.assoc typ structs diff --git a/generator/generator_structs.mli b/generator/generator_structs.mli index 66ae2ea..f47a9ad 100644 --- a/generator/generator_structs.mli +++ b/generator/generator_structs.mli @@ -26,8 +26,8 @@ type cols = (string * Generator_types.field) list val structs : (string * cols) list (** List of structures. *) -val java_structs : (string * string) list -(** Of course, Java has to be different from everyone else. *) +val camel_structs : (string * string) list +(** For bindings which want camel case struct names *) val lvm_pv_cols : cols val lvm_vg_cols : cols @@ -36,8 +36,8 @@ val lvm_lv_cols : cols used to generate code for parsing the output of commands like [lvs]. One day replace this with liblvm API calls. *) -val java_name_of_struct : string -> string -(** Extract Java name of struct. *) +val camel_name_of_struct : string -> string +(** Camel case name of struct. *) val cols_of_struct : string -> cols (** Extract columns of a struct. *) -- 1.7.7.5
Matthew Booth
2012-Jan-09 10:16 UTC
[Libguestfs] [PATCH 2/2] 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. --- 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 at 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 at 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
Maybe Matching Threads
- [PATCH 0/7] Add tar compress, numericowner, excludes flags.
- [PATCH 0/6] Allow non-optargs functions to gain optional arguments.
- [PATCH 1/4] php: fix invalid memory access with OptString
- [PATCH] python: fix possible free on uninit memory with OStringList optargs
- [PATCH 3/3] python: Allow bindings to be compiled with different version of libguestfs (RHBZ#1262983).