_

Signed-off-by: Jeremie Dimino <[email protected]>

bench/bench.ml

@@ -88,24 +88,16 @@ let prepare_workspace () =
       Format.eprintf "cloning %s/%s@." pkg.org pkg.name;
       Package.clone pkg)
 
-let with_timer f =
-  let start = Unix.time () in
-  let res = f () in
-  let stop = Unix.time () in
-  (stop -. start, res)
-
 let dune_build () =
   let stdin_from = Process.(Io.null In) in
   let stdout_to = Process.(Io.file Config.dev_null Out) in
   let stderr_to = Process.(Io.file Config.dev_null Out) in
-  let start = Unix.time () in
   let open Fiber.O in
-  let+ () =
-    Process.run Strict (Lazy.force dune) ~stdin_from ~stdout_to ~stderr_to
+  let+ times =
+    Process.run_with_times (Lazy.force dune) ~stdin_from ~stdout_to ~stderr_to
       [ "build"; "@install"; "--root"; "." ]
   in
-  let stop = Unix.time () in
-  stop -. start
+  times.elapsed_time
 
 let run_bench () =
   let open Fiber.O in

otherlibs/stdune-unstable/proc.ml

@@ -23,17 +23,40 @@ let restore_cwd_and_execve prog argv ~env =
     Unix.execve prog argv env
   )
 
-type resource_usage =
-  { utime : float
-  ; stime : float
-  }
+module Resource_usage = struct
+  type t =
+    { user_cpu_time : float
+    ; system_cpu_time : float
+    }
+end
+
+module Times = struct
+  type t =
+    { elapsed_time : float
+    ; resource_usage : Resource_usage.t option
+    }
+end
+
+module Process_info = struct
+  type t =
+    { pid : Pid.t
+    ; status : Unix.process_status
+    ; end_time : float
+    ; resource_usage : Resource_usage.t option
+    }
+end
 
 external stub_wait3 :
-  Unix.wait_flag list -> int * Unix.process_status * resource_usage
+  Unix.wait_flag list -> int * Unix.process_status * float * Resource_usage.t
   = "dune_wait3"
 
-let wait3 flags =
+let wait flags =
   if Sys.win32 then
     Code_error.raise "wait3 not available on windows" []
   else
-    stub_wait3 flags
+    let pid, status, end_time, resource_usage = stub_wait3 flags in
+    { Process_info.pid = Pid.of_int pid
+    ; status
+    ; end_time
+    ; resource_usage = Some resource_usage
+    }

otherlibs/stdune-unstable/proc.mli

@@ -1,8 +1,30 @@
 val restore_cwd_and_execve : string -> string list -> env:Env.t -> _
 
-type resource_usage =
-  { utime : float
-  ; stime : float
-  }
+module Resource_usage : sig
+  type t =
+    { user_cpu_time : float
+          (** Same as the "user" time reported by the "time" command *)
+    ; system_cpu_time : float
+          (** Same as the "sys" time reported by the "time" command *)
+    }
+end
 
-val wait3 : Unix.wait_flag list -> int * Unix.process_status * resource_usage
+module Times : sig
+  type t =
+    { elapsed_time : float
+          (** Same as the "real" time reported by the "time" command *)
+    ; resource_usage : Resource_usage.t option
+    }
+end
+
+module Process_info : sig
+  type t =
+    { pid : Pid.t
+    ; status : Unix.process_status
+    ; end_time : float  (** Time at which the process finished. *)
+    ; resource_usage : Resource_usage.t option
+    }
+end
+
+(** This function is not implemented on Windows *)
+val wait : Unix.wait_flag list -> Process_info.t

otherlibs/stdune-unstable/wait3_stubs.c

@@ -49,12 +49,14 @@ value dune_wait3(value flags) {
   CAMLlocal2(times, res);
 
   int pid, status, cv_flags;
+  struct timeval tp;
   cv_flags = caml_convert_flag_list(flags, wait_flag_table);
 
   struct rusage ru;
 
   caml_enter_blocking_section();
   pid = wait3(&status, cv_flags, &ru);
+  gettimeofday(&tp, NULL);
   caml_leave_blocking_section();
   if (pid == -1)
     uerror("wait3", Nothing);
@@ -63,10 +65,11 @@ value dune_wait3(value flags) {
   Store_double_field(times, 0, ru.ru_utime.tv_sec + ru.ru_utime.tv_usec / 1e6);
   Store_double_field(times, 1, ru.ru_stime.tv_sec + ru.ru_stime.tv_usec / 1e6);
 
-  res = caml_alloc_tuple(3);
+  res = caml_alloc_tuple(4);
   Store_field(res, 0, Val_int(pid));
   Store_field(res, 1, alloc_process_status(status));
-  Store_field(res, 2, times);
+  Store_field(res, 2, caml_copy_double(((double) tp.tv_sec + (double) tp.tv_usec / 1e6)));
+  Store_field(res, 3, times);
   CAMLreturn(res);
 }
 

src/dune_engine/process.ml

@@ -475,37 +475,22 @@ module Exit_status = struct
          :: Option.to_list output)
 end
 
-let report_process_start stats ~id ~prog ~args =
+let report_process_start stats ~id ~prog ~args ~now =
   let common =
     let name = Filename.basename prog in
-    let ts = Timestamp.now () in
+    let ts = Timestamp.of_float_seconds now in
     Event.common_fields ~cat:[ "process" ] ~name ~ts ()
   in
   let args =
     [ ("process_args", `List (List.map args ~f:(fun arg -> `String arg))) ]
   in
   let event = Event.async (Int id) ~args Start common in
   Stats.emit stats event;
-  common
+  (common, args)
 
-let report_process_end stats common ~id =
-  let common = Event.set_ts common (Timestamp.now ()) in
-  let event = Event.async (Int id) End common in
-  Stats.emit stats event
-
-let report_process_event stats ~prog ~args
-    (resource_usage : Proc.resource_usage) =
-  let common =
-    let name = Filename.basename prog in
-    let ts = Timestamp.now () in
-    Event.common_fields ~cat:[ "process" ] ~name ~ts ()
-  in
-  let args =
-    [ ("process_args", `List (List.map args ~f:(fun arg -> `String arg))) ]
-  in
-  let dur =
-    Chrome_trace.Event.Timestamp.of_float_seconds resource_usage.stime
-  in
+let report_process_end stats (common, args) ~now (times : Proc.Times.t) =
+  let common = Event.set_ts common (Timestamp.of_float_seconds now) in
+  let dur = Chrome_trace.Event.Timestamp.of_float_seconds times.elapsed_time in
   let event = Event.complete ~args ~dur common in
   Stats.emit stats event
 
@@ -602,7 +587,7 @@ let run_internal ?dir ?(stdout_to = Io.stdout) ?(stderr_to = Io.stderr)
           (stdout, stderr)
         | _ -> ((`No_capture, stdout_to), (`No_capture, stderr_to))
       in
-      let event_common, pid =
+      let event_common, started_at, pid =
         (* Output.fd might create the file with Unix.openfile. We need to make
            sure to call it before doing the chdir as the path might be relative. *)
         let stdout = Io.fd stdout_to in
@@ -611,35 +596,37 @@ let run_internal ?dir ?(stdout_to = Io.stdout) ?(stderr_to = Io.stderr)
         let env =
           env |> Dtemp.add_to_env |> Scheduler.Config.add_to_env config
         in
-        let event_common =
-          match config.stats with
-          | Some stats when Sys.win32 ->
-            (* We track process times manually on windows. Elsewhere, we can use
-               [wait3] *)
-            Some (report_process_start stats ~id ~prog:prog_str ~args)
-          | _ -> None
-        in
         let env = Env.to_unix env |> Spawn.Env.of_list in
-        let pid =
-          Spawn.spawn () ~prog:prog_str ~argv ~env ~stdout ~stderr ~stdin
-            ~cwd:
-              (match dir with
-              | None -> Inherit
-              | Some dir -> Path (Path.to_string dir))
-          |> Pid.of_int
+        let started_at, pid =
+          (* jeremiedimino: I think we should do this just before the [execve]
+             in the stub for [Spawn.spawn] to be as precise as possible *)
+          let now = Unix.gettimeofday () in
+          ( now
+          , Spawn.spawn () ~prog:prog_str ~argv ~env ~stdout ~stderr ~stdin
+              ~cwd:
+                (match dir with
+                | None -> Inherit
+                | Some dir -> Path (Path.to_string dir))
+            |> Pid.of_int )
+        in
+        let event_common =
+          Option.map config.stats ~f:(fun stats ->
+              ( stats
+              , report_process_start stats ~id ~prog:prog_str ~args
+                  ~now:started_at ))
         in
-        (event_common, pid)
+        (event_common, started_at, pid)
       in
       Io.release stdout_to;
       Io.release stderr_to;
-      let+ exit_status, resource_usage = Scheduler.wait_for_process pid in
-      (match (event_common, config.stats, resource_usage) with
-      | Some common, Some stats, None -> report_process_end stats common ~id
-      | None, Some stats, Some resource_usage ->
-        report_process_event stats ~prog:prog_str ~args resource_usage
-      | None, None, _ -> ()
-      | None, Some _, None -> assert false
-      | Some _, _, _ -> assert false);
+      let+ process_info = Scheduler.wait_for_process pid in
+      let times =
+        { Proc.Times.elapsed_time = process_info.end_time -. started_at
+        ; resource_usage = process_info.resource_usage
+        }
+      in
+      Option.iter event_common ~f:(fun (stats, common) ->
+          report_process_end stats common ~now:process_info.end_time times);
       Option.iter response_file ~f:Path.unlink;
       let actual_stdout =
         match stdout_capture with
@@ -667,7 +654,7 @@ let run_internal ?dir ?(stdout_to = Io.stdout) ?(stderr_to = Io.stderr)
         has_unexpected_output stderr_on_success actual_stderr
       in
       let exit_status' : Exit_status.t =
-        match exit_status with
+        match process_info.status with
         | WEXITED n
           when (not has_unexpected_stdout)
                && (not has_unexpected_stderr)
@@ -703,31 +690,43 @@ let run_internal ?dir ?(stdout_to = Io.stdout) ?(stderr_to = Io.stderr)
           swallow_on_success_if_requested fn actual_stderr stderr_on_success
       in
       let output = stdout ^ stderr in
-      Log.command ~command_line ~output ~exit_status;
-      match (display, exit_status', output) with
-      | (Quiet | Progress), Ok n, "" -> n (* Optimisation for the common case *)
-      | Verbose, _, _ ->
-        Exit_status.handle_verbose exit_status' ~id
-          ~command_line:fancy_command_line ~output
-      | _ ->
-        Exit_status.handle_non_verbose exit_status' ~prog:prog_str ~command_line
-          ~output ~purpose ~display ~has_unexpected_stdout
-          ~has_unexpected_stderr)
+      Log.command ~command_line ~output ~exit_status:process_info.status;
+      let res =
+        match (display, exit_status', output) with
+        | (Quiet | Progress), Ok n, "" ->
+          n (* Optimisation for the common case *)
+        | Verbose, _, _ ->
+          Exit_status.handle_verbose exit_status' ~id
+            ~command_line:fancy_command_line ~output
+        | _ ->
+          Exit_status.handle_non_verbose exit_status' ~prog:prog_str
+            ~command_line ~output ~purpose ~display ~has_unexpected_stdout
+            ~has_unexpected_stderr
+      in
+      (res, times))
 
 let run ?dir ?stdout_to ?stderr_to ?stdin_from ?env ?(purpose = Internal_job)
     fail_mode prog args =
   let+ run =
     run_internal ?dir ?stdout_to ?stderr_to ?stdin_from ?env ~purpose fail_mode
       prog args
+    >>| fst
   in
   map_result fail_mode run ~f:ignore
 
+let run_with_times ?dir ?stdout_to ?stderr_to ?stdin_from ?env
+    ?(purpose = Internal_job) prog args =
+  run_internal ?dir ?stdout_to ?stderr_to ?stdin_from ?env ~purpose Strict prog
+    args
+  >>| snd
+
 let run_capture_gen ?dir ?stderr_to ?stdin_from ?env ?(purpose = Internal_job)
     fail_mode prog args ~f =
   let fn = Temp.create File ~prefix:"dune" ~suffix:".output" in
   let+ run =
     run_internal ?dir ~stdout_to:(Io.file fn Io.Out) ?stderr_to ?stdin_from ?env
       ~purpose fail_mode prog args
+    >>| fst
   in
   map_result fail_mode run ~f:(fun () ->
       let x = f fn in

src/dune_engine/process.mli

@@ -69,6 +69,17 @@ val run :
   -> string list
   -> 'a Fiber.t
 
+val run_with_times :
+     ?dir:Path.t
+  -> ?stdout_to:Io.output Io.t
+  -> ?stderr_to:Io.output Io.t
+  -> ?stdin_from:Io.input Io.t
+  -> ?env:Env.t
+  -> ?purpose:purpose
+  -> Path.t
+  -> string list
+  -> Proc.Times.t Fiber.t
+
 (** Run a command and capture its output *)
 val run_capture :
      ?dir:Path.t