10:44 a.m.
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\]'
--
2.17.1