From d1485e02f538d50fd7d4790fb63317093ba8c6bf Mon Sep 17 00:00:00 2001 From: Richard Jones Date: Wed, 1 Sep 2010 17:12:15 +0100 Subject: [PATCH] ocaml: Add test for progress notification callbacks. --- .gitignore | 1 + ocaml/Makefile.am | 10 ++++++++-- ocaml/t/guestfs_400_progress.ml | 41 +++++++++++++++++++++++++++++++++++++++++ 3 files changed, 50 insertions(+), 2 deletions(-) create mode 100644 ocaml/t/guestfs_400_progress.ml diff --git a/.gitignore b/.gitignore index 064d062..266fb74 100644 --- a/.gitignore +++ b/.gitignore @@ -170,6 +170,7 @@ ocaml/t/guestfs_010_launch ocaml/t/guestfs_050_lvcreate ocaml/t/guestfs_060_readdir ocaml/t/guestfs_070_threads +ocaml/t/guestfs_400_progress perl/bindtests.pl perl/blib perl/Guestfs.bs diff --git a/ocaml/Makefile.am b/ocaml/Makefile.am index 5c7b929..e80d44a 100644 --- a/ocaml/Makefile.am +++ b/ocaml/Makefile.am @@ -64,10 +64,12 @@ TESTS_ENVIRONMENT = \ TESTS = run-bindtests \ t/guestfs_005_load t/guestfs_010_launch t/guestfs_050_lvcreate \ - t/guestfs_060_readdir t/guestfs_070_threads + t/guestfs_060_readdir t/guestfs_070_threads \ + t/guestfs_400_progress noinst_DATA += bindtests \ t/guestfs_005_load t/guestfs_010_launch t/guestfs_050_lvcreate \ - t/guestfs_060_readdir t/guestfs_070_threads + t/guestfs_060_readdir t/guestfs_070_threads \ + t/guestfs_400_progress bindtests: bindtests.cmx mlguestfs.cmxa mkdir -p t @@ -93,6 +95,10 @@ t/guestfs_070_threads: t/guestfs_070_threads.cmx mlguestfs.cmxa mkdir -p t $(OCAMLFIND) ocamlopt -cclib -L$(top_builddir)/src/.libs -I . -package unix,threads -thread -linkpkg mlguestfs.cmxa $< -o $@ +t/guestfs_400_progress: t/guestfs_400_progress.cmx mlguestfs.cmxa + mkdir -p t + $(OCAMLFIND) ocamlopt -cclib -L$(top_builddir)/src/.libs -I . -package xml-light,unix -linkpkg mlguestfs.cmxa $< -o $@ + # Need to rebuild the tests from source if the main library has # changed at all, otherwise we get inconsistent assumptions. t/guestfs_070_threads.cmx: t/guestfs_070_threads.ml mlguestfs.cmxa diff --git a/ocaml/t/guestfs_400_progress.ml b/ocaml/t/guestfs_400_progress.ml new file mode 100644 index 0000000..7227fac --- /dev/null +++ b/ocaml/t/guestfs_400_progress.ml @@ -0,0 +1,41 @@ +(* 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., 675 Mass Ave, Cambridge, MA 02139, 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 + G.set_progress_callback g cb; + assert ("ok" = G.debug g "progress" [| "5" |]); + assert (!calls > 0); + calls := 0; + G.clear_progress_callback g; + assert ("ok" = G.debug g "progress" [| "5" |]); + assert (!calls = 0); + G.set_progress_callback g cb; + assert ("ok" = G.debug g "progress" [| "5" |]); + assert (!calls > 0); + + G.close g; + Gc.compact () -- 1.8.3.1