mirrors/libguestfs
1
0
Fork 0
mirror of https://github.com/libguestfs/libguestfs.git synced 2026-03-22 07:03:38 +00:00
Code Issues Packages Projects Releases Wiki Activity

ocaml: Standardize the test sequence for all bindings; implement this for OCaml.

Browse Source 
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
This commit is contained in:
Richard W.M. Jones
2013-04-26 16:49:58 +01:00
parent cc93840d31
commit f82a9dbf0f
16 changed files with 265 additions and 376 deletions
Download Patch File Download Diff File Expand all files Collapse all files

16
.gitignore vendored
View File

@@ -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

78
ocaml/Makefile.am
View File

@@ -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

21
ocaml/t/guestfs_010_load.ml Normal file
View File

@@ -0,0 +1,21 @@
(* 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
* 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.
*)
(* Nothing - just test that the library can be linked to. *)
let () = Gc.compact ()

24
ocaml/t/guestfs_020_create.ml Normal file
View File

@@ -0,0 +1,24 @@
(* 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
* 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.
*)
let _ = Guestfs.create ()
(* OCaml only: also try the OO style. *)
let _ = new Guestfs.guestfs ()
let () = Gc.compact ()

28
ocaml/t/guestfs_400_progress.ml → ocaml/t/guestfs_030_create_flags.ml
View File

@@ -1,5 +1,5 @@
(* libguestfs OCaml bindings
* Copyright (C) 2010-2012 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,26 +16,8 @@
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
*)
module G = Guestfs
let () =
let g = G.create () in
let g = new Guestfs.guestfs ~environment:false ~close_on_exit:false () in
g#parse_environment ()
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 ()
let () = Gc.compact ()

25
ocaml/t/guestfs_040_create_multiple.ml Normal file
View File

@@ -0,0 +1,25 @@
(* 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
* 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.
*)
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 ()

30
ocaml/t/guestfs_050_handle_properties.ml Normal file
View File

@@ -0,0 +1,30 @@
(* 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
* 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.
*)
let _ =
let g = new Guestfs.guestfs () in
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 ()

9
ocaml/t/guestfs_005_load.ml → ocaml/t/guestfs_060_explicit_close.ml
View File

@@ -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 ()

26
ocaml/t/guestfs_070_optargs.ml Normal file
View File

@@ -0,0 +1,26 @@
(* 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
* 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.
*)
let () =
let g = new Guestfs.guestfs () in
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 ()

72
ocaml/t/guestfs_070_threads.ml
View File

@@ -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

8
ocaml/t/guestfs_010_basic.ml → ocaml/t/guestfs_100_launch.ml
View File

@@ -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 ()

22
ocaml/t/guestfs_080_optargs.ml → ocaml/t/guestfs_410_close_event.ml
View File

@@ -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 close _ _ _ _ _ =
incr close_invoked
let () =
let g = Guestfs.create () in
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.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";
Guestfs.close g
let () = Gc.compact ()

38
ocaml/t/guestfs_400_events.ml → ocaml/t/guestfs_420_log_messages.ml
View File

@@ -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)))
(String.concat ", " (List.map Int64.to_string (Array.to_list array)));
let close_invoked = ref 0
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 ()

43
ocaml/t/guestfs_430_progress_messages.ml Normal file
View File

@@ -0,0 +1,43 @@
(* 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
* 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.
*)
let callback_invoked = ref 0
let callback _ _ _ _ _ = incr callback_invoked
let () =
let g = new Guestfs.guestfs () in
g#add_drive "/dev/null";
g#launch ();
let eh = g#set_event_callback callback [Guestfs.EVENT_PROGRESS] in
assert ("ok" = g#debug "progress" [| "5" |]);
assert (!callback_invoked > 0);
callback_invoked := 0;
g#delete_event_callback eh;
assert ("ok" = g#debug "progress" [| "5" |]);
assert (!callback_invoked = 0);
ignore (g#set_event_callback callback [Guestfs.EVENT_PROGRESS]);
assert ("ok" = g#debug "progress" [| "5" |]);
assert (!callback_invoked > 0);
g#close ()
let () = Gc.compact ()

155
ocaml/t/guestfs_500_mount_local.ml
View File

@@ -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

46
src/guestfs.pod
View File

@@ -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