From 7708d3e04f6ec3985fd74ee1a44a5615d43065e2 Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
Date: Tue, 29 Nov 2011 17:14:18 +0000
Subject: [PATCH] extra tests: Test virt-resize.

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

Add an extratest which runs virt-resize under valgrind.
---
 extratests/Makefile.am     |  6 +++++-
 resize/resize.ml           | 12 ++++++++++--
 resize/test-virt-resize.sh |  4 ++--
 resize/virt-resize.pod     |  6 ++++++
 4 files changed, 23 insertions(+), 5 deletions(-)

diff --git a/extratests/Makefile.am b/extratests/Makefile.am
index 3449ca7..3b46ae8 100644
--- a/extratests/Makefile.am
+++ b/extratests/Makefile.am
@@ -46,6 +46,7 @@ extra-tests: \
 	test-tools-null \
 	test-tools-internal \
 	test-tools-real \
+	test-resize \
 	test-capitests \
 	test-ocaml
 
@@ -97,12 +98,15 @@ test-tools-real:
 	  if [ $$r -ne 0 ]; then exit $$r; fi; \
 	done
 
+# Run virt-resize tests under valgrind.
+test-resize:
+	$(MAKE) -C ../resize VG="$(VG)" check
+
 # XXX Not tested:
 # ../clone/virt-sysprep
 # ../edit/virt-edit
 # ../edit/virt-edit -e
 # ../fuse/guestmount
-# ../resize/virt-resize (OCaml)
 # ../sparsify/virt-sparsify (OCaml)
 # ../tools/virt-win-reg (Perl)
 # ../tools/virt-make-fs (Perl)
diff --git a/resize/resize.ml b/resize/resize.ml
index 3c7a633..6d97553 100644
--- a/resize/resize.ml
+++ b/resize/resize.ml
@@ -30,7 +30,8 @@ let prog = Filename.basename Sys.executable_name
 
 type align_first_t = [ `Never | `Always | `Auto ]
 
-let infile, outfile, align_first, alignment, copy_boot_loader, debug, deletes,
+let infile, outfile, align_first, alignment, copy_boot_loader,
+  debug, debug_gc, deletes,
   dryrun, expand, expand_content, extra_partition, format, ignores,
   lv_expands, machine_readable, ntfsresize_force, output_format,
   quiet, resizes, resizes_force, shrink =
@@ -48,6 +49,7 @@ let infile, outfile, align_first, alignment, copy_boot_loader, debug, deletes,
   let alignment = ref 128 in
   let copy_boot_loader = ref true in
   let debug = ref false in
+  let debug_gc = ref false in
   let deletes = ref [] in
   let dryrun = ref false in
   let expand = ref "" in
@@ -80,6 +82,7 @@ let infile, outfile, align_first, alignment, copy_boot_loader, debug, deletes,
     "--no-copy-boot-loader", Arg.Clear copy_boot_loader, " Don't copy boot loader";
     "-d",        Arg.Set debug,             " Enable debugging messages";
     "--debug",   Arg.Set debug,             " -\"-";
+    "--debug-gc",Arg.Set debug_gc,          " Debug GC and memory allocations";
     "--delete",  Arg.String (add deletes),  "part Delete partition";
     "--expand",  Arg.String set_expand,     "part Expand partition";
     "--no-expand-content", Arg.Clear expand_content, " Don't expand content";
@@ -126,6 +129,7 @@ read the man page virt-resize(1).
   (* Dereference the rest of the args. *)
   let alignment = !alignment in
   let copy_boot_loader = !copy_boot_loader in
+  let debug_gc = !debug_gc in
   let deletes = List.rev !deletes in
   let dryrun = !dryrun in
   let expand = match !expand with "" -> None | str -> Some str in
@@ -183,7 +187,8 @@ read the man page virt-resize(1).
     | _ ->
         error "usage is: %s [--options] indisk outdisk" prog in
 
-  infile, outfile, align_first, alignment, copy_boot_loader, debug, deletes,
+  infile, outfile, align_first, alignment, copy_boot_loader,
+  debug, debug_gc, deletes,
   dryrun, expand, expand_content, extra_partition, format, ignores,
   lv_expands, machine_readable, ntfsresize_force, output_format,
   quiet, resizes, resizes_force, shrink
@@ -1179,4 +1184,7 @@ let () =
     wrap "Resize operation completed with no errors.  Before deleting the old disk, carefully check that the resized disk boots and works correctly.\n";
   );
 
+  if debug_gc then
+    Gc.compact ();
+
   exit 0
diff --git a/resize/test-virt-resize.sh b/resize/test-virt-resize.sh
index 2b76e0b..09e5f61 100755
--- a/resize/test-virt-resize.sh
+++ b/resize/test-virt-resize.sh
@@ -27,7 +27,7 @@ set -e
 ../fish/guestfish -N bootrootlv:/dev/VG/LV:ext2:ext4:400M:32M:gpt </dev/null
 
 qemu-img create -f qcow2 test2.img 500M
-./virt-resize -d --expand /dev/sda2 --lv-expand /dev/VG/LV test1.img test2.img
+$VG ./virt-resize -d --debug-gc --expand /dev/sda2 --lv-expand /dev/VG/LV test1.img test2.img
 
 # Test shrinking in a semi-realistic scenario.  Although the disk
 # image created above contains no data, we will nevertheless use
@@ -42,6 +42,6 @@ fsck ext4 /dev/VG/LV
 EOF
 
 rm -f test2.img; truncate -s 300M test2.img
-./virt-resize -d --shrink /dev/sda2 test1.img test2.img
+$VG ./virt-resize -d --debug-gc --shrink /dev/sda2 test1.img test2.img
 
 rm -f test1.img test2.img
diff --git a/resize/virt-resize.pod b/resize/virt-resize.pod
index abf190e..9ee9c6f 100644
--- a/resize/virt-resize.pod
+++ b/resize/virt-resize.pod
@@ -329,6 +329,12 @@ since around 2008.
 
 Enable debugging messages.
 
+=item B<--debug-gc>
+
+Debug garbage collection and memory allocation.  This is only useful
+when debugging memory problems in virt-resize or the OCaml libguestfs
+bindings.
+
 =item B<--delete part>
 
 Delete the named partition.  It would be more accurate to describe
-- 
1.8.3.1