114.28+32

README.org

@@ -1,4 +1,4 @@
-* SHEXP - shell scripting for OCaml
+[[shexp][/images/logo.png]]
 
 Shexp is composed of two parts: a library providing a process monad
 for shell scripting in OCaml as well as a simple s-expression based

bigstring-io-lib/test/tests.ml

@@ -1,5 +1,5 @@
 open! Core.Std
-open! Expect_test_helpers_kernel.Std
+open! Expect_test_helpers_kernel
 
 module B = Shexp_bigstring_io.Std.Bigstring
 

bigstring-lib/test/tests.ml

@@ -1,5 +1,5 @@
 open! Core.Std
-open! Expect_test_helpers_kernel.Std
+open! Expect_test_helpers_kernel
 
 module B = Shexp_bigstring.Std.Bigstring
 

posixat-lib/test/tests.ml

@@ -1,6 +1,6 @@
 open Core.Std
 open Shexp_posixat.Std
-open! Expect_test_helpers_kernel.Std
+open! Expect_test_helpers_kernel
 
 module B = Shexp_bigstring_io.Std.Bigstring
 

process-lib/src/env.ml

@@ -288,7 +288,7 @@ type run_error =
 let spawn t ~prog ~args =
   match find_executable t prog with
   | None -> Error Command_not_found
-  | Some prog ->
+  | Some real_prog ->
     let env =
       SMap.fold t.unix_env.entries ~init:[] ~f:(fun ~key ~data acc ->
         sprintf "%s=%s" key data :: acc)
@@ -302,7 +302,7 @@ let spawn t ~prog ~args =
       Spawn.spawn ()
         ~env
         ~cwd
-        ~prog
+        ~prog:real_prog
         ~argv:(prog :: args)
         ~stdin:t.stdin
         ~stdout:t.stdout

process-lib/src/process.ml

@@ -569,6 +569,56 @@ let waitpid pid : Exit_status.t =
   | WSIGNALED n -> Signaled n
   | WSTOPPED  _ -> assert false
 
+module Background_command = struct
+  type t =
+    { mutex        : Mutex.t
+    ; pid          : int
+    ; mutable wait : Exit_status.t Lazy.t
+    }
+
+  let sexp_of_t t = sexp_of_string (Printf.sprintf "[%d]" t.pid)
+
+  let create pid =
+    { mutex = Mutex.create ()
+    ; pid
+    ; wait = lazy (waitpid pid)
+    }
+
+  let pid t = t.pid
+
+  let wait t =
+    Mutex.lock t.mutex;
+    protectx t.mutex ~finally:Mutex.unlock ~f:(fun _ ->
+      Lazy.force t.wait)
+end
+
+let spawn =
+  let prim =
+    Prim.make "spawn"
+      [ A sexp_of_string
+      ; A (sexp_of_list sexp_of_string)
+      ]
+      (F Background_command.sexp_of_t)
+      (fun env prog args ->
+         match Env.spawn env ~prog ~args with
+         | Ok pid -> Background_command.create pid
+         | Error Command_not_found ->
+           Printf.ksprintf failwith "%s: command not found" (quote_for_errors prog))
+  in
+  fun prog args -> pack2 prim prog args
+
+let wait =
+  let prim =
+    Prim.make "wait"
+      [ A Background_command.sexp_of_t
+      ]
+      (F Exit_status.sexp_of_t)
+      (fun _ bc -> Background_command.wait bc)
+  in
+  fun bc -> pack1 prim bc
+
+(* This could be implemented in term of [spawn] followed by a [wait], but doing it in one
+   primitive improve traces. *)
 let run_exit_status =
   let prim =
     Prim.make "run"

process-lib/src/process.mli

@@ -190,6 +190,19 @@ val run_bool
   -> string list
   -> bool t
 
+module Background_command : sig
+  type t
+
+  val pid  : t -> int
+end
+
+(** Start an external program but do not wait for its termination. If you never call
+    [wait] on the result, the process will become a zombie after it terminates. *)
+val spawn : string -> string list -> Background_command.t t
+
+(** Wait for a background command to terminate and return its exit status. *)
+val wait : Background_command.t -> Exit_status.t t
+
 (** {1 Unix environment} *)
 
 (** Return the value associated to the given environment variable. *)

process-lib/test/errors.ml

@@ -1,5 +1,5 @@
 open! Core.Std
-open! Expect_test_helpers_kernel.Std
+open! Expect_test_helpers_kernel
 
 open Import
 

process-lib/test/logging.ml

@@ -1,5 +1,5 @@
 open! Core.Std
-open! Expect_test_helpers_kernel.Std
+open! Expect_test_helpers_kernel
 
 open Import
 

process-lib/test/regression_tests.ml

@@ -1,5 +1,5 @@
 open! Core.Std
-open! Expect_test_helpers_kernel.Std
+open! Expect_test_helpers_kernel
 
 open Import
 

process-lib/test/tests.ml

@@ -1,5 +1,5 @@
 open! Core.Std
-open! Expect_test_helpers_kernel.Std
+open! Expect_test_helpers_kernel
 
 open Import
 

process-lib/test/trace.ml

@@ -1,5 +1,5 @@
 open! Core.Std
-open! Expect_test_helpers_kernel.Std
+open! Expect_test_helpers_kernel
 
 open Import