From 14b1e7b963cd5446ab76a067085b91925dd5d3e3 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.
---
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 3b46ae8..66aefaf 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
@@ -102,12 +103,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 4e438ac..dd3e043 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, compress, convert, format, ignores, machine_readable,
+let indisk, outdisk, compress, convert, debug_gc,
+ format, ignores, machine_readable,
option, quiet, verbose, trace =
let display_version () =
let g = new G.guestfs () in
@@ -42,6 +43,7 @@ let indisk, outdisk, compress, convert, format, ignores, machine_readable,
let compress = ref false 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
@@ -53,6 +55,7 @@ let indisk, outdisk, compress, convert, format, ignores, machine_readable,
let argspec = Arg.align [
"--compress", Arg.Set compress, " Compressed output format";
"--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";
@@ -82,6 +85,7 @@ read the man page virt-sparsify(1).
(* Dereference the rest of the args. *)
let compress = !compress in
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
@@ -128,8 +132,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, compress, convert, format, ignores, machine_readable,
- option, quiet, verbose, trace
+ indisk, outdisk, compress, convert,
+ debug_gc, format, ignores, machine_readable,
+ option, quiet, verbose, trace
let () =
if not quiet then
@@ -312,4 +317,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 6653787..0894cbc 100644
--- a/sparsify/virt-sparsify.pod
+++ b/sparsify/virt-sparsify.pod
@@ -128,6 +128,12 @@ then virt-sparsify doesn't need to try to guess the input format.
For fine-tuning the output format, see: I<--compress>, I<-o>.
+=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