Fix handling of Control+C in watch mode (#1678)

- prevent proceses started by dune from being killed, in particular
  the file watcher
- fix handling of signals after a failing build

Fixes #1671

Signed-off-by: Jeremie Dimino <jeremie@dimino.org>

CHANGES.md

@@ -48,6 +48,8 @@ unreleased
 - Add virtual libraries feature and enable it by default (#1430 fixes #921,
   @rgrinberg)
 
+- Fix handling of Control+C in watch mode (#1678, fixes #1671, @diml)
+
 1.6.2 (05/12/2018)
 ------------------
 

src/scheduler.ml

@@ -723,7 +723,7 @@ let poll ?log ?config ~once ~finally () =
       got_signal t signal;
       Exit
   in
-  let wait msg =
+  let rec wait msg =
     let old_generator = t.gen_status_line in
     set_status_line_generator
       (fun () ->
@@ -732,25 +732,19 @@ let poll ?log ?config ~once ~finally () =
          });
     let res = block_waiting_for_changes () in
     set_status_line_generator old_generator;
-    Fiber.return res
-  in
-  let wait_success () = wait "Success" in
-  let wait_failure () = wait "Had errors" in
-  let rec main_loop () =
+    match res with
+    | Exit -> Fiber.return Got_signal
+    | Continue -> main_loop ()
+  and main_loop () =
     once ()
     >>= fun _ ->
     finally ();
-    wait_success ()
-    >>= function
-    | Exit -> Fiber.return Got_signal
-    | Continue -> main_loop ()
+    wait "Success"
   in
   let continue_on_error () =
     if not t.cur_build_canceled then begin
       finally ();
-      wait_failure ()
-      >>= fun _ ->
-      main_loop ()
+      wait "Had errors"
     end else begin
       set_status_line_generator
         (fun () ->

src/spawn.ml

@@ -4,49 +4,13 @@ module Env = struct
   let of_array t = t
 end
 
-external sys_exit : int -> 'a = "caml_sys_exit"
-
-let rec file_descr_not_standard fd =
-  assert (not Sys.win32);
-  if (Obj.magic (fd : Unix.file_descr) : int) >= 3 then
-    fd
-  else
-    file_descr_not_standard (Unix.dup fd)
-
-let safe_close fd =
-  try Unix.close fd with Unix.Unix_error _ -> ()
-
-let perform_redirections stdin stdout stderr =
-  let stdin = file_descr_not_standard stdin in
-  let stdout = file_descr_not_standard stdout in
-  let stderr = file_descr_not_standard stderr in
-  Unix.dup2 stdin Unix.stdin;
-  Unix.dup2 stdout Unix.stdout;
-  Unix.dup2 stderr Unix.stderr;
-  safe_close stdin;
-  safe_close stdout;
-  safe_close stderr
-
 let spawn ?env ~prog ~argv
       ?(stdin=Unix.stdin)
       ?(stdout=Unix.stdout)
-      ?(stderr=Unix.stderr) () =
+      ?(stderr=Unix.stderr)
+      () =
   let argv = Array.of_list argv in
-  if Sys.win32 then
-    match env with
-    | None -> Unix.create_process prog argv stdin stdout stderr
-    | Some env -> Unix.create_process_env prog argv env stdin stdout stderr
-  else
-    match Unix.fork () with
-    | 0 ->
-      begin try
-        ignore (Unix.sigprocmask SIG_SETMASK [] : int list);
-        perform_redirections stdin stdout stderr;
-        match env with
-        | None -> Unix.execv prog argv
-        | Some env -> Unix.execve prog argv env
-      with _ ->
-        sys_exit 127
-      end
-    | pid -> pid
+  match env with
+  | None -> Unix.create_process prog argv stdin stdout stderr
+  | Some env -> Unix.create_process_env prog argv env stdin stdout stderr