ocaml: Test mount-local, without parallel test.

Unfortunately the parallel test keeps hitting this bug:
https://bugzilla.redhat.com/show_bug.cgi?id=838081
which could be a bug in the OCaml runtime.

Just test simple mount-local.  We will write a parallel test in C to
replace this.

5 files changed, 22 insertions, 115 deletions

diff --git a/.gitignore b/.gitignore
index 822bc074..193c79d1 100644
--- a/.gitignore
+++ b/.gitignore
@@ -246,8 +246,8 @@ Makefile.in
 /ocaml/t/guestfs_400_events.opt
 /ocaml/t/guestfs_400_progress.bc
 /ocaml/t/guestfs_400_progress.opt
-/ocaml/t/guestfs_500_parallel_mount_local.bc
-/ocaml/t/guestfs_500_parallel_mount_local.opt
+/ocaml/t/guestfs_500_mount_local.bc
+/ocaml/t/guestfs_500_mount_local.opt
 /perl/bindtests.pl
 /perl/blib
 /perl/examples/guestfs-perl.3
diff --git a/ocaml/Makefile.am b/ocaml/Makefile.am
index 9a06d5a5..e2c4667b 100644
--- a/ocaml/Makefile.am
+++ b/ocaml/Makefile.am
@@ -36,7 +36,6 @@ EXTRA_DIST = \
 	html/.gitignore \
 	META.in \
 	run-bindtests \
-	t/exit.c \
 	t/*.ml
 
 CLEANFILES = *.cmi *.cmo *.cmx *.cma *.cmxa *.o *.a *.so
@@ -92,7 +91,7 @@ test_progs += \
 	t/guestfs_010_basic \
 	t/guestfs_070_threads \
 	t/guestfs_400_progress \
-	t/guestfs_500_parallel_mount_local
+	t/guestfs_500_mount_local
 endif
 
 TESTS = run-bindtests \
@@ -168,14 +167,14 @@ t/guestfs_400_progress.opt: t/guestfs_400_progress.cmx mlguestfs.cmxa
 	mkdir -p t
 	$(OCAMLFIND) ocamlopt $(OCAMLOPTFLAGS) -cclib -L$(top_builddir)/src/.libs -I . -package unix -linkpkg mlguestfs.cmxa $< -o $@
 
-t/guestfs_500_parallel_mount_local.bc: t/guestfs_500_parallel_mount_local.cmo mlguestfs.cma libocamltestlib.a
+t/guestfs_500_mount_local.bc: t/guestfs_500_mount_local.cmo mlguestfs.cma
 	mkdir -p t
 	LD_LIBRARY_PATH=../src/.libs \
-	$(OCAMLFIND) ocamlc -custom $(OCAMLCFLAGS) -I . -package unix,threads -thread -linkpkg mlguestfs.cma libocamltestlib.a $< -o $@
+	$(OCAMLFIND) ocamlc -custom $(OCAMLCFLAGS) -I . -package unix -linkpkg mlguestfs.cma $< -o $@
 
-t/guestfs_500_parallel_mount_local.opt: t/guestfs_500_parallel_mount_local.cmx mlguestfs.cmxa libocamltestlib.a
+t/guestfs_500_mount_local.opt: t/guestfs_500_mount_local.cmx mlguestfs.cmxa
 	mkdir -p t
-	$(OCAMLFIND) ocamlopt $(OCAMLOPTFLAGS) -cclib -L$(top_builddir)/src/.libs -I . -package unix,threads -thread -linkpkg mlguestfs.cmxa libocamltestlib.a $< -o $@
+	$(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
@@ -184,16 +183,6 @@ t/guestfs_070_threads.cmo: t/guestfs_070_threads.ml mlguestfs.cma
 t/guestfs_070_threads.cmx: t/guestfs_070_threads.ml mlguestfs.cmxa
 	$(OCAMLFIND) ocamlopt $(OCAMLOPTFLAGS) -package unix,threads -thread -linkpkg -c $< -o $@
 
-t/guestfs_500_parallel_mount_local.cmo: t/guestfs_500_parallel_mount_local.ml mlguestfs.cma
-	$(OCAMLFIND) ocamlc $(OCAMLCFLAGS) -package unix,threads -thread -linkpkg -c $< -o $@
-
-t/guestfs_500_parallel_mount_local.cmx: t/guestfs_500_parallel_mount_local.ml mlguestfs.cmxa
-	$(OCAMLFIND) ocamlopt $(OCAMLOPTFLAGS) -package unix,threads -thread -linkpkg -c $< -o $@
-
-noinst_LIBRARIES += libocamltestlib.a
-libocamltestlib_a_SOURCES = t/exit.c
-libocamltestlib_a_CFLAGS = $(libguestfsocaml_a_CFLAGS)
-
 %.cmi: %.mli
 	$(OCAMLFIND) ocamlc $(OCAMLCFLAGS) -package unix -c $< -o $(builddir)/$@
 %.cmo: %.ml mlguestfs.cma
diff --git a/ocaml/t/exit.c b/ocaml/t/exit.c
deleted file mode 100644
index ca392def..00000000
--- a/ocaml/t/exit.c
+++ /dev/null
@@ -1,44 +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.
- */
-
-#include <config.h>
-
-#include <stdio.h>
-#include <stdlib.h>
-#include <unistd.h>
-
-#include <caml/alloc.h>
-#include <caml/fail.h>
-#include <caml/memory.h>
-#include <caml/misc.h>
-#include <caml/mlvalues.h>
-
-value ocaml_guestfs__exit (value) Noreturn;
-
-/* _exit : int -> 'a (does not return) */
-value
-ocaml_guestfs__exit (value statusv)
-{
-  CAMLparam1 (statusv);
-  int status = Int_val (statusv);
-
-  _exit (status);
-
-  /*NOTREACHED*/
-  CAMLnoreturn;
-}
diff --git a/ocaml/t/guestfs_500_parallel_mount_local.ml b/ocaml/t/guestfs_500_mount_local.ml
index 17e30ee7..b4dd28d7 100644
--- a/ocaml/t/guestfs_500_parallel_mount_local.ml
+++ b/ocaml/t/guestfs_500_mount_local.ml
@@ -16,27 +16,16 @@
  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  *)
 
-(* Test guestfs_mount_local, from a higher level language (it will
- * mostly be used first from Python), in parallel threads.  OCaml
- * allows us to test this at a reasonable speed.
- *)
+(* Test guestfs_mount_local. *)
 
 open Unix
 open Printf
 
 let (//) = Filename.concat
 
-(* See [exit.c]. *)
-external _exit : int -> 'a = "ocaml_guestfs__exit"
-
 (* Some settings. *)
 let total_time = 60.                 (* seconds, excluding launch *)
 let debug = true                     (* overview debugging messages *)
-let min_threads = 2
-let max_threads = 12
-let mbytes_per_thread = 900
-
-let clip low high v = min high (max low v)
 
 let rec main () =
   Random.self_init ();
@@ -45,7 +34,7 @@ let rec main () =
    * This is for RHEL 5, where FUSE doesn't work very reliably.
    *)
   let () =
-    let name = "SKIP_TEST_GUESTFS_500_PARALLEL_MOUNT_LOCAL_ML" in
+    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"
@@ -54,52 +43,26 @@ let rec main () =
     )
   in
 
-  (* Choose the number of threads based on the amount of free memory. *)
-  let nr_threads =
-    let mbytes =
-      let cmd = "LANG=C free -m | grep 'buffers/cache' | awk '{print $NF}'" in
-      let chan = open_process_in cmd in
-      let mbytes = input_line chan in
-      match close_process_in chan with
-      | WEXITED 0 -> Some (int_of_string mbytes)
-      | _ -> None in
-    match mbytes with
-    | None -> min_threads (* default *)
-    | Some mbytes ->
-      clip min_threads max_threads (mbytes / mbytes_per_thread) in
-
-  let threads = ref [] in
-  for i = 1 to nr_threads do
-    let filename = sprintf "test%d.img" i in
-    let mp = sprintf "mp%d" i in
-    (try rmdir mp with Unix_error _ -> ());
-    mkdir mp 0o700;
-
-    if debug then eprintf "%s : starting thread\n%!" mp;
-    let t = Thread.create start_thread (filename, mp) in
-    threads := (t, filename, mp) :: !threads
-  done;
+  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;
 
-  (* Wait until the threads terminate and delete the files and mountpoints. *)
-  List.iter (
-    fun (t, filename, mp) ->
-      Thread.join t;
+  start_test filename mp;
 
-      if debug then eprintf "%s : cleaning up thread\n%!" mp;
-      unlink filename;
-      rmdir mp
-  ) !threads;
+  unlink filename;
+  rmdir mp;
 
   Gc.compact ()
 
-and start_thread (filename, mp) =
+and start_test filename mp =
   (* Create a filesystem for the tests. *)
   let g = new Guestfs.guestfs () in
 
-  let fd = openfile filename [O_WRONLY;O_CREAT;O_NOCTTY;O_TRUNC] 0o666 in
-  ftruncate fd (500 * 1024 * 1024);
-  close fd;
-
   g#add_drive filename;
   g#launch ();
 
@@ -122,7 +85,7 @@ and start_thread (filename, mp) =
       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
+        with exn -> prerr_endline (Printexc.to_string exn); exit 1
       );
 
       (* Run FUSE main loop.  This processes requests until the
diff --git a/po/POTFILES b/po/POTFILES
index e3986871..6a590d47 100644
--- a/po/POTFILES
+++ b/po/POTFILES
@@ -180,7 +180,6 @@ inspector/virt-inspector.c
 java/com_redhat_et_libguestfs_GuestFS.c
 ocaml/guestfs_c.c
 ocaml/guestfs_c_actions.c
-ocaml/t/exit.c
 perl/Guestfs.c
 perl/bindtests.pl
 perl/lib/Sys/Guestfs.pm