thr3ads.net - Libguestfs - [Libguestfs] [PATCH v2 0/3] mllib: Various fixes and changes to Getopt module. [Jul 2016]

If this information is useful, please help other people find it:
Share via:

Richard W.M. Jones

2016-Jul-18 10:46 UTC

[Libguestfs] [PATCH v2 0/3] mllib: Various fixes and changes to Getopt module.

v1 -> v2:

 - Further fixes to Getopt int parsing.

 - Completed the L/S changes.

 - Fixed the test suite so it passes now.  Also we don't need the
   special-case tests for 64 bit arch.

Rich.

Richard W.M. Jones

2016-Jul-18 10:46 UTC

head link

[Libguestfs] [PATCH v2 1/3] mllib: getopt: Further fix int parsing.

Don't allow suffixes on integers, and fix the bounds to match the
definitions of Min_long and Max_long in <caml/mlvalues.h>.

Fixes commit 66b54bfefe42f2996d1b42c3646511bbd4349317.
---
 mllib/getopt-c.c | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/mllib/getopt-c.c b/mllib/getopt-c.c
index bf40f91..13852c2 100644
--- a/mllib/getopt-c.c
+++ b/mllib/getopt-c.c
@@ -124,13 +124,13 @@ strtoint (const char *arg)
 {
   long int num;
 
-  if (xstrtol (arg, NULL, 0, &num, NULL) != LONGINT_OK) {
+  if (xstrtol (arg, NULL, 0, &num, "") != LONGINT_OK) {
     fprintf (stderr, _("%s: '%s' is not a numeric value.\n"),
              guestfs_int_program_name, arg);
     show_error (EXIT_FAILURE);
   }
 
-  if (num <= -(2LL<<30) || num >= ((2LL<<30)-1)) {
+  if (num < -(1<<30) || num > (1<<30)-1) {
     fprintf (stderr, _("%s: %s: integer out of range\n"),
              guestfs_int_program_name, arg);
     show_error (EXIT_FAILURE);
-- 
2.7.4

Richard W.M. Jones

2016-Jul-18 10:46 UTC

head link

[Libguestfs] [PATCH v2 2/3] mllib: Use L"..." and S '...' for long and short options.

---
 builder/cmdline.ml                        |  61 +++++++--------
 dib/cmdline.ml                            |  57 +++++++-------
 generator/customize.ml                    |  29 +++----
 get-kernel/get_kernel.ml                  |  17 +++--
 mllib/common_utils.ml                     |  15 ++--
 mllib/getopt.ml                           | 121 +++++++++++++++---------------
 mllib/getopt.mli                          |  43 ++++++-----
 resize/resize.ml                          |  41 +++++-----
 sparsify/cmdline.ml                       |  21 +++---
 sysprep/main.ml                           |  29 +++----
 sysprep/sysprep_operation.ml              |   8 +-
 sysprep/sysprep_operation_script.ml       |   5 +-
 sysprep/sysprep_operation_user_account.ml |   5 +-
 v2v/cmdline.ml                            |  55 +++++++-------
 v2v/copy_to_local.ml                      |   5 +-
 15 files changed, 267 insertions(+), 245 deletions(-)

diff --git a/builder/cmdline.ml b/builder/cmdline.ml
index 846c2e3..49a57ee 100644
--- a/builder/cmdline.ml
+++ b/builder/cmdline.ml
@@ -20,6 +20,7 @@
 
 open Common_gettext.Gettext
 open Common_utils
+open Getopt.OptionName
 
 open Customize_cmdline
 
@@ -119,46 +120,46 @@ let parse_cmdline ()    let warn_if_partition = ref true
in
 
   let argspec = [
-    [ "--arch" ],    Getopt.Set_string ("arch", arch),     
s_"Set the output architecture";
-    [ "--attach" ],  Getopt.String ("iso", attach_disk),   
s_"Attach data disk/ISO during install";
-    [ "--attach-format" ],  Getopt.String ("format",
set_attach_format),
+    [ L"arch" ],    Getopt.Set_string ("arch", arch),      
s_"Set the output architecture";
+    [ L"attach" ],  Getopt.String ("iso", attach_disk),    
s_"Attach data disk/ISO during install";
+    [ L"attach-format" ],  Getopt.String ("format",
set_attach_format),
                                              s_"Set attach disk
format";
-    [ "--cache" ],   Getopt.String ("dir", set_cache),     
s_"Set template cache dir";
-    [ "--no-cache" ], Getopt.Unit no_cache,        s_"Disable
template cache";
-    [ "--cache-all-templates" ], Getopt.Unit cache_all_mode,
+    [ L"cache" ],   Getopt.String ("dir", set_cache),      
s_"Set template cache dir";
+    [ L"no-cache" ], Getopt.Unit no_cache,        s_"Disable
template cache";
+    [ L"cache-all-templates" ], Getopt.Unit cache_all_mode,
                                             s_"Download all templates to
the cache";
-    [ "--check-signature"; "--check-signatures" ],
Getopt.Set check_signature,
+    [ L"check-signature"; L"check-signatures" ], Getopt.Set
check_signature,
                                             s_"Check digital
signatures";
-    [ "--no-check-signature"; "--no-check-signatures" ],
Getopt.Clear check_signature,
+    [ L"no-check-signature"; L"no-check-signatures" ],
Getopt.Clear check_signature,
                                             s_"Disable digital
signatures";
-    [ "--curl" ],    Getopt.Set_string ("curl", curl),     
s_"Set curl binary/command";
-    [ "--delete-cache" ], Getopt.Unit delete_cache_mode,
+    [ L"curl" ],    Getopt.Set_string ("curl", curl),      
s_"Set curl binary/command";
+    [ L"delete-cache" ], Getopt.Unit delete_cache_mode,
                                             s_"Delete the template
cache";
-    [ "--no-delete-on-failure" ], Getopt.Clear delete_on_failure,
+    [ L"no-delete-on-failure" ], Getopt.Clear delete_on_failure,
                                             s_"Don't delete output
file on failure";
-    [ "--fingerprint" ], Getopt.String ("AAAA..",
add_fingerprint),
+    [ L"fingerprint" ], Getopt.String ("AAAA..",
add_fingerprint),
                                              s_"Fingerprint of valid
signing key";
-    [ "--format" ],  Getopt.Set_string ("raw|qcow2",
format),      s_"Output format (default: raw)";
-    [ "--get-kernel" ], Getopt.Unit get_kernel_mode,
+    [ L"format" ],  Getopt.Set_string ("raw|qcow2",
format),      s_"Output format (default: raw)";
+    [ L"get-kernel" ], Getopt.Unit get_kernel_mode,
                                             s_"Get kernel from
image";
-    [ "--gpg" ],    Getopt.Set_string ("gpg", gpg),        
s_"Set GPG binary/command";
-    [ "-l"; "--list" ],        Getopt.Unit list_mode,      
s_"List available templates";
-    [ "--long" ],    Getopt.Unit list_set_long,    s_"Shortcut
for --list-format long";
-    [ "--list-format" ], Getopt.String ("short|long|json",
list_set_format),
+    [ L"gpg" ],    Getopt.Set_string ("gpg", gpg),         
s_"Set GPG binary/command";
+    [ S 'l'; L"list" ],        Getopt.Unit list_mode,       
s_"List available templates";
+    [ L"long" ],    Getopt.Unit list_set_long,    s_"Shortcut
for --list-format long";
+    [ L"list-format" ], Getopt.String ("short|long|json",
list_set_format),
                                              s_"Set the format for --list
(default: short)";
-    [ "--machine-readable" ], Getopt.Set machine_readable,
s_"Make output machine readable";
-    [ "-m"; "--memsize" ],        Getopt.Int
("mb", set_memsize),        s_"Set memory size";
-    [ "--network" ], Getopt.Set network,           s_"Enable
appliance network (default)";
-    [ "--no-network" ], Getopt.Clear network,      s_"Disable
appliance network";
-    [ "--notes" ],   Getopt.Unit notes_mode,       s_"Display
installation notes";
-    [ "-o"; "--output" ],        Getopt.Set_string
("file", output),      s_"Set output filename";
-    [ "--print-cache" ], Getopt.Unit print_cache_mode,
+    [ L"machine-readable" ], Getopt.Set machine_readable,
s_"Make output machine readable";
+    [ S 'm'; L"memsize" ],        Getopt.Int ("mb",
set_memsize),        s_"Set memory size";
+    [ L"network" ], Getopt.Set network,           s_"Enable
appliance network (default)";
+    [ L"no-network" ], Getopt.Clear network,      s_"Disable
appliance network";
+    [ L"notes" ],   Getopt.Unit notes_mode,       s_"Display
installation notes";
+    [ S 'o'; L"output" ],        Getopt.Set_string
("file", output),      s_"Set output filename";
+    [ L"print-cache" ], Getopt.Unit print_cache_mode,
                                             s_"Print info about template
cache";
-    [ "--size" ],    Getopt.String ("size", set_size),     
s_"Set output disk size";
-    [ "--smp" ],     Getopt.Int ("vcpus", set_smp),        
s_"Set number of vCPUs";
-    [ "--source" ],  Getopt.String ("URL", add_source),    
s_"Set source URL";
-    [ "--no-sync" ], Getopt.Clear sync,            s_"Do not
fsync output file on exit";
-    [ "--no-warn-if-partition" ], Getopt.Clear warn_if_partition,
+    [ L"size" ],    Getopt.String ("size", set_size),      
s_"Set output disk size";
+    [ L"smp" ],     Getopt.Int ("vcpus", set_smp),         
s_"Set number of vCPUs";
+    [ L"source" ],  Getopt.String ("URL", add_source),     
s_"Set source URL";
+    [ L"no-sync" ], Getopt.Clear sync,            s_"Do not
fsync output file on exit";
+    [ L"no-warn-if-partition" ], Getopt.Clear warn_if_partition,
                                             s_"Do not warn if writing to a
partition";
   ] in
   let customize_argspec, get_customize_ops = Customize_cmdline.argspec () in
diff --git a/dib/cmdline.ml b/dib/cmdline.ml
index 0ec1616..acba9b4 100644
--- a/dib/cmdline.ml
+++ b/dib/cmdline.ml
@@ -20,6 +20,7 @@
 
 open Common_gettext.Gettext
 open Common_utils
+open Getopt.OptionName
 
 open Utils
 
@@ -151,44 +152,44 @@ read the man page virt-dib(1).
     prepend (List.rev (String.nsplit "," arg)) extra_packages in
 
   let argspec = [
-    [ "-p"; "--element-path" ],           Getopt.String
("path", append_element_path),  s_"Add new a elements
location";
-    [ "--exclude-element" ], Getopt.String ("element",
append_excluded_element),
+    [ S 'p'; L"element-path" ],           Getopt.String
("path", append_element_path),  s_"Add new a elements
location";
+    [ L"exclude-element" ], Getopt.String ("element",
append_excluded_element),
       s_"Exclude the specified element";
-    [ "--exclude-script" ], Getopt.String ("script",
append_excluded_script),
+    [ L"exclude-script" ], Getopt.String ("script",
append_excluded_script),
       s_"Exclude the specified script";
-    [ "--envvar" ],     Getopt.String ("envvar[=value]",
append_envvar),   s_"Carry/set this environment variable";
-    [ "--skip-base" ],  Getopt.Clear use_base,        s_"Skip
the inclusion of the 'base' element";
-    [ "--root-label" ], Getopt.String ("label",
set_root_label), s_"Label for the root fs";
-    [ "--install-type" ], Getopt.Set_string ("type",
install_type),  s_"Installation type";
-    [ "--image-cache" ], Getopt.String ("directory",
set_image_cache), s_"Location for cached images";
-    [ "-u" ],           Getopt.Clear compressed,      "Do not
compress the qcow2 image";
-    [ "--qemu-img-options" ], Getopt.String ("option",
set_qemu_img_options),
+    [ L"envvar" ],     Getopt.String ("envvar[=value]",
append_envvar),   s_"Carry/set this environment variable";
+    [ L"skip-base" ],  Getopt.Clear use_base,        s_"Skip the
inclusion of the 'base' element";
+    [ L"root-label" ], Getopt.String ("label",
set_root_label), s_"Label for the root fs";
+    [ L"install-type" ], Getopt.Set_string ("type",
install_type),  s_"Installation type";
+    [ L"image-cache" ], Getopt.String ("directory",
set_image_cache), s_"Location for cached images";
+    [ S 'u' ],           Getopt.Clear compressed,      "Do not
compress the qcow2 image";
+    [ L"qemu-img-options" ], Getopt.String ("option",
set_qemu_img_options),
                                               s_"Add qemu-img
options";
-    [ "--mkfs-options" ], Getopt.String ("option",
set_mkfs_options),
+    [ L"mkfs-options" ], Getopt.String ("option",
set_mkfs_options),
                                               s_"Add mkfs options";
-    [ "--extra-packages" ], Getopt.String ("pkg,...",
append_extra_packages),
+    [ L"extra-packages" ], Getopt.String ("pkg,...",
append_extra_packages),
       s_"Add extra packages to install";
 
-    [ "--ramdisk" ],    Getopt.Set is_ramdisk,        "Switch to
a ramdisk build";
-    [ "--ramdisk-element" ], Getopt.Set_string ("name",
ramdisk_element), s_"Main element for building ramdisks";
+    [ L"ramdisk" ],    Getopt.Set is_ramdisk,        "Switch to
a ramdisk build";
+    [ L"ramdisk-element" ], Getopt.Set_string ("name",
ramdisk_element), s_"Main element for building ramdisks";
 
-    [ "--name" ],       Getopt.Set_string ("name",
image_name), s_"Name of the image";
-    [ "--fs-type" ],    Getopt.Set_string ("fs", fs_type), 
s_"Filesystem for the image";
-    [ "--size" ],       Getopt.String ("size", set_size),  
s_"Set output disk size";
-    [ "--formats" ],    Getopt.String ("qcow2,tgz,...",
set_format),     s_"Output formats";
-    [ "--arch" ],       Getopt.Set_string ("arch", arch),  
s_"Output architecture";
-    [ "--drive" ],      Getopt.String ("path", set_drive), 
s_"Optional drive for caches";
+    [ L"name" ],       Getopt.Set_string ("name",
image_name), s_"Name of the image";
+    [ L"fs-type" ],    Getopt.Set_string ("fs", fs_type),  
s_"Filesystem for the image";
+    [ L"size" ],       Getopt.String ("size", set_size),   
s_"Set output disk size";
+    [ L"formats" ],    Getopt.String ("qcow2,tgz,...",
set_format),     s_"Output formats";
+    [ L"arch" ],       Getopt.Set_string ("arch", arch),   
s_"Output architecture";
+    [ L"drive" ],      Getopt.String ("path", set_drive),  
s_"Optional drive for caches";
 
-    [ "-m"; "--memsize" ],           Getopt.Int
("mb", set_memsize),       s_"Set memory size";
-    [ "--network" ],    Getopt.Set network,           s_"Enable
appliance network (default)";
-    [ "--no-network" ], Getopt.Clear network,      s_"Disable
appliance network";
-    [ "--smp" ],        Getopt.Int ("vcpus", set_smp),     
s_"Set number of vCPUs";
-    [ "--no-delete-on-failure" ], Getopt.Clear delete_on_failure,
+    [ S 'm'; L"memsize" ],           Getopt.Int
("mb", set_memsize),       s_"Set memory size";
+    [ L"network" ],    Getopt.Set network,           s_"Enable
appliance network (default)";
+    [ L"no-network" ], Getopt.Clear network,      s_"Disable
appliance network";
+    [ L"smp" ],        Getopt.Int ("vcpus", set_smp),      
s_"Set number of vCPUs";
+    [ L"no-delete-on-failure" ], Getopt.Clear delete_on_failure,
                                                s_"Don't delete output
file on failure";
-    [ "--machine-readable" ], Getopt.Set machine_readable,
s_"Make output machine readable";
+    [ L"machine-readable" ], Getopt.Set machine_readable,
s_"Make output machine readable";
 
-    [ "--debug" ],      Getopt.Int ("level", set_debug),   
s_"Set debug level";
-    [ "-B" ],           Getopt.Set_string ("path",
basepath),   s_"Base path of diskimage-builder library";
+    [ L"debug" ],      Getopt.Int ("level", set_debug),    
s_"Set debug level";
+    [ S 'B' ],           Getopt.Set_string ("path",
basepath),   s_"Base path of diskimage-builder library";
   ] in
 
   let opthandle = create_standard_options argspec ~anon_fun:append_element
usage_msg in
diff --git a/generator/customize.ml b/generator/customize.ml
index 0924732..259cd26 100644
--- a/generator/customize.ml
+++ b/generator/customize.ml
@@ -590,6 +590,7 @@ open Printf
 
 open Common_utils
 open Common_gettext.Gettext
+open Getopt.OptionName
 
 open Customize_utils
 
@@ -652,7 +653,7 @@ let rec argspec ()      | { op_type = Unit; op_name = name;
op_discrim = discrim;
         op_shortdesc = shortdesc; op_pod_longdesc = longdesc } ->
       pr "    (\n";
-      pr "      [ \"--%s\" ],\n" name;
+      pr "      [ L\"%s\" ],\n" name;
       pr "      Getopt.Unit (fun () -> push_front %s ops),\n"
discrim;
       pr "      s_\"%s\"\n" shortdesc;
       pr "    ),\n";
@@ -660,7 +661,7 @@ let rec argspec ()      | { op_type = String v; op_name =
name; op_discrim = discrim;
         op_shortdesc = shortdesc; op_pod_longdesc = longdesc } ->
       pr "    (\n";
-      pr "      [ \"--%s\" ],\n" name;
+      pr "      [ L\"%s\" ],\n" name;
       pr "      Getopt.String (s_\"%s\", fun s -> push_front
(%s s) ops),\n" v discrim;
       pr "      s_\"%s\"\n" shortdesc;
       pr "    ),\n";
@@ -668,7 +669,7 @@ let rec argspec ()      | { op_type = StringPair v; op_name
= name; op_discrim = discrim;
         op_shortdesc = shortdesc; op_pod_longdesc = longdesc } ->
       pr "    (\n";
-      pr "      [ \"--%s\" ],\n" name;
+      pr "      [ L\"%s\" ],\n" name;
       pr "      Getopt.String (\n";
       pr "        s_\"%s\",\n" v;
       pr "        fun s ->\n";
@@ -681,7 +682,7 @@ let rec argspec ()      | { op_type = StringList v; op_name
= name; op_discrim = discrim;
         op_shortdesc = shortdesc; op_pod_longdesc = longdesc } ->
       pr "    (\n";
-      pr "      [ \"--%s\" ],\n" name;
+      pr "      [ L\"%s\" ],\n" name;
       pr "      Getopt.String (\n";
       pr "        s_\"%s\",\n" v;
       pr "        fun s ->\n";
@@ -694,7 +695,7 @@ let rec argspec ()      | { op_type = TargetLinks v; op_name
= name; op_discrim = discrim;
         op_shortdesc = shortdesc; op_pod_longdesc = longdesc } ->
       pr "    (\n";
-      pr "      [ \"--%s\" ],\n" name;
+      pr "      [ L\"%s\" ],\n" name;
       pr "      Getopt.String (\n";
       pr "        s_\"%s\",\n" v;
       pr "        fun s ->\n";
@@ -707,7 +708,7 @@ let rec argspec ()      | { op_type = PasswordSelector v;
op_name = name; op_discrim = discrim;
         op_shortdesc = shortdesc; op_pod_longdesc = longdesc } ->
       pr "    (\n";
-      pr "      [ \"--%s\" ],\n" name;
+      pr "      [ L\"%s\" ],\n" name;
       pr "      Getopt.String (\n";
       pr "        s_\"%s\",\n" v;
       pr "        fun s ->\n";
@@ -720,7 +721,7 @@ let rec argspec ()      | { op_type = UserPasswordSelector
v; op_name = name; op_discrim = discrim;
         op_shortdesc = shortdesc; op_pod_longdesc = longdesc } ->
       pr "    (\n";
-      pr "      [ \"--%s\" ],\n" name;
+      pr "      [ L\"%s\" ],\n" name;
       pr "      Getopt.String (\n";
       pr "        s_\"%s\",\n" v;
       pr "        fun s ->\n";
@@ -734,7 +735,7 @@ let rec argspec ()      | { op_type = SSHKeySelector v;
op_name = name; op_discrim = discrim;
         op_shortdesc = shortdesc; op_pod_longdesc = longdesc } ->
       pr "    (\n";
-      pr "      [ \"--%s\" ],\n" name;
+      pr "      [ L\"%s\" ],\n" name;
       pr "      Getopt.String (\n";
       pr "        s_\"%s\",\n" v;
       pr "        fun s ->\n";
@@ -748,7 +749,7 @@ let rec argspec ()      | { op_type = StringFn (v, fn);
op_name = name; op_discrim = discrim;
         op_shortdesc = shortdesc; op_pod_longdesc = longdesc } ->
       pr "    (\n";
-      pr "      [ \"--%s\" ],\n" name;
+      pr "      [ L\"%s\" ],\n" name;
       pr "      Getopt.String (\n";
       pr "        s_\"%s\",\n" v;
       pr "        fun s ->\n";
@@ -761,7 +762,7 @@ let rec argspec ()      | { op_type = SMPoolSelector v;
op_name = name; op_discrim = discrim;
         op_shortdesc = shortdesc; op_pod_longdesc = longdesc } ->
       pr "    (\n";
-      pr "      [ \"--%s\" ],\n" name;
+      pr "      [ L\"%s\" ],\n" name;
       pr "      Getopt.String (\n";
       pr "        s_\"%s\",\n" v;
       pr "        fun s ->\n";
@@ -778,7 +779,7 @@ let rec argspec ()      | { flag_type = FlagBool default;
flag_ml_var = var; flag_name = name;
         flag_shortdesc = shortdesc; flag_pod_longdesc = longdesc } ->
       pr "    (\n";
-      pr "      [ \"--%s\" ],\n" name;
+      pr "      [ L\"%s\" ],\n" name;
       if default (* is true *) then
         pr "      Getopt.Clear %s,\n" var
       else
@@ -790,7 +791,7 @@ let rec argspec ()          flag_name = name; flag_shortdesc
= shortdesc;
         flag_pod_longdesc = longdesc } ->
       pr "    (\n";
-      pr "      [ \"--%s\" ],\n" name;
+      pr "      [ L\"%s\" ],\n" name;
       pr "      Getopt.String (\n";
       pr "        s_\"%s\",\n" v;
       pr "        fun s ->\n";
@@ -803,7 +804,7 @@ let rec argspec ()          flag_name = name; flag_shortdesc
= shortdesc;
         flag_pod_longdesc = longdesc } ->
       pr "    (\n";
-      pr "      [ \"--%s\" ],\n" name;
+      pr "      [ L\"%s\" ],\n" name;
       pr "      Getopt.String (\n";
       pr "        s_\"%s\",\n" v;
       pr "        fun s ->\n";
@@ -855,7 +856,7 @@ pr "    ] in
         try
           let ((_, spec, _), _, _) = List.find (
             fun ((keys, _, _), _, _) ->
-              List.mem (\"--\" ^ cmd) keys
+              List.mem (L cmd) keys
           ) argspec in
           (match spec with
           | Getopt.Unit fn -> fn ()
diff --git a/get-kernel/get_kernel.ml b/get-kernel/get_kernel.ml
index b841c5f..f83a940 100644
--- a/get-kernel/get_kernel.ml
+++ b/get-kernel/get_kernel.ml
@@ -18,6 +18,7 @@
 
 open Common_gettext.Gettext
 open Common_utils
+open Getopt.OptionName
 
 module G = Guestfs
 
@@ -51,15 +52,15 @@ let parse_cmdline ()      prefix := Some p in
 
   let argspec = [
-    [ "-a"; "--add" ],        Getopt.String
(s_"file", set_file),        s_"Add disk image file";
-    [ "-c"; "--connect" ],        Getopt.Set_string
(s_"uri", libvirturi), s_"Set libvirt URI";
-    [ "-d"; "--domain" ],        Getopt.String
(s_"domain", set_domain),      s_"Set libvirt guest name";
-    [ "--format" ],  Getopt.Set_string (s_"format",
format),      s_"Format of input disk";
-    [ "--machine-readable" ], Getopt.Set machine_readable,
s_"Make output machine readable";
-    [ "-o"; "--output" ],        Getopt.Set_string
(s_"directory", output),  s_"Output directory";
-    [ "--unversioned-names" ], Getopt.Set unversioned,
+    [ S 'a'; L"add" ],        Getopt.String
(s_"file", set_file),        s_"Add disk image file";
+    [ S 'c'; L"connect" ],        Getopt.Set_string
(s_"uri", libvirturi), s_"Set libvirt URI";
+    [ S 'd'; L"domain" ],        Getopt.String
(s_"domain", set_domain),      s_"Set libvirt guest name";
+    [ L"format" ],  Getopt.Set_string (s_"format", format),
s_"Format of input disk";
+    [ L"machine-readable" ], Getopt.Set machine_readable,
s_"Make output machine readable";
+    [ S 'o'; L"output" ],        Getopt.Set_string
(s_"directory", output),  s_"Output directory";
+    [ L"unversioned-names" ], Getopt.Set unversioned,
                                             s_"Use unversioned names for
files";
-    [ "--prefix" ],  Getopt.String (s_"prefix",
set_prefix),      s_"Prefix for files";
+    [ L"prefix" ],  Getopt.String (s_"prefix", set_prefix),
s_"Prefix for files";
   ] in
   let usage_msg      sprintf (f_"\
diff --git a/mllib/common_utils.ml b/mllib/common_utils.ml
index 3bbfa46..e7ee84a 100644
--- a/mllib/common_utils.ml
+++ b/mllib/common_utils.ml
@@ -19,6 +19,7 @@
 open Printf
 
 open Common_gettext.Gettext
+open Getopt.OptionName
 
 module Char = struct
     include Char
@@ -571,13 +572,13 @@ let create_standard_options argspec ?anon_fun usage_msg   
let set_debug_gc ()      at_exit (fun () -> Gc.compact()) in
   let argspec = [
-    [ "-V"; "--version" ], Getopt.Unit
print_version_and_exit, s_"Display version and exit";
-    [ "-v"; "--verbose" ], Getopt.Unit set_verbose, 
s_"Enable libguestfs debugging messages";
-    [ "-x" ],              Getopt.Unit set_trace,    s_"Enable
tracing of libguestfs calls";
-    [ "--debug-gc" ],      Getopt.Unit set_debug_gc,
Getopt.hidden_option_description;
-    [ "-q"; "--quiet" ],   Getopt.Unit set_quiet,   
s_"Don't print progress messages";
-    [ "--color"; "--colors";
-      "--colour"; "--colours" ], Getopt.Unit set_colours,
s_"Use ANSI colour sequences even if not tty";
+    [ S 'V'; L"version" ], Getopt.Unit
print_version_and_exit, s_"Display version and exit";
+    [ S 'v'; L"verbose" ], Getopt.Unit set_verbose, 
s_"Enable libguestfs debugging messages";
+    [ S 'x' ],             Getopt.Unit set_trace,    s_"Enable
tracing of libguestfs calls";
+    [ L"debug-gc" ],       Getopt.Unit set_debug_gc,
Getopt.hidden_option_description;
+    [ S 'q'; L"quiet" ],   Getopt.Unit set_quiet,   
s_"Don't print progress messages";
+    [ L"color"; L"colors";
+      L"colour"; L"colours" ], Getopt.Unit set_colours,
s_"Use ANSI colour sequences even if not tty";
   ] @ argspec in
   Getopt.create argspec ?anon_fun usage_msg
 
diff --git a/mllib/getopt.ml b/mllib/getopt.ml
index 550baa4..3bfcd21 100644
--- a/mllib/getopt.ml
+++ b/mllib/getopt.ml
@@ -29,7 +29,12 @@ type spec    | Int of string * (int -> unit)
   | Set_int of string * int ref
 
-type keys = string list
+module OptionName = struct
+  type option_name = S of char | L of string
+end
+open OptionName
+
+type keys = option_name list
 type doc = string
 type usage_msg = string
 type anon_fun = (string -> unit)
@@ -49,6 +54,14 @@ external getopt_parse : string array -> (c_keys * spec *
doc) array -> ?anon_fun
 
 let column_wrap = 38
 
+let string_of_option_name = function
+  | S c -> sprintf "-%c" c
+  | L s -> "--" ^ s
+
+let string_of_option_name_no_dashes = function
+  | S c -> String.make 1 c
+  | L s -> s
+
 let show_help h ()    let b = Buffer.create 1024 in
 
@@ -58,10 +71,11 @@ let show_help h ()    let prologue = sprintf
(f_"%s\nOptions:\n") h.usage_msg in
   Buffer.add_string b prologue;
 
-  let specs = List.filter (
-    fun (_, _, doc) ->
+  let specs +    List.filter (
+      fun (_, _, doc) ->
       doc <> hidden_option_description
-  ) h.specs in
+    ) h.specs in
 
   List.iter (
     fun (keys, spec, doc) ->
@@ -72,7 +86,7 @@ let show_help h ()        in
 
       add "  ";
-      add (String.concat ", " keys);
+      add (String.concat ", " (List.map string_of_option_name keys));
       let arg          match spec with
         | Unit _
@@ -109,9 +123,9 @@ let display_short_options h ()    List.iter (
     fun (args, _, _) ->
       List.iter (
-        fun arg ->
-          if is_prefix arg "-" && not (is_prefix arg
"--") then
-            printf "%s\n" arg
+        function
+        | S _ as arg -> print_endline (string_of_option_name arg)
+        | L _ -> ()
       ) args
   ) h.specs;
   exit 0
@@ -119,73 +133,44 @@ let display_long_options h ()    List.iter (
     fun (args, _, _) ->
       List.iter (
-        fun arg ->
-          if is_prefix arg "--" && arg <>
"--long-options" &&
-               arg <> "--short-options" then
-            printf "%s\n" arg
+        function
+        | L "short-options" | L "long-options"
+        | S _ -> ()
+        | L _ as arg -> print_endline (string_of_option_name arg)
       ) args
   ) h.specs;
   exit 0
 
-(* Skip any leading '-' characters when comparing command line args. *)
-let skip_dashes str -  let n = String.length str in
-  let rec loop i -    if i >= n then invalid_arg "skip_dashes"
-    else if String.unsafe_get str i = '-' then loop (i+1)
-    else i
-  in
-  let i = loop 0 in
-  if i = 0 then str
-  else String.sub str i (n-i)
-
 let compare_command_line_args a b -  compare (String.lowercase (skip_dashes a))
(String.lowercase (skip_dashes b))
+  let a = String.lowercase (string_of_option_name_no_dashes a) in
+  let b = String.lowercase (string_of_option_name_no_dashes b) in
+  compare a b
 
 let create specs ?anon_fun usage_msg    (* Sanity check the input *)
-  let validate_key key -    if String.length key == 0 || key == "-"
|| key == "--"
-       || key.[0] != '-' then
-      invalid_arg (sprintf "invalid option key: '%s'" key)
+  let validate_key = function
+    | L"" -> invalid_arg "Getopt spec: invalid empty long
option"
+    | L"help" -> invalid_arg "Getopt spec: should not have
L\"help\""
+    | L"short-options" ->
+       invalid_arg "Getopt spec: should not have
L\"short-options\""
+    | L"long-options" ->
+       invalid_arg "Getopt spec: should not have
L\"long-options\""
+    | L s when s.[0] = '-' ->
+       invalid_arg (sprintf "Getopt spec: L%S should not begin with a
dash"
+                            s)
+    | L s when String.contains s '_' ->
+       invalid_arg (sprintf "Getopt spec: L%S should not contain
'_'"
+                            s)
+    | _ -> ()
   in
-
   List.iter (
     fun (keys, spec, doc) ->
       if keys == [] then
         invalid_arg "empty keys for Getopt spec";
-      List.iter validate_key keys;
+      List.iter validate_key keys
   ) specs;
 
-  let t -    {
-      specs = [];  (* Set it later, with own options, and sorted.  *)
-      anon_fun = anon_fun;
-      usage_msg = usage_msg;
-    } in
-
-  let specs = specs @ [
-    [ "--short-options" ], Unit (display_short_options t),
hidden_option_description;
-    [ "--long-options" ], Unit (display_long_options t),
hidden_option_description;
-  ] in
-
-  (* Decide whether the help option can be added, and which switches use.  *)
-  let has_dash_help = ref false in
-  let has_dash_dash_help = ref false in
-  List.iter (
-    fun (keys, _, _) ->
-      if not (!has_dash_help) then
-        has_dash_help := List.mem "-help" keys;
-      if not (!has_dash_dash_help) then
-        has_dash_dash_help := List.mem "--help" keys;
-  ) specs;
-  let help_keys = [] @
-    (if !has_dash_help then [] else [ "-help" ]) @
-    (if !has_dash_dash_help then [] else [ "--help" ]) in
-  let specs = specs @
-    (if help_keys <> [] then [ help_keys, Unit (show_help t),
s_"Display brief help"; ] else []) in
-
-  (* Sort the specs, and set them in the handle.  *)
+  (* Sort the specs.  *)
   let specs = List.map (
     fun (keys, action, doc) ->
       List.hd (List.sort compare_command_line_args keys), (keys, action, doc)
@@ -194,14 +179,26 @@ let create specs ?anon_fun usage_msg      let cmp (arg1,
_) (arg2, _) = compare_command_line_args arg1 arg2 in
     List.sort cmp specs in
   let specs = List.map snd specs in
-  t.specs <- specs;
 
+  let t = {
+    specs = specs;
+    anon_fun = anon_fun;
+    usage_msg = usage_msg;
+  } in
+  let added_options = [
+    [ L"short-options" ], Unit (display_short_options t),
+                                         hidden_option_description;
+    [ L"long-options" ], Unit (display_long_options t),
+                                         hidden_option_description;
+    [ L"help" ], Unit (show_help t),     s_"Display brief
help";
+  ] in
+  t.specs <- added_options @ specs;
   t
 
 let parse_argv t argv    let specs = List.map (
     fun (keys, spec, doc) ->
-      Array.of_list keys, spec, doc
+      Array.of_list (List.map string_of_option_name keys), spec, doc
   ) t.specs in
   let specs = Array.of_list specs in
   getopt_parse argv specs ?anon_fun:t.anon_fun t.usage_msg
diff --git a/mllib/getopt.mli b/mllib/getopt.mli
index 2a8bada..a5951f7 100644
--- a/mllib/getopt.mli
+++ b/mllib/getopt.mli
@@ -18,29 +18,34 @@
 
 type spec    | Unit of (unit -> unit)
-    (* Simple option with no argument; call the function. *)
+    (** Simple option with no argument; call the function. *)
   | Set of bool ref
-    (* Simple option with no argument; set the reference to true. *)
+    (** Simple option with no argument; set the reference to true. *)
   | Clear of bool ref
-    (* Simple option with no argument; set the reference to false. *)
+    (** Simple option with no argument; set the reference to false. *)
   | String of string * (string -> unit)
-    (* Option requiring an argument; the first element in the tuple
-       is the documentation string of the argument, and the second
-       is the function to call. *)
+    (** Option requiring an argument; the first element in the tuple
+        is the documentation string of the argument, and the second
+        is the function to call. *)
   | Set_string of string * string ref
-    (* Option requiring an argument; the first element in the tuple
-       is the documentation string of the argument, and the second
-       is the reference to be set. *)
+    (** Option requiring an argument; the first element in the tuple
+        is the documentation string of the argument, and the second
+        is the reference to be set. *)
   | Int of string * (int -> unit)
-    (* Option requiring an integer value as argument; the first
-       element in the tuple is the documentation string of the
-       argument, and the second is the function to call. *)
+    (** Option requiring an integer value as argument; the first
+        element in the tuple is the documentation string of the
+        argument, and the second is the function to call. *)
   | Set_int of string * int ref
-    (* Option requiring an integer value as argument; the first
-       element in the tuple is the documentation string of the
-       argument, and the second is the reference to be set. *)
+    (** Option requiring an integer value as argument; the first
+        element in the tuple is the documentation string of the
+        argument, and the second is the reference to be set. *)
 
-type keys = string list
+module OptionName : sig
+  type option_name +    | S of char           (** short option like -a *)
+    | L of string         (** long option like --add *)
+end
+type keys = OptionName.option_name list
 type doc = string
 type usage_msg = string
 type anon_fun = (string -> unit)
@@ -49,9 +54,13 @@ type speclist = (keys * spec * doc) list
 
 val hidden_option_description : string
 
-val compare_command_line_args : string -> string -> int
+val compare_command_line_args : OptionName.option_name ->
OptionName.option_name -> int
 (** Compare command line arguments for equality, ignoring any leading [-]s. *)
 
+val string_of_option_name : OptionName.option_name -> string
+(** Convert an {!OptionName.option_name} to a string.  For instance
+    [L"foo"] is converted to ["--foo"]. *)
+
 type t
 (** The abstract data type. *)
 
diff --git a/resize/resize.ml b/resize/resize.ml
index 185f5a0..7d06f18 100644
--- a/resize/resize.ml
+++ b/resize/resize.ml
@@ -20,6 +20,7 @@ open Printf
 
 open Common_utils
 open Common_gettext.Gettext
+open Getopt.OptionName
 
 module G = Guestfs
 
@@ -183,26 +184,26 @@ let main ()      let unknown_fs_mode = ref
"warn" in
 
     let argspec = [
-      [ "--align-first" ], Getopt.Set_string
(s_"never|always|auto", align_first), s_"Align first partition
(default: auto)";
-      [ "--alignment" ], Getopt.Set_int (s_"sectors",
alignment),   s_"Set partition alignment (default: 128 sectors)";
-      [ "--no-copy-boot-loader" ], Getopt.Clear copy_boot_loader,
s_"Don't copy boot loader";
-      [ "-d"; "--debug" ],        Getopt.Unit set_verbose, 
s_"Enable debugging messages";
-      [ "--delete" ],  Getopt.String (s_"part", add
deletes),  s_"Delete partition";
-      [ "--expand" ],  Getopt.String (s_"part",
set_expand),     s_"Expand partition";
-      [ "--no-expand-content" ], Getopt.Clear expand_content,
s_"Don't expand content";
-      [ "--no-extra-partition" ], Getopt.Clear extra_partition,
s_"Don't create extra partition";
-      [ "--format" ],  Getopt.Set_string (s_"format",
format),     s_"Format of input disk";
-      [ "--ignore" ],  Getopt.String (s_"part", add
ignores),  s_"Ignore partition";
-      [ "--lv-expand"; "--LV-expand";
"--lvexpand"; "--LVexpand" ], Getopt.String
(s_"lv", add lv_expands), s_"Expand logical volume";
-      [ "--machine-readable" ], Getopt.Set machine_readable,
s_"Make output machine readable";
-      [ "-n"; "--dry-run"; "--dryrun" ],       
Getopt.Set dryrun,            s_"Don't perform changes";
-      [ "--ntfsresize-force" ], Getopt.Set ntfsresize_force,
s_"Force ntfsresize";
-      [ "--output-format" ], Getopt.Set_string (s_"format",
output_format), s_"Format of output disk";
-      [ "--resize" ],  Getopt.String (s_"part=size", add
resizes),  s_"Resize partition";
-      [ "--resize-force" ], Getopt.String (s_"part=size",
add resizes_force), s_"Forcefully resize partition";
-      [ "--shrink" ],  Getopt.String (s_"part",
set_shrink),     s_"Shrink partition";
-      [ "--no-sparse" ], Getopt.Clear sparse,        s_"Turn off
sparse copying";
-      [ "--unknown-filesystems" ], Getopt.Set_string
(s_"ignore|warn|error", unknown_fs_mode),
+      [ L"align-first" ], Getopt.Set_string
(s_"never|always|auto", align_first), s_"Align first partition
(default: auto)";
+      [ L"alignment" ], Getopt.Set_int (s_"sectors",
alignment),   s_"Set partition alignment (default: 128 sectors)";
+      [ L"no-copy-boot-loader" ], Getopt.Clear copy_boot_loader,
s_"Don't copy boot loader";
+      [ S 'd'; L"debug" ],        Getopt.Unit set_verbose,   
s_"Enable debugging messages";
+      [ L"delete" ],  Getopt.String (s_"part", add
deletes),  s_"Delete partition";
+      [ L"expand" ],  Getopt.String (s_"part", set_expand),
s_"Expand partition";
+      [ L"no-expand-content" ], Getopt.Clear expand_content,
s_"Don't expand content";
+      [ L"no-extra-partition" ], Getopt.Clear extra_partition,
s_"Don't create extra partition";
+      [ L"format" ],  Getopt.Set_string (s_"format",
format),     s_"Format of input disk";
+      [ L"ignore" ],  Getopt.String (s_"part", add
ignores),  s_"Ignore partition";
+      [ L"lv-expand"; L"LV-expand"; L"lvexpand";
L"LVexpand" ], Getopt.String (s_"lv", add lv_expands),
s_"Expand logical volume";
+      [ L"machine-readable" ], Getopt.Set machine_readable,
s_"Make output machine readable";
+      [ S 'n'; L"dry-run"; L"dryrun" ],       
Getopt.Set dryrun,            s_"Don't perform changes";
+      [ L"ntfsresize-force" ], Getopt.Set ntfsresize_force,
s_"Force ntfsresize";
+      [ L"output-format" ], Getopt.Set_string (s_"format",
output_format), s_"Format of output disk";
+      [ L"resize" ],  Getopt.String (s_"part=size", add
resizes),  s_"Resize partition";
+      [ L"resize-force" ], Getopt.String (s_"part=size",
add resizes_force), s_"Forcefully resize partition";
+      [ L"shrink" ],  Getopt.String (s_"part", set_shrink),
s_"Shrink partition";
+      [ L"no-sparse" ], Getopt.Clear sparse,        s_"Turn off
sparse copying";
+      [ L"unknown-filesystems" ], Getopt.Set_string
(s_"ignore|warn|error", unknown_fs_mode),
                                               s_"Behaviour on expand
unknown filesystems (default: warn)";
     ] in
     let disks = ref [] in
diff --git a/sparsify/cmdline.ml b/sparsify/cmdline.ml
index 3593e26..3eb0d5b 100644
--- a/sparsify/cmdline.ml
+++ b/sparsify/cmdline.ml
@@ -22,6 +22,7 @@ open Printf
 
 open Common_gettext.Gettext
 open Common_utils
+open Getopt.OptionName
 
 open Utils
 
@@ -64,16 +65,16 @@ let parse_cmdline ()    let zeroes = ref [] in
 
   let argspec = [
-    [ "--check-tmpdir" ], Getopt.String ("ignore|...",
set_check_tmpdir),  s_"Check there is enough space in $TMPDIR";
-    [ "--compress" ], Getopt.Set compress,         s_"Compressed
output format";
-    [ "--convert" ], Getopt.Set_string (s_"format",
convert),    s_"Format of output disk (default: same as input)";
-    [ "--format" ],  Getopt.Set_string (s_"format",
format),     s_"Format of input disk";
-    [ "--ignore" ],  Getopt.String (s_"fs", add ignores), 
s_"Ignore filesystem";
-    [ "--in-place"; "--inplace" ], Getopt.Set in_place,    
s_"Modify the disk image in-place";
-    [ "--machine-readable" ], Getopt.Set machine_readable,
s_"Make output machine readable";
-    [ "-o" ],        Getopt.Set_string (s_"option",
option),     s_"Add qemu-img options";
-    [ "--tmp" ],     Getopt.Set_string
(s_"block|dir|prebuilt:file", tmp),        s_"Set temporary block
device, directory or prebuilt file";
-    [ "--zero" ],    Getopt.String (s_"fs", add zeroes),  
s_"Zero filesystem";
+    [ L"check-tmpdir" ], Getopt.String ("ignore|...",
set_check_tmpdir),  s_"Check there is enough space in $TMPDIR";
+    [ L"compress" ], Getopt.Set compress,         s_"Compressed
output format";
+    [ L"convert" ], Getopt.Set_string (s_"format",
convert),    s_"Format of output disk (default: same as input)";
+    [ L"format" ],  Getopt.Set_string (s_"format", format),
s_"Format of input disk";
+    [ L"ignore" ],  Getopt.String (s_"fs", add ignores), 
s_"Ignore filesystem";
+    [ L"in-place"; L"inplace" ], Getopt.Set in_place,      
s_"Modify the disk image in-place";
+    [ L"machine-readable" ], Getopt.Set machine_readable,
s_"Make output machine readable";
+    [ S 'o' ],        Getopt.Set_string (s_"option", option),
s_"Add qemu-img options";
+    [ L"tmp" ],     Getopt.Set_string
(s_"block|dir|prebuilt:file", tmp),        s_"Set temporary block
device, directory or prebuilt file";
+    [ L"zero" ],    Getopt.String (s_"fs", add zeroes),  
s_"Zero filesystem";
   ] in
   let disks = ref [] in
   let anon_fun s = push_front s disks in
diff --git a/sysprep/main.ml b/sysprep/main.ml
index b2df880..01ea590 100644
--- a/sysprep/main.ml
+++ b/sysprep/main.ml
@@ -21,6 +21,7 @@ open Printf
 
 open Common_utils
 open Common_gettext.Gettext
+open Getopt.OptionName
 
 open Sysprep_operation
 
@@ -117,21 +118,21 @@ let main ()      in
 
     let basic_args = [
-      [ "-a"; "--add" ],        Getopt.String
(s_"file", add_file),        s_"Add disk image file";
-      [ "-c"; "--connect" ],        Getopt.Set_string
(s_"uri", libvirturi),  s_"Set libvirt URI";
-      [ "-d"; "--domain" ],        Getopt.String
(s_"domain", set_domain),      s_"Set libvirt guest name";
-      [ "-n"; "--dryrun"; "--dry-run" ],       
Getopt.Set dryrun,            s_"Perform a dry run";
-      [ "--dump-pod" ], Getopt.Unit dump_pod,       
Getopt.hidden_option_description;
-      [ "--dump-pod-options" ], Getopt.Unit dump_pod_options,
Getopt.hidden_option_description;
-      [ "--enable" ],  Getopt.String (s_"operations",
set_enable),      s_"Enable specific operations";
-      [ "--format" ],  Getopt.String (s_"format",
set_format),      s_"Set format (default: auto)";
-      [ "--list-operations" ], Getopt.Unit list_operations,
s_"List supported operations";
-      [ "--mount-options" ], Getopt.Set_string (s_"opts",
mount_opts),  s_"Set mount options (eg /:noatime;/var:rw,noatime)";
-      [ "--network" ], Getopt.Set network,           s_"Enable
appliance network";
-      [ "--no-network" ], Getopt.Clear network,      s_"Disable
appliance network (default)";
-      [ "--no-selinux-relabel" ], Getopt.Unit (fun () -> ()),
+      [ S 'a'; L"add" ],        Getopt.String
(s_"file", add_file),        s_"Add disk image file";
+      [ S 'c'; L"connect" ],        Getopt.Set_string
(s_"uri", libvirturi),  s_"Set libvirt URI";
+      [ S 'd'; L"domain" ],        Getopt.String
(s_"domain", set_domain),      s_"Set libvirt guest name";
+      [ S 'n'; L"dryrun"; L"dry-run" ],       
Getopt.Set dryrun,            s_"Perform a dry run";
+      [ L"dump-pod" ], Getopt.Unit dump_pod,       
Getopt.hidden_option_description;
+      [ L"dump-pod-options" ], Getopt.Unit dump_pod_options,
Getopt.hidden_option_description;
+      [ L"enable" ],  Getopt.String (s_"operations",
set_enable),      s_"Enable specific operations";
+      [ L"format" ],  Getopt.String (s_"format",
set_format),      s_"Set format (default: auto)";
+      [ L"list-operations" ], Getopt.Unit list_operations,
s_"List supported operations";
+      [ L"mount-options" ], Getopt.Set_string (s_"opts",
mount_opts),  s_"Set mount options (eg /:noatime;/var:rw,noatime)";
+      [ L"network" ], Getopt.Set network,           s_"Enable
appliance network";
+      [ L"no-network" ], Getopt.Clear network,      s_"Disable
appliance network (default)";
+      [ L"no-selinux-relabel" ], Getopt.Unit (fun () -> ()),
                                               s_"Compatibility option,
does nothing";
-      [ "--operation"; "--operations" ],  Getopt.String
(s_"operations", set_operations), s_"Enable/disable specific
operations";
+      [ L"operation"; L"operations" ],  Getopt.String
(s_"operations", set_operations), s_"Enable/disable specific
operations";
     ] in
     let args = basic_args @ Sysprep_operation.extra_args () in
     let usage_msg diff --git a/sysprep/sysprep_operation.ml
b/sysprep/sysprep_operation.ml
index b4d650f..4ccd03c 100644
--- a/sysprep/sysprep_operation.ml
+++ b/sysprep/sysprep_operation.ml
@@ -21,6 +21,7 @@ open Common_utils
 open Printf
 
 open Common_gettext.Gettext
+open Getopt.OptionName
 
 class filesystem_side_effects  object
@@ -215,7 +216,8 @@ let dump_pod_options ()           extra_pod_description =
pod }) ->
       List.map (
         fun arg_name ->
-          let heading = sprintf "B<%s>" arg_name in
+          let heading +            sprintf "B<%s>"
(Getopt.string_of_option_name arg_name) in
           arg_name, (op_name, heading, pod)
       ) arg_names
 
@@ -228,7 +230,9 @@ let dump_pod_options ()           extra_pod_description =
pod }) ->
       List.map (
         fun arg_name ->
-          let heading = sprintf "B<%s> %s" arg_name arg_val in
+          let heading +            sprintf "B<%s> %s"
+                    (Getopt.string_of_option_name arg_name) arg_val in
           arg_name, (op_name, heading, pod)
       ) arg_names
 
diff --git a/sysprep/sysprep_operation_script.ml
b/sysprep/sysprep_operation_script.ml
index cc0ec9b..ff4b073 100644
--- a/sysprep/sysprep_operation_script.ml
+++ b/sysprep/sysprep_operation_script.ml
@@ -21,6 +21,7 @@ open Unix
 
 open Common_gettext.Gettext
 open Common_utils
+open Getopt.OptionName
 
 open Sysprep_operation
 
@@ -129,7 +130,7 @@ B<Note:> This is different from I<--firstboot>
scripts (which run
 in the context of the guest when it is booting first time).
 I<--script> scripts run on the host, not in the guest.");
     extra_args = [
-      { extra_argspec = [ "--scriptdir" ], Getopt.String
(s_"dir", set_scriptdir), s_"Mount point on host";
+      { extra_argspec = [ L"scriptdir" ], Getopt.String
(s_"dir", set_scriptdir), s_"Mount point on host";
         extra_pod_argval = Some "SCRIPTDIR";
         extra_pod_description = s_"\
 The mount point (an empty directory on the host) used when
@@ -142,7 +143,7 @@ If I<--scriptdir> is not specified then a temporary
mountpoint
 will be created."
       };
 
-      { extra_argspec = [ "--script" ], Getopt.String
(s_"script", add_script), s_"Script or program to run on
guest";
+      { extra_argspec = [ L"script" ], Getopt.String
(s_"script", add_script), s_"Script or program to run on
guest";
         extra_pod_argval = Some "SCRIPT";
         extra_pod_description = s_"\
 Run the named C<SCRIPT> (a shell script or program) against the
diff --git a/sysprep/sysprep_operation_user_account.ml
b/sysprep/sysprep_operation_user_account.ml
index cf7dc57..6f44b9d 100644
--- a/sysprep/sysprep_operation_user_account.ml
+++ b/sysprep/sysprep_operation_user_account.ml
@@ -21,6 +21,7 @@ open Printf
 
 open Common_utils
 open Common_gettext.Gettext
+open Getopt.OptionName
 
 open Sysprep_operation
 
@@ -109,7 +110,7 @@ The \"root\" account is not removed.
 See the I<--remove-user-accounts> parameter for a way to specify
 how to remove only some users, or to not remove some others.");
     extra_args = [
-      { extra_argspec = [ "--remove-user-accounts" ], Getopt.String
(s_"users", add_users remove_users), s_"Users to remove";
+      { extra_argspec = [ L"remove-user-accounts" ], Getopt.String
(s_"users", add_users remove_users), s_"Users to remove";
         extra_pod_argval = Some "USERS";
         extra_pod_description = s_"\
 The user accounts to be removed from the guest.
@@ -124,7 +125,7 @@ would only remove the user accounts C<bob> and
C<eve>.
 This option can be specified multiple times."
       };
 
-      { extra_argspec = [ "--keep-user-accounts" ], Getopt.String
(s_"users", add_users keep_users), s_"Users to keep";
+      { extra_argspec = [ L"keep-user-accounts" ], Getopt.String
(s_"users", add_users keep_users), s_"Users to keep";
         extra_pod_argval = Some "USERS";
         extra_pod_description = s_"\
 The user accounts to be kept in the guest.
diff --git a/v2v/cmdline.ml b/v2v/cmdline.ml
index e704bd4..cb8397f 100644
--- a/v2v/cmdline.ml
+++ b/v2v/cmdline.ml
@@ -22,6 +22,7 @@ open Printf
 
 open Common_gettext.Gettext
 open Common_utils
+open Getopt.OptionName
 
 open Types
 open Utils
@@ -165,45 +166,45 @@ let parse_cmdline ()      String.concat "|"
(Modules_list.output_modules ()) in
 
   let argspec = [
-    [ "-b"; "--bridge" ],        Getopt.String
("in:out", add_bridge),     s_"Map bridge 'in' to
'out'";
-    [ "--compressed" ], Getopt.Set compressed,     s_"Compress
output file";
-    [ "--dcpath"; "--dcPath" ],  Getopt.String
("path", set_string_option_once "--dcpath" dcpath),
+    [ S 'b'; L"bridge" ],        Getopt.String
("in:out", add_bridge),     s_"Map bridge 'in' to
'out'";
+    [ L"compressed" ], Getopt.Set compressed,     s_"Compress
output file";
+    [ L"dcpath"; L"dcPath" ],  Getopt.String
("path", set_string_option_once "--dcpath" dcpath),
                                             s_"Override dcPath (for
vCenter)";
-    [ "--debug-overlay"; "--debug-overlays" ], Getopt.Set
debug_overlays, s_"Save overlay files";
-    [ "-i" ],        Getopt.String (i_options, set_input_mode),
s_"Set input mode (default: libvirt)";
-    [ "-ic" ],       Getopt.String ("uri",
set_string_option_once "-ic" input_conn),
+    [ L"debug-overlay"; L"debug-overlays" ], Getopt.Set
debug_overlays, s_"Save overlay files";
+    [ S 'i' ],        Getopt.String (i_options, set_input_mode),
s_"Set input mode (default: libvirt)";
+    [ L"ic" ],       Getopt.String ("uri",
set_string_option_once "-ic" input_conn),
                                             s_"Libvirt URI";
-    [ "-if" ],       Getopt.String ("format",
set_string_option_once "-if" input_format),
+    [ L"if" ],       Getopt.String ("format",
set_string_option_once "-if" input_format),
                                             s_"Input format (for -i
disk)";
-    [ "--in-place" ], Getopt.Set in_place,         s_"Only tune
the guest in the input VM";
-    [ "--machine-readable" ], Getopt.Set machine_readable,
s_"Make output machine readable";
-    [ "-n"; "--network" ],        Getopt.String
("in:out", add_network),    s_"Map network 'in' to
'out'";
-    [ "--no-copy" ], Getopt.Clear do_copy,         s_"Just write
the metadata";
-    [ "--no-trim" ], Getopt.String ("-", no_trim_warning),
+    [ L"in-place" ], Getopt.Set in_place,         s_"Only tune
the guest in the input VM";
+    [ L"machine-readable" ], Getopt.Set machine_readable,
s_"Make output machine readable";
+    [ S 'n'; L"network" ],        Getopt.String
("in:out", add_network),    s_"Map network 'in' to
'out'";
+    [ L"no-copy" ], Getopt.Clear do_copy,         s_"Just write
the metadata";
+    [ L"no-trim" ], Getopt.String ("-", no_trim_warning),
                                             s_"Ignored for backwards
compatibility";
-    [ "-o" ],        Getopt.String (o_options, set_output_mode),
s_"Set output mode (default: libvirt)";
-    [ "-oa" ],       Getopt.String ("sparse|preallocated",
set_output_alloc),
+    [ S 'o' ],        Getopt.String (o_options, set_output_mode),
s_"Set output mode (default: libvirt)";
+    [ L"oa" ],       Getopt.String ("sparse|preallocated",
set_output_alloc),
                                             s_"Set output allocation
mode";
-    [ "-oc" ],       Getopt.String ("uri",
set_string_option_once "-oc" output_conn),
+    [ L"oc" ],       Getopt.String ("uri",
set_string_option_once "-oc" output_conn),
                                             s_"Libvirt URI";
-    [ "-of" ],       Getopt.String ("raw|qcow2",
set_string_option_once "-of" output_format),
+    [ L"of" ],       Getopt.String ("raw|qcow2",
set_string_option_once "-of" output_format),
                                             s_"Set output format";
-    [ "-on" ],       Getopt.String ("name",
set_string_option_once "-on" output_name),
+    [ L"on" ],       Getopt.String ("name",
set_string_option_once "-on" output_name),
                                             s_"Rename guest when
converting";
-    [ "-os" ],       Getopt.String ("storage",
set_string_option_once "-os" output_storage),
+    [ L"os" ],       Getopt.String ("storage",
set_string_option_once "-os" output_storage),
                                             s_"Set output storage
location";
-    [ "--password-file" ], Getopt.String ("file",
set_string_option_once "--password-file" password_file),
+    [ L"password-file" ], Getopt.String ("file",
set_string_option_once "--password-file" password_file),
                                             s_"Use password from
file";
-    [ "--print-source" ], Getopt.Set print_source, s_"Print
source and stop";
-    [ "--qemu-boot" ], Getopt.Set qemu_boot,       s_"Boot in
qemu (-o qemu only)";
-    [ "--root" ],    Getopt.String ("ask|... ",
set_root_choice), s_"How to choose root filesystem";
-    [ "--vdsm-image-uuid" ], Getopt.String ("uuid",
add_vdsm_image_uuid), s_"Output image UUID(s)";
-    [ "--vdsm-vol-uuid" ], Getopt.String ("uuid",
add_vdsm_vol_uuid), s_"Output vol UUID(s)";
-    [ "--vdsm-vm-uuid" ], Getopt.String ("uuid",
set_string_option_once "--vdsm-vm-uuid" vdsm_vm_uuid),
+    [ L"print-source" ], Getopt.Set print_source, s_"Print
source and stop";
+    [ L"qemu-boot" ], Getopt.Set qemu_boot,       s_"Boot in
qemu (-o qemu only)";
+    [ L"root" ],    Getopt.String ("ask|... ",
set_root_choice), s_"How to choose root filesystem";
+    [ L"vdsm-image-uuid" ], Getopt.String ("uuid",
add_vdsm_image_uuid), s_"Output image UUID(s)";
+    [ L"vdsm-vol-uuid" ], Getopt.String ("uuid",
add_vdsm_vol_uuid), s_"Output vol UUID(s)";
+    [ L"vdsm-vm-uuid" ], Getopt.String ("uuid",
set_string_option_once "--vdsm-vm-uuid" vdsm_vm_uuid),
                                             s_"Output VM UUID";
-    [ "--vdsm-ovf-output" ], Getopt.String ("-",
set_string_option_once "--vdsm-ovf-output" vdsm_ovf_output),
+    [ L"vdsm-ovf-output" ], Getopt.String ("-",
set_string_option_once "--vdsm-ovf-output" vdsm_ovf_output),
                                             s_"Output OVF file";
-    [ "--vmtype" ],  Getopt.String ("-", vmtype_warning),
+    [ L"vmtype" ],  Getopt.String ("-", vmtype_warning),
                                             s_"Ignored for backwards
compatibility";
   ] in
   let args = ref [] in
diff --git a/v2v/copy_to_local.ml b/v2v/copy_to_local.ml
index fe34413..ecfaf29 100644
--- a/v2v/copy_to_local.ml
+++ b/v2v/copy_to_local.ml
@@ -22,6 +22,7 @@ open Printf
 
 open Common_gettext.Gettext
 open Common_utils
+open Getopt.OptionName
 
 open Utils
 
@@ -41,9 +42,9 @@ let rec main ()  
   (* Handle the command line. *)
   let argspec = [
-    [ "-ic" ],       Getopt.String ("uri",
set_string_option_once "-ic" input_conn),
+    [ L"ic" ],       Getopt.String ("uri",
set_string_option_once "-ic" input_conn),
                                             s_"Libvirt URI";
-    [ "--password-file" ], Getopt.String ("file",
set_string_option_once "--password-file" password_file),
+    [ L"password-file" ], Getopt.String ("file",
set_string_option_once "--password-file" password_file),
                                             s_"Use password from
file";
   ] in
   let args = ref [] in
-- 
2.7.4

Richard W.M. Jones

2016-Jul-18 10:46 UTC

head link

[Libguestfs] [PATCH v2 3/3] mllib: tests: Add tests of the new Getopt module.

---
 .gitignore            |   1 +
 mllib/Makefile.am     |  30 ++++++++-
 mllib/getopt_tests.ml |  68 ++++++++++++++++++++
 mllib/test-getopt.sh  | 167 ++++++++++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 264 insertions(+), 2 deletions(-)
 create mode 100644 mllib/getopt_tests.ml
 create mode 100755 mllib/test-getopt.sh

diff --git a/.gitignore b/.gitignore
index 000e984..c1ae484 100644
--- a/.gitignore
+++ b/.gitignore
@@ -295,6 +295,7 @@ Makefile.in
 /mllib/common_gettext.ml
 /mllib/common_utils_tests
 /mllib/dummy
+/mllib/getopt_tests
 /mllib/guestfs_config.ml
 /mllib/JSON_tests
 /mllib/libdir.ml
diff --git a/mllib/Makefile.am b/mllib/Makefile.am
index 4f50c52..dc36f26 100644
--- a/mllib/Makefile.am
+++ b/mllib/Makefile.am
@@ -162,6 +162,15 @@ common_utils_tests_CPPFLAGS = \
 common_utils_tests_BOBJECTS = common_utils_tests.cmo
 common_utils_tests_XOBJECTS = $(common_utils_tests_BOBJECTS:.cmo=.cmx)
 
+getopt_tests_SOURCES = dummy.c
+getopt_tests_CPPFLAGS = \
+	-I. \
+	-I$(top_builddir) \
+	-I$(shell $(OCAMLC) -where) \
+	-I$(top_srcdir)/src
+getopt_tests_BOBJECTS = getopt_tests.cmo
+getopt_tests_XOBJECTS = $(getopt_tests_BOBJECTS:.cmo=.cmx)
+
 JSON_tests_SOURCES = dummy.c
 JSON_tests_BOBJECTS = JSON_tests.cmo
 JSON_tests_XOBJECTS = $(JSON_tests_BOBJECTS:.cmo=.cmx)
@@ -171,16 +180,24 @@ if !HAVE_OCAMLOPT
 common_utils_tests_THEOBJECTS = $(common_utils_tests_BOBJECTS)
 common_utils_tests.cmo: OCAMLPACKAGES += $(OCAMLPACKAGES_TESTS)
 
+getopt_tests_THEOBJECTS = $(getopt_tests_BOBJECTS)
+getopt_tests.cmo: OCAMLPACKAGES += $(OCAMLPACKAGES_TESTS)
+
 JSON_tests_THEOBJECTS = $(JSON_tests_BOBJECTS)
 JSON_tests.cmo: OCAMLPACKAGES += $(OCAMLPACKAGES_TESTS)
+
 BEST    = c
 OCAMLLINKFLAGS = mlguestfs.cma -custom
 else
 common_utils_tests_THEOBJECTS = $(common_utils_tests_XOBJECTS)
 common_utils_tests.cmx: OCAMLPACKAGES += $(OCAMLPACKAGES_TESTS)
 
+getopt_tests_THEOBJECTS = $(getopt_tests_XOBJECTS)
+getopt_tests.cmx: OCAMLPACKAGES += $(OCAMLPACKAGES_TESTS)
+
 JSON_tests_THEOBJECTS = $(JSON_tests_XOBJECTS)
 JSON_tests.cmx: OCAMLPACKAGES += $(OCAMLPACKAGES_TESTS)
+
 BEST    = opt
 OCAMLLINKFLAGS = mlguestfs.cmxa
 endif
@@ -192,6 +209,13 @@ common_utils_tests_LINK = \
 	  $(OCAMLPACKAGES) $(OCAMLPACKAGES_TESTS) \
 	  $(common_utils_tests_THEOBJECTS) -o $@
 
+getopt_tests_DEPENDENCIES = $(getopt_tests_THEOBJECTS)
$(top_srcdir)/ocaml-link.sh
+getopt_tests_LINK = \
+	$(top_srcdir)/ocaml-link.sh -cclib '-lutils $(LIBXML2_LIBS) -lgnu' --
\
+	  $(OCAMLFIND) $(BEST) $(OCAMLFLAGS) $(OCAMLLINKFLAGS) \
+	  $(OCAMLPACKAGES) $(OCAMLPACKAGES_TESTS) \
+	  $(getopt_tests_THEOBJECTS) -o $@
+
 JSON_tests_DEPENDENCIES = $(JSON_tests_THEOBJECTS) $(top_srcdir)/ocaml-link.sh
 JSON_tests_LINK = \
 	$(top_srcdir)/ocaml-link.sh -- \
@@ -201,8 +225,10 @@ JSON_tests_LINK = \
 
 TESTS_ENVIRONMENT = $(top_builddir)/run --test
 
-TESTS -check_PROGRAMS +TESTS = \
+	test-getopt.sh
+check_PROGRAMS = \
+	getopt_tests
 
 if HAVE_OCAML_PKG_OUNIT
 check_PROGRAMS += common_utils_tests JSON_tests
diff --git a/mllib/getopt_tests.ml b/mllib/getopt_tests.ml
new file mode 100644
index 0000000..fb089ec
--- /dev/null
+++ b/mllib/getopt_tests.ml
@@ -0,0 +1,68 @@
+(* mllib
+ * Copyright (C) 2016 Red Hat Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along
+ * with this program; if not, write to the Free Software Foundation, Inc.,
+ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+(* Test the Getopt module.  The tests are controlled by the
+ * test-getopt.sh script.
+ *)
+
+open Printf
+
+open Common_utils
+open Getopt.OptionName
+
+let adds = ref []
+let add_string = push_back adds
+
+let anons = ref []
+let anon_fun = push_back anons
+
+let ints = ref []
+let add_int = push_back ints
+
+let clear_flag = ref true
+let set_flag = ref false
+let si = ref 42
+let ss = ref "not set"
+
+let argspec = [
+  [ S 'a'; L"add" ],  Getopt.String ("string",
add_string), "Add string";
+  [ S 'c'; L"clear" ], Getopt.Clear clear_flag, "Clear
flag";
+  [ S 'i'; L"int" ], Getopt.Int ("int", add_int),
"Add int";
+  [ L"si"; L"set-int" ], Getopt.Set_int ("int",
si), "Set int";
+  [ L"ss"; L"set-string"], Getopt.Set_string
("string", ss), "Set string";
+  [ S 't'; L"set" ], Getopt.Set set_flag, "Set
flag";
+]
+
+let usage_msg = sprintf "%s: test the Getopt parser" prog
+
+let opthandle = create_standard_options argspec ~anon_fun usage_msg
+let () +  Getopt.parse opthandle;
+
+  (* Implicit settings. *)
+  printf "trace = %b\n" (trace ());
+  printf "verbose = %b\n" (verbose ());
+
+  (* Print the results. *)
+  printf "adds = [%s]\n" (String.concat ", " !adds);
+  printf "anons = [%s]\n" (String.concat ", " !anons);
+  printf "ints = [%s]\n" (String.concat ", " (List.map
string_of_int !ints));
+  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
diff --git a/mllib/test-getopt.sh b/mllib/test-getopt.sh
new file mode 100755
index 0000000..73a59df
--- /dev/null
+++ b/mllib/test-getopt.sh
@@ -0,0 +1,167 @@
+#!/bin/bash -
+# libguestfs
+# Copyright (C) 2016 Red Hat Inc.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+# Test the Getopt module.
+# See also: getopt_tests.ml
+
+set -e
+set -x
+
+t=./getopt_tests
+
+expect_fail ()
+{
+    if "$@"; then
+        echo "$@" ": this command was expected to exit with an
error"
+        exit 1
+    fi
+}
+
+# Program works.
+$t
+
+# Flags added automatically by Common_utils.
+$t | grep '^trace = false'
+$t | grep '^verbose = false'
+
+$t -x | grep '^trace = true'
+$t --verbose | grep '^verbose = true'
+
+# --help
+$t --help | grep '^getopt_tests: test the Getopt parser'
+$t --help | grep '^Options:'
+$t --help | grep -- '-i, --int <int>'
+$t --help | grep -- '-v, --verbose'
+$t --help | grep -- '-x'
+
+# --version
+$t --version | grep '^getopt_tests 1\.'
+
+# --short-options
+$t --short-options | grep '^-a'
+$t --short-options | grep '^-c'
+$t --short-options | grep '^-i'
+$t --short-options | grep '^-q'
+$t --short-options | grep '^-t'
+$t --short-options | grep '^-V'
+$t --short-options | grep '^-v'
+$t --short-options | grep '^-x'
+
+# --long-options
+$t --long-options | grep '^--help'
+$t --long-options | grep '^--add'
+$t --long-options | grep '^--clear'
+$t --long-options | grep '^--color'
+$t --long-options | grep '^--colors'
+$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 '^--quiet'
+$t --long-options | grep '^--set'
+$t --long-options | grep '^--set-int'
+$t --long-options | grep '^--set-string'
+$t --long-options | grep '^--si'
+$t --long-options | grep '^--ss'
+$t --long-options | grep '^--version'
+$t --long-options | grep '^--verbose'
+
+# -a/--add parameter.
+$t | grep '^adds = \[\]'
+$t -a A | grep '^adds = \[A\]'
+$t -a A -a B | grep '^adds = \[A, B\]'
+$t --add A | grep '^adds = \[A\]'
+$t --add A -a B | grep '^adds = \[A, B\]'
+expect_fail $t -a
+expect_fail $t --add
+
+# -c/--clear parameter.
+$t | grep '^clear_flag = true'
+$t -c | grep '^clear_flag = false'
+$t --clear | grep '^clear_flag = false'
+
+# -i/--int parameter.
+$t | grep '^ints = \[\]'
+$t -i 1 | grep '^ints = \[1\]'
+$t -i 1 -i 2 | grep '^ints = \[1, 2\]'
+$t -i 1 --int 2 --int 3 | grep '^ints = \[1, 2, 3\]'
+expect_fail $t --int
+
+# Non-integer parameters.
+expect_fail $t --int --int
+expect_fail $t --int ""
+expect_fail $t --int ABC
+expect_fail $t --int 0.3
+expect_fail $t --int 0E
+expect_fail $t --int 0ABC
+
+# Negative and large integer parameters.
+# All int parameters must be within signed 31 bit (even on 64 bit arch),
+# and anything else should be rejected.
+$t -i -1 | grep '^ints = \[-1\]'
+$t -i -1073741824 | grep '^ints = \[-1073741824\]'
+$t -i  1073741823 | grep '^ints = \[1073741823\]'
+expect_fail $t -i -1073741825
+expect_fail $t -i  1073741824
+expect_fail $t -i -2147483648
+expect_fail $t -i  2147483647
+expect_fail $t -i -4611686018427387904
+expect_fail $t -i  4611686018427387903
+expect_fail $t -i -9223372036854775808
+expect_fail $t -i  9223372036854775807
+
+# -t/--set parameter.
+$t | grep '^set_flag = false'
+$t -t | grep '^set_flag = true'
+$t --set | grep '^set_flag = true'
+
+# --si/--set-int parameter.
+$t | grep '^set_int = 42'
+$t --si 1 | grep '^set_int = 1'
+$t --set-int 2 | grep '^set_int = 2'
+expect_fail $t --si
+expect_fail $t --set-int
+expect_fail $t --set-int -i
+expect_fail $t --set-int ""
+expect_fail $t --set-int ABC
+expect_fail $t --set-int 0.3
+expect_fail $t --set-int 1e1
+expect_fail $t --set-int 0E
+expect_fail $t --set-int 0ABC
+
+# --ss/--set-string parameter.
+$t | grep '^set_string = not set'
+$t --ss A | grep '^set_string = A'
+$t --set-string B | grep '^set_string = B'
+expect_fail $t --ss
+expect_fail $t --set-string
+
+# Anonymous parameters.
+$t | grep '^anons = \[\]'
+$t 1 | grep '^anons = \[1\]'
+$t 1 2 3 | grep '^anons = \[1, 2, 3\]'
+
+# Grouping single letter options.
+$t -cti1 | grep '^clear_flag = false'
+$t -cti1 | grep '^set_flag = true'
+$t -cti1 | grep '^ints = \[1\]'
+$t -i1 -i2 | grep '^ints = \[1, 2\]'
+
+# Short versions of long options (used by virt-v2v).
+$t -si 1 | grep '^set_int = 1'
+$t -ss A | grep '^set_string = A'
-- 
2.7.4

Pino Toscano

2016-Jul-18 13:21 UTC

head link

Re: [Libguestfs] [PATCH v2 2/3] mllib: Use L"..." and S '...' for long and short options.

On Monday, 18 July 2016 11:46:46 CEST Richard W.M. Jones
wrote:> ---
Note that this changes the way -foo options are handled: this basically
makes them as --foo, but still working as -foo because getopt_long_only
is used.  IMHO either add a new M".." ([M]edium or [T]runcated or
[D]ash or ...), or turn S to get a string instead.
> -  let validate_key key > -    if String.length key == 0 || key ==
"-" || key == "--"
> -       || key.[0] != '-' then
> -      invalid_arg (sprintf "invalid option key: '%s'"
key)
> +  let validate_key = function
> +    | L"" -> invalid_arg "Getopt spec: invalid empty
long option"
> +    | L"help" -> invalid_arg "Getopt spec: should not
have L\"help\""
Theoretically both Arg and the current Getopt allow applications to
provide an own handler for --help, instead of the built-in one.
> +    | L s when String.contains s '_' ->
> +       invalid_arg (sprintf "Getopt spec: L%S should not contain
'_'"
> +                            s)
Why this limitation?
> -  let t > -    {
> -      specs = [];  (* Set it later, with own options, and sorted.  *)
> -      anon_fun = anon_fun;
> -      usage_msg = usage_msg;
> -    } in
> -
> -  let specs = specs @ [
> -    [ "--short-options" ], Unit (display_short_options t),
hidden_option_description;
> -    [ "--long-options" ], Unit (display_long_options t),
hidden_option_description;
> -  ] in
> -
> -  (* Decide whether the help option can be added, and which switches use. 
*)
> -  let has_dash_help = ref false in
> -  let has_dash_dash_help = ref false in
> -  List.iter (
> -    fun (keys, _, _) ->
> -      if not (!has_dash_help) then
> -        has_dash_help := List.mem "-help" keys;
> -      if not (!has_dash_dash_help) then
> -        has_dash_dash_help := List.mem "--help" keys;
> -  ) specs;
> -  let help_keys = [] @
> -    (if !has_dash_help then [] else [ "-help" ]) @
> -    (if !has_dash_dash_help then [] else [ "--help" ]) in
> -  let specs = specs @
> -    (if help_keys <> [] then [ help_keys, Unit (show_help t),
s_"Display brief help"; ] else []) in
> -
> -  (* Sort the specs, and set them in the handle.  *)
> +  (* Sort the specs.  *)
>    let specs = List.map (
>      fun (keys, action, doc) ->
>        List.hd (List.sort compare_command_line_args keys), (keys, action,
doc)
> @@ -194,14 +179,26 @@ let create specs ?anon_fun usage_msg >      let
cmp (arg1, _) (arg2, _) = compare_command_line_args arg1 arg2 in
>      List.sort cmp specs in
>    let specs = List.map snd specs in
> -  t.specs <- specs;
>  
> +  let t = {
> +    specs = specs;
> +    anon_fun = anon_fun;
> +    usage_msg = usage_msg;
> +  } in
> +  let added_options = [
> +    [ L"short-options" ], Unit (display_short_options t),
> +                                         hidden_option_description;
> +    [ L"long-options" ], Unit (display_long_options t),
> +                                         hidden_option_description;
> +    [ L"help" ], Unit (show_help t),     s_"Display brief
help";
> +  ] in
> +  t.specs <- added_options @ specs;
IMHO it'd be better to sort the specs at this point, like done before;
otherwise, --help (and potentially any non-hidden built-in option added
here) will be shown only at the end of the other specs.

Thanks,
-- 
Pino Toscano

Seemingly Similar Threads

Search for more apparently analagous threads

Libguestfs - Jul 2016 - [PATCH v2 0/3] mllib: Various fixes and changes to Getopt module.

[Libguestfs] [PATCH v2 0/3] mllib: Various fixes and changes to Getopt module.

[Libguestfs] [PATCH v2 1/3] mllib: getopt: Further fix int parsing.

[Libguestfs] [PATCH v2 2/3] mllib: Use L"..." and S '...' for long and short options.

[Libguestfs] [PATCH v2 3/3] mllib: tests: Add tests of the new Getopt module.

Re: [Libguestfs] [PATCH v2 2/3] mllib: Use L"..." and S '...' for long and short options.

Seemingly Similar Threads