[Pkg-libvirt-commits] [SCM] Libguestfs Debian packaging branch, experimental, updated. debian/1%1.21.40-1

Richard W.M. Jones rjones at redhat.com
Sat Jun 1 11:04:19 UTC 2013


The following commit has been merged in the experimental branch:
commit f82a9dbf0fbc66fb099c68cea0d17ac2e4dc67a9
Author: Richard W.M. Jones <rjones at redhat.com>
Date:   Fri Apr 26 16:49:58 2013 +0100

    ocaml: Standardize the test sequence for all bindings; implement this for OCaml.
    
    The idea behind this change is to have a consistent set of
    tests across all bindings, while at the same time saving time.
    For background see:
    
    https://www.redhat.com/archives/libguestfs/2013-April/thread.html#00069

diff --git a/.gitignore b/.gitignore
index 3a36ab7..eb1e749 100644
--- a/.gitignore
+++ b/.gitignore
@@ -269,20 +269,8 @@ Makefile.in
 /ocamlinit-stamp
 /ocaml/META
 /ocaml/stamp-mlguestfs
-/ocaml/t/guestfs_005_load.bc
-/ocaml/t/guestfs_005_load.opt
-/ocaml/t/guestfs_010_basic.bc
-/ocaml/t/guestfs_010_basic.opt
-/ocaml/t/guestfs_070_threads.bc
-/ocaml/t/guestfs_070_threads.opt
-/ocaml/t/guestfs_080_optargs.bc
-/ocaml/t/guestfs_080_optargs.opt
-/ocaml/t/guestfs_400_events.bc
-/ocaml/t/guestfs_400_events.opt
-/ocaml/t/guestfs_400_progress.bc
-/ocaml/t/guestfs_400_progress.opt
-/ocaml/t/guestfs_500_mount_local.bc
-/ocaml/t/guestfs_500_mount_local.opt
+/ocaml/t/*.bc
+/ocaml/t/*.opt
 /perl/bindtests.pl
 /perl/blib
 /perl/examples/guestfs-perl.3
diff --git a/ocaml/Makefile.am b/ocaml/Makefile.am
index 70dd7f4..92bb7d0 100644
--- a/ocaml/Makefile.am
+++ b/ocaml/Makefile.am
@@ -96,16 +96,20 @@ endif
 TESTS_ENVIRONMENT = $(top_builddir)/run --test $(VG)
 
 test_progs = \
-	t/guestfs_005_load \
-	t/guestfs_080_optargs \
-	t/guestfs_400_events
+	t/guestfs_010_load \
+	t/guestfs_020_create \
+	t/guestfs_030_create_flags \
+	t/guestfs_040_create_multiple \
+	t/guestfs_050_handle_properties \
+	t/guestfs_060_explicit_close \
+	t/guestfs_070_optargs \
+	t/guestfs_410_close_event \
+	t/guestfs_420_log_messages
 
 if ENABLE_APPLIANCE
 test_progs += \
-	t/guestfs_010_basic \
-	t/guestfs_070_threads \
-	t/guestfs_400_progress \
-	t/guestfs_500_mount_local
+	t/guestfs_100_launch \
+	t/guestfs_430_progress_messages
 endif
 
 TESTS = run-bindtests \
@@ -118,69 +122,13 @@ noinst_DATA += \
 	$(test_progs:%=%.bc) \
 	$(test_progs:%=%.opt)
 
-bindtests.bc: bindtests.cmo mlguestfs.cma
+%.bc: %.cmo mlguestfs.cma
 	$(top_builddir)/libtool -dlopen $(top_builddir)/src/.libs/libguestfs.la --mode=execute \
 	$(OCAMLFIND) ocamlc $(OCAMLCFLAGS) -I . -package unix -linkpkg mlguestfs.cma $< -o $@
 
-bindtests.opt: bindtests.cmx mlguestfs.cmxa
+%.opt: %.cmx mlguestfs.cmxa
 	$(OCAMLFIND) ocamlopt $(OCAMLOPTFLAGS) -cclib -L$(top_builddir)/src/.libs -I . -package unix -linkpkg mlguestfs.cmxa $< -o $@
 
-t/guestfs_005_load.bc: t/guestfs_005_load.cmo mlguestfs.cma
-	$(top_builddir)/libtool -dlopen $(top_builddir)/src/.libs/libguestfs.la --mode=execute \
-	$(OCAMLFIND) ocamlc $(OCAMLCFLAGS) -I . -package unix -linkpkg mlguestfs.cma $< -o $@
-
-t/guestfs_005_load.opt: t/guestfs_005_load.cmx mlguestfs.cmxa
-	$(OCAMLFIND) ocamlopt $(OCAMLOPTFLAGS) -cclib -L$(top_builddir)/src/.libs -I . -package unix -linkpkg mlguestfs.cmxa $< -o $@
-
-t/guestfs_010_basic.bc: t/guestfs_010_basic.cmo mlguestfs.cma
-	$(top_builddir)/libtool -dlopen $(top_builddir)/src/.libs/libguestfs.la --mode=execute \
-	$(OCAMLFIND) ocamlc $(OCAMLCFLAGS) -I . -package unix -linkpkg mlguestfs.cma $< -o $@
-
-t/guestfs_010_basic.opt: t/guestfs_010_basic.cmx mlguestfs.cmxa
-	$(OCAMLFIND) ocamlopt $(OCAMLOPTFLAGS) -cclib -L$(top_builddir)/src/.libs -I . -package unix -linkpkg mlguestfs.cmxa $< -o $@
-
-t/guestfs_070_threads.bc: t/guestfs_070_threads.cmo mlguestfs.cma
-	$(top_builddir)/libtool -dlopen $(top_builddir)/src/.libs/libguestfs.la --mode=execute \
-	$(OCAMLFIND) ocamlc $(OCAMLCFLAGS) -I . -package unix,threads -thread -linkpkg mlguestfs.cma $< -o $@
-
-t/guestfs_070_threads.opt: t/guestfs_070_threads.cmx mlguestfs.cmxa
-	$(OCAMLFIND) ocamlopt $(OCAMLOPTFLAGS) -cclib -L$(top_builddir)/src/.libs -I . -package unix,threads -thread -linkpkg mlguestfs.cmxa $< -o $@
-
-t/guestfs_080_optargs.bc: t/guestfs_080_optargs.cmo mlguestfs.cma
-	$(top_builddir)/libtool -dlopen $(top_builddir)/src/.libs/libguestfs.la --mode=execute \
-	$(OCAMLFIND) ocamlc $(OCAMLCFLAGS) -I . -package unix -linkpkg mlguestfs.cma $< -o $@
-
-t/guestfs_080_optargs.opt: t/guestfs_080_optargs.cmx mlguestfs.cmxa
-	$(OCAMLFIND) ocamlopt $(OCAMLOPTFLAGS) -cclib -L$(top_builddir)/src/.libs -I . -package unix -linkpkg mlguestfs.cmxa $< -o $@
-
-t/guestfs_400_events.bc: t/guestfs_400_events.cmo mlguestfs.cma
-	$(top_builddir)/libtool -dlopen $(top_builddir)/src/.libs/libguestfs.la --mode=execute \
-	$(OCAMLFIND) ocamlc $(OCAMLCFLAGS) -I . -package unix -linkpkg mlguestfs.cma $< -o $@
-
-t/guestfs_400_events.opt: t/guestfs_400_events.cmx mlguestfs.cmxa
-	$(OCAMLFIND) ocamlopt $(OCAMLOPTFLAGS) -cclib -L$(top_builddir)/src/.libs -I . -package unix -linkpkg mlguestfs.cmxa $< -o $@
-
-t/guestfs_400_progress.bc: t/guestfs_400_progress.cmo mlguestfs.cma
-	$(top_builddir)/libtool -dlopen $(top_builddir)/src/.libs/libguestfs.la --mode=execute \
-	$(OCAMLFIND) ocamlc $(OCAMLCFLAGS) -I . -package unix -linkpkg mlguestfs.cma $< -o $@
-
-t/guestfs_400_progress.opt: t/guestfs_400_progress.cmx mlguestfs.cmxa
-	$(OCAMLFIND) ocamlopt $(OCAMLOPTFLAGS) -cclib -L$(top_builddir)/src/.libs -I . -package unix -linkpkg mlguestfs.cmxa $< -o $@
-
-t/guestfs_500_mount_local.bc: t/guestfs_500_mount_local.cmo mlguestfs.cma
-	$(top_builddir)/libtool -dlopen $(top_builddir)/src/.libs/libguestfs.la --mode=execute \
-	$(OCAMLFIND) ocamlc -custom $(OCAMLCFLAGS) -I . -package unix -linkpkg mlguestfs.cma $< -o $@
-
-t/guestfs_500_mount_local.opt: t/guestfs_500_mount_local.cmx mlguestfs.cmxa
-	$(OCAMLFIND) ocamlopt $(OCAMLOPTFLAGS) -cclib -L$(top_builddir)/src/.libs -I . -package unix -linkpkg mlguestfs.cmxa $< -o $@
-
-# Explicit rules for these tests which require 'threads' package.
-t/guestfs_070_threads.cmo: t/guestfs_070_threads.ml mlguestfs.cma
-	$(OCAMLFIND) ocamlc $(OCAMLCFLAGS) -package unix,threads -thread -linkpkg -c $< -o $@
-
-t/guestfs_070_threads.cmx: t/guestfs_070_threads.ml mlguestfs.cmxa
-	$(OCAMLFIND) ocamlopt $(OCAMLOPTFLAGS) -package unix,threads -thread -linkpkg -c $< -o $@
-
 check-valgrind:
 	$(MAKE) VG="$(top_builddir)/run @VG@" check
 
diff --git a/ocaml/t/guestfs_005_load.ml b/ocaml/t/guestfs_010_load.ml
similarity index 84%
copy from ocaml/t/guestfs_005_load.ml
copy to ocaml/t/guestfs_010_load.ml
index dfd8133..c9935d1 100644
--- a/ocaml/t/guestfs_005_load.ml
+++ b/ocaml/t/guestfs_010_load.ml
@@ -1,4 +1,4 @@
-(* libguestfs OCaml bindings
+(* libguestfs OCaml tests
  * Copyright (C) 2009-2013 Red Hat Inc.
  *
  * This program is free software; you can redistribute it and/or modify
@@ -16,11 +16,6 @@
  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  *)
 
-let _ = Guestfs.create
-
-(* Also try the OO style. *)
-let _ =
-  let g = new Guestfs.guestfs () in
-  g#get_verbose ()
+(* Nothing - just test that the library can be linked to. *)
 
 let () = Gc.compact ()
diff --git a/ocaml/t/guestfs_005_load.ml b/ocaml/t/guestfs_020_create.ml
similarity index 84%
copy from ocaml/t/guestfs_005_load.ml
copy to ocaml/t/guestfs_020_create.ml
index dfd8133..524adea 100644
--- a/ocaml/t/guestfs_005_load.ml
+++ b/ocaml/t/guestfs_020_create.ml
@@ -1,4 +1,4 @@
-(* libguestfs OCaml bindings
+(* libguestfs OCaml tests
  * Copyright (C) 2009-2013 Red Hat Inc.
  *
  * This program is free software; you can redistribute it and/or modify
@@ -16,11 +16,9 @@
  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  *)
 
-let _ = Guestfs.create
+let _ = Guestfs.create ()
 
-(* Also try the OO style. *)
-let _ =
-  let g = new Guestfs.guestfs () in
-  g#get_verbose ()
+(* OCaml only: also try the OO style. *)
+let _ = new Guestfs.guestfs ()
 
 let () = Gc.compact ()
diff --git a/ocaml/t/guestfs_005_load.ml b/ocaml/t/guestfs_030_create_flags.ml
similarity index 84%
copy from ocaml/t/guestfs_005_load.ml
copy to ocaml/t/guestfs_030_create_flags.ml
index dfd8133..9c1d1c1 100644
--- a/ocaml/t/guestfs_005_load.ml
+++ b/ocaml/t/guestfs_030_create_flags.ml
@@ -1,4 +1,4 @@
-(* libguestfs OCaml bindings
+(* libguestfs OCaml tests
  * Copyright (C) 2009-2013 Red Hat Inc.
  *
  * This program is free software; you can redistribute it and/or modify
@@ -16,11 +16,8 @@
  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  *)
 
-let _ = Guestfs.create
-
-(* Also try the OO style. *)
-let _ =
-  let g = new Guestfs.guestfs () in
-  g#get_verbose ()
+let () =
+  let g = new Guestfs.guestfs ~environment:false ~close_on_exit:false () in
+  g#parse_environment ()
 
 let () = Gc.compact ()
diff --git a/ocaml/t/guestfs_005_load.ml b/ocaml/t/guestfs_040_create_multiple.ml
similarity index 82%
copy from ocaml/t/guestfs_005_load.ml
copy to ocaml/t/guestfs_040_create_multiple.ml
index dfd8133..88ce233 100644
--- a/ocaml/t/guestfs_005_load.ml
+++ b/ocaml/t/guestfs_040_create_multiple.ml
@@ -1,4 +1,4 @@
-(* libguestfs OCaml bindings
+(* libguestfs OCaml tests
  * Copyright (C) 2009-2013 Red Hat Inc.
  *
  * This program is free software; you can redistribute it and/or modify
@@ -16,11 +16,10 @@
  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  *)
 
-let _ = Guestfs.create
-
-(* Also try the OO style. *)
-let _ =
-  let g = new Guestfs.guestfs () in
-  g#get_verbose ()
+let () =
+  let g1 = new Guestfs.guestfs () in
+  let g2 = new Guestfs.guestfs () in
+  let g3 = new Guestfs.guestfs () in
+  ignore (g1, g2, g3)
 
 let () = Gc.compact ()
diff --git a/ocaml/t/guestfs_005_load.ml b/ocaml/t/guestfs_050_handle_properties.ml
similarity index 79%
copy from ocaml/t/guestfs_005_load.ml
copy to ocaml/t/guestfs_050_handle_properties.ml
index dfd8133..dbf98c7 100644
--- a/ocaml/t/guestfs_005_load.ml
+++ b/ocaml/t/guestfs_050_handle_properties.ml
@@ -1,4 +1,4 @@
-(* libguestfs OCaml bindings
+(* libguestfs OCaml tests
  * Copyright (C) 2009-2013 Red Hat Inc.
  *
  * This program is free software; you can redistribute it and/or modify
@@ -16,11 +16,15 @@
  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  *)
 
-let _ = Guestfs.create
-
-(* Also try the OO style. *)
 let _ =
   let g = new Guestfs.guestfs () in
-  g#get_verbose ()
+  let v = g#get_verbose () in
+  g#set_verbose v;
+  let v = g#get_trace () in
+  g#set_trace v;
+  let v = g#get_memsize () in
+  g#set_memsize v;
+  let v = g#get_path () in
+  g#set_path (Some v)
 
 let () = Gc.compact ()
diff --git a/ocaml/t/guestfs_005_load.ml b/ocaml/t/guestfs_060_explicit_close.ml
similarity index 88%
copy from ocaml/t/guestfs_005_load.ml
copy to ocaml/t/guestfs_060_explicit_close.ml
index dfd8133..d4ede7d 100644
--- a/ocaml/t/guestfs_005_load.ml
+++ b/ocaml/t/guestfs_060_explicit_close.ml
@@ -1,4 +1,4 @@
-(* libguestfs OCaml bindings
+(* libguestfs OCaml tests
  * Copyright (C) 2009-2013 Red Hat Inc.
  *
  * This program is free software; you can redistribute it and/or modify
@@ -16,11 +16,8 @@
  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  *)
 
-let _ = Guestfs.create
-
-(* Also try the OO style. *)
-let _ =
+let () =
   let g = new Guestfs.guestfs () in
-  g#get_verbose ()
+  g#close ()
 
 let () = Gc.compact ()
diff --git a/ocaml/t/guestfs_005_load.ml b/ocaml/t/guestfs_070_optargs.ml
similarity index 78%
rename from ocaml/t/guestfs_005_load.ml
rename to ocaml/t/guestfs_070_optargs.ml
index dfd8133..38c4318 100644
--- a/ocaml/t/guestfs_005_load.ml
+++ b/ocaml/t/guestfs_070_optargs.ml
@@ -1,4 +1,4 @@
-(* libguestfs OCaml bindings
+(* libguestfs OCaml tests
  * Copyright (C) 2009-2013 Red Hat Inc.
  *
  * This program is free software; you can redistribute it and/or modify
@@ -16,11 +16,11 @@
  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  *)
 
-let _ = Guestfs.create
-
-(* Also try the OO style. *)
-let _ =
+let () =
   let g = new Guestfs.guestfs () in
-  g#get_verbose ()
+  g#add_drive "/dev/null";
+  g#add_drive ~readonly:true "/dev/null";
+  g#add_drive ~readonly:true ~format:"raw" "/dev/null";
+  g#add_drive ~iface:"virtio" ~readonly:true ~format:"raw" "/dev/null"
 
 let () = Gc.compact ()
diff --git a/ocaml/t/guestfs_070_threads.ml b/ocaml/t/guestfs_070_threads.ml
deleted file mode 100644
index 35e6ab7..0000000
--- a/ocaml/t/guestfs_070_threads.ml
+++ /dev/null
@@ -1,72 +0,0 @@
-(* libguestfs OCaml bindings
- * Copyright (C) 2010 Red Hat Inc.
- *
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation; either version 2 of the License, or
- * (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
- *)
-
-open Unix
-
-(* Start a background thread which does lots of allocation and
- * GC activity.
- *)
-let thread = Thread.create (
-  fun () ->
-    while true do
-      Gc.compact ();
-      ignore (Array.init 1000 (fun i -> String.create (8*i)));
-      Thread.delay 0.001
-    done
-) ()
-
-let () =
-  let g = Guestfs.create () in
-
-  let fd = openfile "test.img" [O_WRONLY;O_CREAT;O_NOCTTY;O_TRUNC] 0o666 in
-  ftruncate fd (500 * 1024 * 1024);
-  close fd;
-
-  (* Copy these strings so they're located on the heap and
-   * subject to garbage collection.
-   *)
-  let s = String.copy "test.img" in
-  Guestfs.add_drive_ro g s;
-  Guestfs.launch g;
-
-  let dev = String.copy "/dev/sda" in
-  Guestfs.pvcreate g dev;
-  let vg = String.copy "VG" in
-  Guestfs.vgcreate g vg [|dev|];
-  let s = String.copy "LV1" in
-  Guestfs.lvcreate g s vg 200;
-  let s = String.copy "LV2" in
-  Guestfs.lvcreate g s vg 200;
-
-  let lvs = Guestfs.lvs g in
-  if lvs <> [|"/dev/VG/LV1"; "/dev/VG/LV2"|] then
-    failwith "Guestfs.lvs returned incorrect result";
-
-  let s = String.copy "ext3" in
-  let lv = String.copy "/dev/VG/LV1" in
-  Guestfs.mkfs g s lv;
-  let s = String.copy "/" in
-  Guestfs.mount g lv s;
-  let s = String.copy "/test" in
-  Guestfs.touch g s;
-
-  Guestfs.shutdown g;
-  Guestfs.close g;
-  unlink "test.img";
-  Gc.compact ();
-  exit 0
diff --git a/ocaml/t/guestfs_010_basic.ml b/ocaml/t/guestfs_100_launch.ml
similarity index 95%
rename from ocaml/t/guestfs_010_basic.ml
rename to ocaml/t/guestfs_100_launch.ml
index a4858e5..ae90100 100644
--- a/ocaml/t/guestfs_010_basic.ml
+++ b/ocaml/t/guestfs_100_launch.ml
@@ -1,4 +1,4 @@
-(* libguestfs OCaml bindings
+(* libguestfs OCaml tests
  * Copyright (C) 2009-2013 Red Hat Inc.
  *
  * This program is free software; you can redistribute it and/or modify
@@ -16,8 +16,6 @@
  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  *)
 
-(* Test basic functionality. *)
-
 open Unix
 
 let () =
@@ -27,8 +25,6 @@ let () =
   ftruncate fd (500 * 1024 * 1024);
   close fd;
 
-  g#set_autosync true;
-
   g#add_drive "test.img";
   g#launch ();
 
@@ -64,3 +60,5 @@ let () =
   g#shutdown ();
   g#close ();
   unlink "test.img"
+
+let () = Gc.compact ()
diff --git a/ocaml/t/guestfs_400_progress.ml b/ocaml/t/guestfs_400_progress.ml
deleted file mode 100644
index 2cd3194..0000000
--- a/ocaml/t/guestfs_400_progress.ml
+++ /dev/null
@@ -1,41 +0,0 @@
-(* libguestfs OCaml bindings
- * Copyright (C) 2010-2012 Red Hat Inc.
- *
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation; either version 2 of the License, or
- * (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
- *)
-
-module G = Guestfs
-
-let () =
-  let g = G.create () in
-
-  G.add_drive g "/dev/null";
-  G.launch g;
-
-  let calls = ref 0 in
-  let cb _ _ _ _ _ = incr calls in
-  let eh = G.set_event_callback g cb [G.EVENT_PROGRESS] in
-  assert ("ok" = G.debug g "progress" [| "5" |]);
-  assert (!calls > 0);
-  calls := 0;
-  G.delete_event_callback g eh;
-  assert ("ok" = G.debug g "progress" [| "5" |]);
-  assert (!calls = 0);
-  ignore (G.set_event_callback g cb [G.EVENT_PROGRESS]);
-  assert ("ok" = G.debug g "progress" [| "5" |]);
-  assert (!calls > 0);
-
-  G.close g;
-  Gc.compact ()
diff --git a/ocaml/t/guestfs_080_optargs.ml b/ocaml/t/guestfs_410_close_event.ml
similarity index 67%
rename from ocaml/t/guestfs_080_optargs.ml
rename to ocaml/t/guestfs_410_close_event.ml
index e2b2f6c..d434e98 100644
--- a/ocaml/t/guestfs_080_optargs.ml
+++ b/ocaml/t/guestfs_410_close_event.ml
@@ -1,5 +1,5 @@
-(* libguestfs OCaml bindings
- * Copyright (C) 2010 Red Hat Inc.
+(* libguestfs OCaml tests
+ * Copyright (C) 2009-2013 Red Hat Inc.
  *
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -16,14 +16,16 @@
  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  *)
 
-open Unix
+let close_invoked = ref 0
 
-let () =
-  let g = Guestfs.create () in
+let close _ _ _ _ _ =
+  incr close_invoked
 
-  Guestfs.add_drive g "/dev/null";
-  Guestfs.add_drive g ~readonly:true "/dev/null";
-  Guestfs.add_drive g ~readonly:true ~format:"raw" "/dev/null";
-  Guestfs.add_drive g ~iface:"virtio" ~readonly:true ~format:"raw" "/dev/null";
+let () =
+  let g = new Guestfs.guestfs () in
+  ignore (g#set_event_callback close [Guestfs.EVENT_CLOSE]);
+  assert (!close_invoked = 0);
+  g#close ();
+  assert (!close_invoked = 1)
 
-  Guestfs.close g
+let () = Gc.compact ()
diff --git a/ocaml/t/guestfs_400_events.ml b/ocaml/t/guestfs_420_log_messages.ml
similarity index 57%
rename from ocaml/t/guestfs_400_events.ml
rename to ocaml/t/guestfs_420_log_messages.ml
index baf8340..a8897c2 100644
--- a/ocaml/t/guestfs_400_events.ml
+++ b/ocaml/t/guestfs_420_log_messages.ml
@@ -1,5 +1,5 @@
-(* libguestfs OCaml bindings
- * Copyright (C) 2011 Red Hat Inc.
+(* libguestfs OCaml tests
+ * Copyright (C) 2009-2013 Red Hat Inc.
  *
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -18,44 +18,30 @@
 
 open Printf
 
+let log_invoked = ref 0
+
 let log g ev eh buf array =
   let eh : int = Obj.magic eh in
 
-  printf "ocaml event logged: event=%s eh=%d buf=%S array=[%s]\n"
+  printf "event logged: event=%s eh=%d buf=%S array=[%s]\n"
     (Guestfs.event_to_string [ev]) eh buf
-    (String.concat ", " (List.map Int64.to_string (Array.to_list array)))
-
-let close_invoked = ref 0
+    (String.concat ", " (List.map Int64.to_string (Array.to_list array)));
 
-let close g ev eh buf array =
-  incr close_invoked;
-  log g ev eh buf array
+  incr log_invoked
 
 let () =
   let g = new Guestfs.guestfs () in
-
-  (* Grab log, trace and daemon messages into our own custom handler
-   * which prints the messages with a particular prefix.
-   *)
-  let events = [Guestfs.EVENT_APPLIANCE; Guestfs.EVENT_LIBRARY;
-                Guestfs.EVENT_TRACE] in
+  let events = [ Guestfs.EVENT_APPLIANCE; Guestfs.EVENT_LIBRARY;
+                 Guestfs.EVENT_TRACE ] in
   ignore (g#set_event_callback log events);
 
-  (* Check that the close event is invoked. *)
-  ignore (g#set_event_callback close [Guestfs.EVENT_CLOSE]);
-
-  (* Now make sure we see some messages. *)
   g#set_trace true;
   g#set_verbose true;
-
-  (* Do some stuff. *)
   g#add_drive_ro "/dev/null";
   g#set_autosync true;
 
-  (* Close the handle -- should call the close callback. *)
-  assert (!close_invoked = 0);
   g#close ();
-  assert (!close_invoked = 1);
 
-  (* Run full garbage collection. *)
-  Gc.compact ()
+  assert (!log_invoked > 0)
+
+let () = Gc.compact ()
diff --git a/fish/lcd.c b/ocaml/t/guestfs_430_progress_messages.ml
similarity index 53%
copy from fish/lcd.c
copy to ocaml/t/guestfs_430_progress_messages.ml
index a543887..faa37df 100644
--- a/fish/lcd.c
+++ b/ocaml/t/guestfs_430_progress_messages.ml
@@ -1,4 +1,4 @@
-/* guestfish - guest filesystem shell
+(* libguestfs OCaml tests
  * Copyright (C) 2009-2013 Red Hat Inc.
  *
  * This program is free software; you can redistribute it and/or modify
@@ -14,32 +14,30 @@
  * You should have received a copy of the GNU General Public License
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
- */
+ *)
 
-#include <config.h>
+let callback_invoked = ref 0
 
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-#include <unistd.h>
-#include <libintl.h>
+let callback _ _ _ _ _ = incr callback_invoked
 
-#include "fish.h"
+let () =
+  let g = new Guestfs.guestfs () in
+  g#add_drive "/dev/null";
+  g#launch ();
 
-/* guestfish lcd command (similar to the lcd command in BSD ftp) */
+  let eh = g#set_event_callback callback [Guestfs.EVENT_PROGRESS] in
+  assert ("ok" = g#debug "progress" [| "5" |]);
+  assert (!callback_invoked > 0);
 
-int
-run_lcd (const char *cmd, size_t argc, char *argv[])
-{
-  if (argc != 1) {
-    fprintf (stderr, _("use 'lcd directory' to change local directory\n"));
-    return -1;
-  }
+  callback_invoked := 0;
+  g#delete_event_callback eh;
+  assert ("ok" = g#debug "progress" [| "5" |]);
+  assert (!callback_invoked = 0);
 
-  if (chdir (argv[0]) == -1) {
-    perror (argv[0]);
-    return -1;
-  }
+  ignore (g#set_event_callback callback [Guestfs.EVENT_PROGRESS]);
+  assert ("ok" = g#debug "progress" [| "5" |]);
+  assert (!callback_invoked > 0);
 
-  return 0;
-}
+  g#close ()
+
+let () = Gc.compact ()
diff --git a/ocaml/t/guestfs_500_mount_local.ml b/ocaml/t/guestfs_500_mount_local.ml
deleted file mode 100644
index ca89a63..0000000
--- a/ocaml/t/guestfs_500_mount_local.ml
+++ /dev/null
@@ -1,155 +0,0 @@
-(* libguestfs OCaml bindings
- * Copyright (C) 2012 Red Hat Inc.
- *
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation; either version 2 of the License, or
- * (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
- *)
-
-(* Test guestfs_mount_local. *)
-
-open Unix
-open Printf
-
-let (//) = Filename.concat
-
-(* Some settings. *)
-let total_time = 60.                 (* seconds, excluding launch *)
-let debug = true                     (* overview debugging messages *)
-
-let rec main () =
-  Random.self_init ();
-
-  let fuse_writable =
-    try access "/dev/fuse" [W_OK]; true with Unix_error _ -> false in
-  if not fuse_writable then (
-    printf "%s: test skipped because /dev/fuse is not writable.\n"
-      Sys.executable_name;
-    exit 77
-  );
-
-  (* Allow the test to be skipped by setting this environment variable.
-   * This is for RHEL 5, where FUSE doesn't work very reliably.
-   *)
-  let () =
-    let name = "SKIP_TEST_GUESTFS_500_MOUNT_LOCAL_ML" in
-    let value = try Sys.getenv name with Not_found -> "" in
-    if value <> "" then (
-      printf "%s: test skipped because %s is set.\n"
-        Sys.executable_name name;
-      exit 77
-    )
-  in
-
-  let filename = "test1.img" in
-  let fd = openfile filename [O_WRONLY;O_CREAT;O_NOCTTY;O_TRUNC] 0o666 in
-  ftruncate fd (500 * 1024 * 1024);
-  close fd;
-
-  let mp = "mp" in
-  (try rmdir mp with Unix_error _ -> ());
-  mkdir mp 0o700;
-
-  start_test filename mp;
-
-  unlink filename;
-  rmdir mp;
-
-  Gc.compact ()
-
-and start_test filename mp =
-  (* Create a filesystem for the tests. *)
-  let g = new Guestfs.guestfs () in
-
-  g#add_drive filename;
-  g#launch ();
-
-  g#part_disk "/dev/sda" "mbr";
-  g#mkfs "ext2" "/dev/sda1";
-  g#mount "/dev/sda1" "/";
-
-  (* Randomly mount the filesystem and repeat.  Keep going until we
-   * finish the test.
-   *)
-  let start_t = time () in
-  let rec loop () =
-    let t = time () in
-    if t -. start_t < total_time then (
-      if debug then eprintf "%s < mounting filesystem\n%!" mp;
-      g#mount_local mp;
-
-      (* Run test in an exec'd subprocess. *)
-      let args = [| Sys.executable_name; "--test"; mp |] in
-      let pid = fork () in
-      if pid = 0 then (			(* child *)
-        try execv Sys.executable_name args
-        with exn -> prerr_endline (Printexc.to_string exn); exit 1
-      );
-
-      (* Run FUSE main loop.  This processes requests until the
-       * subprocess unmounts the filesystem.
-       *)
-      g#mount_local_run ();
-
-      let _, status = waitpid [] pid in
-      (match status with
-       | WEXITED 0 -> ()
-       | WEXITED i ->
-           eprintf "test subprocess failed (exit code %d)\n" i;
-           exit 1
-       | WSIGNALED i | WSTOPPED i ->
-           eprintf "test subprocess signaled/stopped (signal %d)\n" i;
-           exit 1
-      );
-      loop ()
-    )
-  in
-  loop ();
-
-  g#shutdown ();
-  g#close ()
-
-(* This is run in a child program. *)
-and test_mountpoint mp =
-  if debug then eprintf "%s | testing filesystem\n%!" mp;
-
-  (* Run through the same set of tests repeatedly a number of times.
-   * The aim of this stress test is repeated mount/unmount, not testing
-   * FUSE itself, so we don't do much here.
-   *)
-  for pass = 0 to Random.int 32 do
-    mkdir (mp // "tmp.d") 0o700;
-    let chan = open_out (mp // "file") in
-    let s = String.make (Random.int (128 * 1024)) (Char.chr (Random.int 256)) in
-    output_string chan s;
-    close_out chan;
-    rename (mp // "tmp.d") (mp // "newdir");
-    link (mp // "file") (mp // "newfile");
-    if Random.int 32 = 0 then sleep 1;
-    rmdir (mp // "newdir");
-    unlink (mp // "file");
-    unlink (mp // "newfile")
-  done;
-
-  if debug then eprintf "%s > unmounting filesystem\n%!" mp;
-  ignore (
-    Sys.command (sprintf "../fuse/guestunmount %s" (Filename.quote mp))
-  )
-
-let () =
-  match Array.to_list Sys.argv with
-  | [ _; "--test"; mp ] -> test_mountpoint mp
-  | [ _ ] -> main ()
-  | _ ->
-    eprintf "%s: unknown arguments given to program\n" Sys.executable_name;
-    exit 1
diff --git a/src/guestfs.pod b/src/guestfs.pod
index a0c2681..ee9cc2a 100644
--- a/src/guestfs.pod
+++ b/src/guestfs.pod
@@ -3721,6 +3721,52 @@ Debugging the daemon is a problem because it runs inside a minimal
 environment.  However you can fprintf messages in the daemon to
 stderr, and they will show up if you use C<guestfish -v>.
 
+=head2 ADDING A NEW LANGUAGE BINDING
+
+All language bindings must be generated by the generator
+(see the C<generator> subdirectory).
+
+There is no documentation for this yet.  We suggest you look
+at an existing binding, eg. C<generator/ocaml.ml> or
+C<generator/perl.ml>.
+
+=head2 ADDING TESTS FOR LANGUAGE BINDINGS
+
+Language bindings should come with tests.  Previously testing of
+language bindings was rather ad-hoc, but we have been trying to
+formalize the set of tests that every language binding should use.
+
+Currently only the OCaml and Perl bindings actually implement the full
+set of tests, and the OCaml bindings are canonical, so you should
+emulate what the OCaml tests do.
+
+This is the numbering scheme used by the tests:
+
+ - 000+ basic tests:
+ 
+   010  load the library
+   020  create
+   030  create-flags
+   040  create multiple handles
+   050  test setting and getting config properties
+   060  explicit close
+   070  optargs
+ 
+ - 100  launch, create partitions and LVs and filesystems
+ 
+ - 400+ events:
+ 
+   410  close event
+   420  log messages
+   430  progress messages
+ 
+ - 800+ regression tests (specific to the language)
+ 
+ - 900+ any other custom tests for the language
+
+To save time when running the tests, only 100, 430, 800+, 900+ should
+launch the handle.
+
 =head2 FORMATTING CODE
 
 Our C source code generally adheres to some basic code-formatting

-- 
Libguestfs Debian packaging



More information about the Pkg-libvirt-commits mailing list