From 766b5cdefa13145a529dd08e756c3bf81d7fe734 Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
Date: Tue, 29 Nov 2011 17:20:11 +0000
Subject: [PATCH] extra tests: Test virt-sparsify.

This adds the virt-sparsify --debug-gc option which causes
virt-sparsify to call Gc.compact before exiting, allowing
GC and memory problems to be tested.

Add an extratest which runs virt-sparsify under valgrind.
(cherry picked from commit 14b1e7b963cd5446ab76a067085b91925dd5d3e3)
---
 extratests/Makefile.am         |  6 +++++-
 sparsify/sparsify.ml           | 14 +++++++++++---
 sparsify/test-virt-sparsify.sh |  2 +-
 sparsify/virt-sparsify.pod     |  6 ++++++
 4 files changed, 23 insertions(+), 5 deletions(-)

diff --git a/extratests/Makefile.am b/extratests/Makefile.am
index a73a187..dff74b6 100644
--- a/extratests/Makefile.am
+++ b/extratests/Makefile.am
@@ -47,6 +47,7 @@ extra-tests: \
 	test-tools-internal \
 	test-tools-real \
 	test-resize \
+	test-sparsify \
 	test-capitests \
 	test-ocaml
 
@@ -101,12 +102,15 @@ test-tools-real:
 test-resize:
 	$(MAKE) -C ../resize VG="$(VG)" check
 
+# Run virt-sparsify tests under valgrind.
+test-sparsify:
+	$(MAKE) -C ../sparsify VG="$(VG)" check
+
 # XXX Not tested:
 # ../clone/virt-sysprep
 # ../edit/virt-edit
 # ../edit/virt-edit -e
 # ../fuse/guestmount
-# ../sparsify/virt-sparsify (OCaml)
 # ../tools/virt-win-reg (Perl)
 # ../tools/virt-make-fs (Perl)
 
diff --git a/sparsify/sparsify.ml b/sparsify/sparsify.ml
index 956fccb..9a46495 100644
--- a/sparsify/sparsify.ml
+++ b/sparsify/sparsify.ml
@@ -28,7 +28,8 @@ let () = Random.self_init ()
 (* Command line argument parsing. *)
 let prog = Filename.basename Sys.executable_name
 
-let indisk, outdisk, convert, format, ignores, machine_readable, quiet,
+let indisk, outdisk, convert, debug_gc,
+  format, ignores, machine_readable, quiet,
   verbose, trace =
   let display_version () =
     let g = new G.guestfs () in
@@ -41,6 +42,7 @@ let indisk, outdisk, convert, format, ignores, machine_readable, quiet,
   let add xs s = xs := s :: !xs in
 
   let convert = ref "" in
+  let debug_gc = ref false in
   let format = ref "" in
   let ignores = ref [] in
   let machine_readable = ref false in
@@ -50,6 +52,7 @@ let indisk, outdisk, convert, format, ignores, machine_readable, quiet,
 
   let argspec = Arg.align [
     "--convert", Arg.Set_string convert,    "format Format of output disk (default: same as input)";
+    "--debug-gc", Arg.Set debug_gc,         " Debug GC and memory allocations";
     "--format",  Arg.Set_string format,     "format Format of input disk";
     "--ignore",  Arg.String (add ignores),  "fs Ignore filesystem";
     "--machine-readable", Arg.Set machine_readable, " Make output machine readable";
@@ -77,6 +80,7 @@ read the man page virt-sparsify(1).
 
   (* Dereference the rest of the args. *)
   let convert = match !convert with "" -> None | str -> Some str in
+  let debug_gc = !debug_gc in
   let format = match !format with "" -> None | str -> Some str in
   let ignores = List.rev !ignores in
   let machine_readable = !machine_readable in
@@ -122,8 +126,9 @@ read the man page virt-sparsify(1).
   if contains_comma then
     error "input filename '%s' contains a comma; qemu-img command line syntax prevents us from using such an image" indisk;
 
-  indisk, outdisk, convert, format, ignores, machine_readable, quiet,
-  verbose, trace
+  indisk, outdisk, convert,
+    debug_gc, format, ignores, machine_readable, quiet,
+    verbose, trace
 
 let () =
   if not quiet then
@@ -302,4 +307,7 @@ let () =
     wrap "Sparsify operation completed with no errors.  Before deleting the old disk, carefully check that the target disk boots and works correctly.\n";
   );
 
+  if debug_gc then
+    Gc.compact ();
+
   exit 0
diff --git a/sparsify/test-virt-sparsify.sh b/sparsify/test-virt-sparsify.sh
index 8d38775..4a7a2f6 100755
--- a/sparsify/test-virt-sparsify.sh
+++ b/sparsify/test-virt-sparsify.sh
@@ -37,7 +37,7 @@ rm /boot/big
 umount-all
 EOF
 
-./virt-sparsify --format raw test1.img --convert qcow2 test2.img
+$VG ./virt-sparsify --debug-gc --format raw test1.img --convert qcow2 test2.img
 
 size_before=$(du -s test1.img | awk '{print $1}')
 size_after=$(du -s test2.img | awk '{print $1}')
diff --git a/sparsify/virt-sparsify.pod b/sparsify/virt-sparsify.pod
index 77467b6..2e2c02d 100644
--- a/sparsify/virt-sparsify.pod
+++ b/sparsify/virt-sparsify.pod
@@ -121,6 +121,12 @@ eg. C<vmdk>, but support for other formats is reliant on qemu.
 Specifying the I<--convert> option is usually a good idea, because
 then virt-sparsify doesn't need to try to guess the input format.
 
+=item B<--debug-gc>
+
+Debug garbage collection and memory allocation.  This is only useful
+when debugging memory problems in virt-sparsify or the OCaml libguestfs
+bindings.
+
 =item B<--format> raw
 
 =item B<--format> qcow2
-- 
1.8.3.1