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.

3 files changed, 18 insertions, 4 deletions

diff --git a/resize/resize.ml b/resize/resize.ml
index 3c7a6335..6d975537 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 2b76e0b8..09e5f617 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 abf190e6..9ee9c6f6 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