diff options
Diffstat (limited to 'lib/spawn.ml')
| -rw-r--r-- | lib/spawn.ml | 40 |
1 files changed, 17 insertions, 23 deletions
diff --git a/lib/spawn.ml b/lib/spawn.ml index 4d35ded9..47917697 100644 --- a/lib/spawn.ml +++ b/lib/spawn.ml @@ -43,7 +43,7 @@ module type MainLoopModel = sig end (* Common code *) -let assert_ b s = if not b then Errors.anomaly (Pp.str s) +let assert_ b s = if not b then CErrors.anomaly (Pp.str s) (* According to http://caml.inria.fr/mantis/view.php?id=5325 * you can't use the same socket for both writing and reading (may change @@ -78,20 +78,6 @@ let accept (sr,sw) = set_binary_mode_out cout true; (csr, csw), cin, cout -let handshake cin cout = - try - output_value cout (Hello (proto_version,Unix.getpid ())); flush cout; - match input_value cin with - | Hello(v, pid) when v = proto_version -> - prerr_endline (Printf.sprintf "Handshake with %d OK" pid); - pid - | _ -> raise (Failure "handshake protocol") - with - | Failure s | Invalid_argument s | Sys_error s -> - pr_err ("Handshake failed: " ^ s); raise (Failure "handshake") - | End_of_file -> - pr_err "Handshake failed: End_of_file"; raise (Failure "handshake") - let spawn_sock env prog args = let main_sock, main_sock_name = mk_socket_channel () in let extra = [| prog; "-main-channel"; main_sock_name |] in @@ -206,7 +192,7 @@ let spawn ?(prefer_sock=prefer_sock) ?(env=Unix.environment ()) let live = callback cl ~read_all:(fun () -> ML.read_all gchan) in if not live then kill p; live - with e when Errors.noncritical e -> + with e when CErrors.noncritical e -> pr_err ("Async reader raised: " ^ (Printexc.to_string e)); kill p; false) gchan @@ -220,10 +206,13 @@ let stats { oob_req; oob_resp; alive } = input_value oob_resp let rec wait p = - try snd (Unix.waitpid [] p.pid) - with - | Unix.Unix_error (Unix.EINTR, _, _) -> wait p - | Unix.Unix_error _ -> Unix.WEXITED 0o400 + (* On windows kill is not reliable, so wait may never return. *) + if Sys.os_type = "Unix" then + try snd (Unix.waitpid [] p.pid) + with + | Unix.Unix_error (Unix.EINTR, _, _) -> wait p + | Unix.Unix_error _ -> Unix.WEXITED 0o400 + else Unix.WEXITED 0o400 end @@ -267,8 +256,13 @@ let stats { oob_req; oob_resp; alive } = flush oob_req; let RespStats g = input_value oob_resp in g -let wait { pid = unixpid } = - try snd (Unix.waitpid [] unixpid) - with Unix.Unix_error _ -> Unix.WEXITED 0o400 +let rec wait p = + (* On windows kill is not reliable, so wait may never return. *) + if Sys.os_type = "Unix" then + try snd (Unix.waitpid [] p.pid) + with + | Unix.Unix_error (Unix.EINTR, _, _) -> wait p + | Unix.Unix_error _ -> Unix.WEXITED 0o400 + else Unix.WEXITED 0o400 end |