diff --git a/.gitignore b/.gitignore index 3a36ab7e9..eb1e7493b 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 70dd7f445..92bb7d046 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_010_load.ml b/ocaml/t/guestfs_010_load.ml new file mode 100644 index 000000000..c9935d1a4 --- /dev/null +++ b/ocaml/t/guestfs_010_load.ml @@ -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 () diff --git a/ocaml/t/guestfs_020_create.ml b/ocaml/t/guestfs_020_create.ml new file mode 100644 index 000000000..524adea15 --- /dev/null +++ b/ocaml/t/guestfs_020_create.ml @@ -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 () diff --git a/ocaml/t/guestfs_400_progress.ml b/ocaml/t/guestfs_030_create_flags.ml similarity index 53% rename from ocaml/t/guestfs_400_progress.ml rename to ocaml/t/guestfs_030_create_flags.ml index 2cd3194fa..9c1d1c138 100644 --- a/ocaml/t/guestfs_400_progress.ml +++ b/ocaml/t/guestfs_030_create_flags.ml @@ -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 () diff --git a/ocaml/t/guestfs_040_create_multiple.ml b/ocaml/t/guestfs_040_create_multiple.ml new file mode 100644 index 000000000..88ce23388 --- /dev/null +++ b/ocaml/t/guestfs_040_create_multiple.ml @@ -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 () diff --git a/ocaml/t/guestfs_050_handle_properties.ml b/ocaml/t/guestfs_050_handle_properties.ml new file mode 100644 index 000000000..dbf98c7bb --- /dev/null +++ b/ocaml/t/guestfs_050_handle_properties.ml @@ -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 () diff --git a/ocaml/t/guestfs_005_load.ml b/ocaml/t/guestfs_060_explicit_close.ml similarity index 88% rename from ocaml/t/guestfs_005_load.ml rename to ocaml/t/guestfs_060_explicit_close.ml index dfd813305..d4ede7dbb 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_070_optargs.ml b/ocaml/t/guestfs_070_optargs.ml new file mode 100644 index 000000000..38c4318ac --- /dev/null +++ b/ocaml/t/guestfs_070_optargs.ml @@ -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 () diff --git a/ocaml/t/guestfs_070_threads.ml b/ocaml/t/guestfs_070_threads.ml deleted file mode 100644 index 35e6ab712..000000000 --- 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 a4858e5c9..ae90100fa 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_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 e2b2f6ca0..d434e989a 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 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 () 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 baf834074..a8897c287 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))) + (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 () diff --git a/ocaml/t/guestfs_430_progress_messages.ml b/ocaml/t/guestfs_430_progress_messages.ml new file mode 100644 index 000000000..faa37dfd2 --- /dev/null +++ b/ocaml/t/guestfs_430_progress_messages.ml @@ -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 () diff --git a/ocaml/t/guestfs_500_mount_local.ml b/ocaml/t/guestfs_500_mount_local.ml deleted file mode 100644 index ca89a63a8..000000000 --- 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 a0c268184..ee9cc2a14 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. +=head2 ADDING A NEW LANGUAGE BINDING + +All language bindings must be generated by the generator +(see the C subdirectory). + +There is no documentation for this yet. We suggest you look +at an existing binding, eg. C or +C. + +=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