[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