[Libguestfs] [PATCH 1/2] common/mltools: getopt: add Getopt.OptString
Richard W.M. Jones
rjones at redhat.com
Wed Aug 22 10:14:46 UTC 2018
On Tue, Aug 21, 2018 at 05:44:29PM +0200, Pino Toscano wrote:
> 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(-)
I think this is the same as when it was last posted, so ACK.
Rich.
> 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\]'
> --
> 2.17.1
>
> _______________________________________________
> Libguestfs mailing list
> Libguestfs at redhat.com
> https://www.redhat.com/mailman/listinfo/libguestfs
--
Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones
Read my programming and virtualization blog: http://rwmj.wordpress.com
virt-df lists disk usage of guests without needing to install any
software inside the virtual machine. Supports Linux and Windows.
http://people.redhat.com/~rjones/virt-df/
More information about the Libguestfs
mailing list