Introduce a new type of option with an optional string argument. --- common/mltools/getopt-c.c | 20 +++++++++++++++++++- common/mltools/getopt.ml | 5 ++++- common/mltools/getopt.mli | 4 ++++ common/mltools/getopt_tests.ml | 18 +++++++++++++++++- common/mltools/test-getopt.sh | 11 +++++++++++ 5 files changed, 55 insertions(+), 3 deletions(-) diff --git a/common/mltools/getopt-c.c b/common/mltools/getopt-c.c index 7b7e39be2..5fa703428 100644 --- a/common/mltools/getopt-c.c +++ b/common/mltools/getopt-c.c @@ -274,6 +274,10 @@ guestfs_int_mllib_getopt_parse (value argsv, value specsv, value anon_funv, valu has_arg = 1; break; + case 8: /* OptString of string * (string option -> unit) */ + has_arg = 2; + break; + default: error (EXIT_FAILURE, 0, "internal error: unhandled Tag_val (actionv) = %d", @@ -286,8 +290,11 @@ guestfs_int_mllib_getopt_parse (value argsv, value specsv, value anon_funv, valu caml_raise_out_of_memory (); optstring = newstring; optstring[optstring_len++] = key[0]; - if (has_arg) + if (has_arg > 0) { optstring[optstring_len++] = ':'; + if (has_arg > 1) + optstring[optstring_len++] = ':'; + } } else { struct option *newopts = realloc (longopts, (longopts_len + 1 + 1) * sizeof (*longopts)); if (newopts == NULL) @@ -393,6 +400,17 @@ guestfs_int_mllib_getopt_parse (value argsv, value specsv, value anon_funv, valu do_call1 (v, v2); break; + case 8: /* OptString of string * (string option -> unit) */ + v = Field (actionv, 1); + if (optarg) { + v2 = caml_alloc (1, 0); + Store_field (v2, 0, caml_copy_string (optarg)); + } else { + v2 = Val_none; + } + do_call1 (v, v2); + break; + default: error (EXIT_FAILURE, 0, "internal error: unhandled Tag_val (actionv) = %d", diff --git a/common/mltools/getopt.ml b/common/mltools/getopt.ml index 9d20855f7..da461457b 100644 --- a/common/mltools/getopt.ml +++ b/common/mltools/getopt.ml @@ -31,6 +31,7 @@ type spec = | Int of string * (int -> unit) | Set_int of string * int ref | Symbol of string * string list * (string -> unit) + | OptString of string * (string option -> unit) module OptionName = struct type option_name = S of char | L of string | M of string @@ -97,7 +98,8 @@ let show_help h () = | Set_string (arg, _) | Int (arg, _) | Set_int (arg, _) - | Symbol (arg, _, _) -> Some arg in + | Symbol (arg, _, _) + | OptString (arg, _) -> Some arg in (match arg with | None -> () | Some arg -> @@ -181,6 +183,7 @@ let create specs ?anon_fun usage_msg = | Set_string _ -> () | Int _ -> () | Set_int _ -> () + | OptString _ -> () | Symbol (_, elements, _) -> List.iter ( fun e -> diff --git a/common/mltools/getopt.mli b/common/mltools/getopt.mli index 2cae19bb8..b4a4f261f 100644 --- a/common/mltools/getopt.mli +++ b/common/mltools/getopt.mli @@ -44,6 +44,10 @@ type spec = element in the tuple is the documentation string of the argument, the second is the list of allowed strings, and the third is the function to call. *) + | OptString of string * (string option -> unit) + (** Option with an optional argument; the first element in the + tuple is the documentation string of the argument, and the + second is the function to call. *) module OptionName : sig type option_name = diff --git a/common/mltools/getopt_tests.ml b/common/mltools/getopt_tests.ml index 751bf1d5f..1617b3056 100644 --- a/common/mltools/getopt_tests.ml +++ b/common/mltools/getopt_tests.ml @@ -40,6 +40,15 @@ let set_flag = ref false let si = ref 42 let ss = ref "not set" +type optstring_value = + | Unset + | NoValue + | Value of string +let optstr = ref Unset +let set_optstr = function + | None -> optstr := NoValue + | Some s -> optstr := Value s + let argspec = [ [ S 'a'; L"add" ], Getopt.String ("string", add_string), "Add string"; [ S 'c'; L"clear" ], Getopt.Clear clear_flag, "Clear flag"; @@ -47,10 +56,16 @@ let argspec = [ [ M"ii"; L"set-int" ], Getopt.Set_int ("int", si), "Set int"; [ M"is"; L"set-string"], Getopt.Set_string ("string", ss), "Set string"; [ S 't'; L"set" ], Getopt.Set set_flag, "Set flag"; + [ S 'o'; L"optstr" ], Getopt.OptString ("string", set_optstr), "Set optional string"; ] let usage_msg = sprintf "%s: test the Getopt parser" prog +let print_optstring_value = function + | Unset -> "not set" + | NoValue -> "<none>" + | Value s -> s + let opthandle = create_standard_options argspec ~anon_fun usage_msg let () = Getopt.parse opthandle; @@ -66,4 +81,5 @@ let () = printf "clear_flag = %b\n" !clear_flag; printf "set_flag = %b\n" !set_flag; printf "set_int = %d\n" !si; - printf "set_string = %s\n" !ss + printf "set_string = %s\n" !ss; + printf "set_optstring = %s\n" (print_optstring_value !optstr) diff --git a/common/mltools/test-getopt.sh b/common/mltools/test-getopt.sh index 9db18fb44..58e2d0d59 100755 --- a/common/mltools/test-getopt.sh +++ b/common/mltools/test-getopt.sh @@ -52,6 +52,7 @@ $t --help | grep -- '-i, --int <int>' $t --help | grep -- '-ii, --set-int <int>' $t --help | grep -- '-v, --verbose' $t --help | grep -- '-x' +$t --help | grep -- '-o, --optstr <string>' # --version $t --version | grep '^getopt_tests 1\.' @@ -60,6 +61,7 @@ $t --version | grep '^getopt_tests 1\.' $t --short-options | grep '^-a' $t --short-options | grep '^-c' $t --short-options | grep '^-i' +$t --short-options | grep '^-o' $t --short-options | grep '^-q' $t --short-options | grep '^-ii' $t --short-options | grep '^-is' @@ -78,6 +80,7 @@ $t --long-options | grep '^--colour' $t --long-options | grep '^--colours' $t --long-options | grep '^--debug-gc' $t --long-options | grep '^--int' +$t --long-options | grep '^--optstr' $t --long-options | grep '^--quiet' $t --long-options | grep '^--set' $t --long-options | grep '^--set-int' @@ -157,6 +160,14 @@ $t --set-string B | grep '^set_string = B' expect_fail $t --is expect_fail $t --set-string +# -o/--optstr parameter. +$t | grep '^set_optstring = not set' +$t -o | grep '^set_optstring = <none>' +$t --optstr | grep '^set_optstring = <none>' +$t -o=A | grep '^set_optstring = A' +$t --optstr=A | grep '^set_optstring = A' +$t --optstr=A --optstr | grep '^set_optstring = <none>' + # Anonymous parameters. $t | grep '^anons = \[\]' $t 1 | grep '^anons = \[1\]'