[Libguestfs] [PATCH 2/2] mllib: set --debug-gc as common option
Pino Toscano
ptoscano at redhat.com
Mon Aug 31 16:49:55 UTC 2015
Move --debug-gc as common option for all the OCaml-based tools, even a
couple of them which didn't have it previously.
As implementation note, make set_debug_gc private to
set_standard_options, as it needed to be moved otherwise, and it is no
more required as public function.
---
customize/customize_main.ml | 1 -
mllib/common_utils.ml | 8 ++++----
mllib/common_utils.mli | 3 ---
resize/resize.ml | 1 -
sparsify/cmdline.ml | 1 -
sysprep/main.ml | 1 -
v2v/cmdline.ml | 1 -
7 files changed, 4 insertions(+), 12 deletions(-)
diff --git a/customize/customize_main.ml b/customize/customize_main.ml
index 459e98a..42af3c7 100644
--- a/customize/customize_main.ml
+++ b/customize/customize_main.ml
@@ -78,7 +78,6 @@ let main () =
"format" ^ " " ^ s_"Set attach disk format";
"-c", Arg.Set_string libvirturi, s_"uri" ^ " " ^ s_"Set libvirt URI";
"--connect", Arg.Set_string libvirturi, s_"uri" ^ " " ^ s_"Set libvirt URI";
- "--debug-gc", Arg.Unit set_debug_gc, " " ^ s_"Debug GC and memory allocations (internal)";
"-d", Arg.String set_domain, s_"domain" ^ " " ^ s_"Set libvirt guest name";
"--domain", Arg.String set_domain, s_"domain" ^ " " ^ s_"Set libvirt guest name";
"-n", Arg.Set dryrun, " " ^ s_"Perform a dry run";
diff --git a/mllib/common_utils.ml b/mllib/common_utils.ml
index 2b7d88d..62d72b1 100644
--- a/mllib/common_utils.ml
+++ b/mllib/common_utils.ml
@@ -511,6 +511,9 @@ let display_long_options () =
exit 0
let set_standard_options argspec =
+ (** Install an exit hook to check gc consistency for --debug-gc *)
+ let set_debug_gc () =
+ at_exit (fun () -> Gc.compact()) in
let argspec = [
"--short-options", Arg.Unit display_short_options, " " ^ s_"List short options";
"--long-options", Arg.Unit display_long_options, " " ^ s_"List long options";
@@ -521,6 +524,7 @@ let set_standard_options argspec =
"-v", Arg.Unit set_verbose, " " ^ s_"Enable libguestfs debugging messages";
"--verbose", Arg.Unit set_verbose, " " ^ s_"Enable libguestfs debugging messages";
"-x", Arg.Unit set_trace, " " ^ s_"Enable tracing of libguestfs calls";
+ "--debug-gc", Arg.Unit set_debug_gc, " " ^ s_"Debug GC and memory allocations (internal)";
] @ argspec in
let argspec =
let cmp (arg1, _, _) (arg2, _, _) = compare_command_line_args arg1 arg2 in
@@ -778,7 +782,3 @@ let read_first_line_from_file filename =
let line = input_line chan in
close_in chan;
line
-
-(** Install an exit hook to check gc consistency for --debug-gc *)
-let set_debug_gc () =
- at_exit (fun () -> Gc.compact())
diff --git a/mllib/common_utils.mli b/mllib/common_utils.mli
index 5d93b53..79032bc 100644
--- a/mllib/common_utils.mli
+++ b/mllib/common_utils.mli
@@ -196,6 +196,3 @@ val last_part_of : string -> char -> string option
val read_first_line_from_file : string -> string
(** Read only the first line (i.e. until the first newline character)
of a file. *)
-
-val set_debug_gc : unit -> unit
-(** Install an exit hook to check gc consistency for --debug-gc *)
diff --git a/resize/resize.ml b/resize/resize.ml
index f353158..edd3bc7 100644
--- a/resize/resize.ml
+++ b/resize/resize.ml
@@ -195,7 +195,6 @@ let main () =
"--no-copy-boot-loader", Arg.Clear copy_boot_loader, " " ^ s_"Don't copy boot loader";
"-d", Arg.Unit set_verbose, " " ^ s_"Enable debugging messages";
"--debug", Arg.Unit set_verbose, ditto;
- "--debug-gc",Arg.Unit set_debug_gc, " " ^ s_"Debug GC and memory allocations";
"--delete", Arg.String (add deletes), s_"part" ^ " " ^ s_"Delete partition";
"--expand", Arg.String set_expand, s_"part" ^ " " ^ s_"Expand partition";
"--no-expand-content", Arg.Clear expand_content, " " ^ s_"Don't expand content";
diff --git a/sparsify/cmdline.ml b/sparsify/cmdline.ml
index 8cd26a4..10c2767 100644
--- a/sparsify/cmdline.ml
+++ b/sparsify/cmdline.ml
@@ -59,7 +59,6 @@ let parse_cmdline () =
"--check-tmpdir", Arg.String set_check_tmpdir, "ignore|..." ^ " " ^ s_"Check there is enough space in $TMPDIR";
"--compress", Arg.Set compress, " " ^ s_"Compressed output format";
"--convert", Arg.Set_string convert, s_"format" ^ " " ^ s_"Format of output disk (default: same as input)";
- "--debug-gc", Arg.Unit set_debug_gc, " " ^ s_"Debug GC and memory allocations";
"--format", Arg.Set_string format, s_"format" ^ " " ^ s_"Format of input disk";
"--ignore", Arg.String (add ignores), s_"fs" ^ " " ^ s_"Ignore filesystem";
"--in-place", Arg.Set in_place, " " ^ s_"Modify the disk image in-place";
diff --git a/sysprep/main.ml b/sysprep/main.ml
index c9fe2ea..a95afce 100644
--- a/sysprep/main.ml
+++ b/sysprep/main.ml
@@ -120,7 +120,6 @@ let main () =
"--add", Arg.String add_file, s_"file" ^ " " ^ s_"Add disk image file";
"-c", Arg.Set_string libvirturi, s_"uri" ^ " " ^ s_"Set libvirt URI";
"--connect", Arg.Set_string libvirturi, s_"uri" ^ " " ^ s_"Set libvirt URI";
- "--debug-gc", Arg.Unit set_debug_gc, " " ^ s_"Debug GC and memory allocations (internal)";
"-d", Arg.String set_domain, s_"domain" ^ " " ^ s_"Set libvirt guest name";
"--domain", Arg.String set_domain, s_"domain" ^ " " ^ s_"Set libvirt guest name";
"-n", Arg.Set dryrun, " " ^ s_"Perform a dry run";
diff --git a/v2v/cmdline.ml b/v2v/cmdline.ml
index 0a0349c..ad0b16c 100644
--- a/v2v/cmdline.ml
+++ b/v2v/cmdline.ml
@@ -137,7 +137,6 @@ let parse_cmdline () =
let argspec = [
"-b", Arg.String add_bridge, "in:out " ^ s_"Map bridge 'in' to 'out'";
"--bridge", Arg.String add_bridge, "in:out " ^ ditto;
- "--debug-gc",Arg.Unit set_debug_gc, " " ^ s_"Debug GC and memory allocations";
"--debug-overlay",Arg.Set debug_overlays,
" " ^ s_"Save overlay files";
"--debug-overlays",Arg.Set debug_overlays,
--
2.1.0
More information about the Libguestfs
mailing list