[log] fix gc stats merging

Summary:
Messed up the aggregation of GC stats in the previous commit.

It's cleaner to have GC stats (and analysis time) outside of
BackendStats as the rules for computing them is different than the rest,
eg notice how "analysis time" needed to be corrected at the end of the
run, and similarly for GC stats. Thus, refactor this part.

Also output different aggregations of GC stats: +/max/average.

Reviewed By: skcho

Differential Revision: D22332496

fbshipit-source-id: eefd9dd72

infer/src/backend/BackendStats.ml

@@ -23,12 +23,7 @@ include struct
     ; mutable proc_locker_lock_time: ExecutionDuration.t
     ; mutable proc_locker_unlock_time: ExecutionDuration.t
     ; mutable restart_scheduler_useful_time: ExecutionDuration.t
-    ; mutable restart_scheduler_total_time: ExecutionDuration.t
-    ; mutable scheduler_process_analysis_time: ExecutionDuration.t
-          (** - [scheduler_process_analysis_time.wall] counts the wall time of the analysis phase
-              - [scheduler_process_analysis_time.(user|sys)] counts the [(user|sys)] time only of
-                the scheduler_process *)
-    ; mutable gc_stats: GCStats.t option }
+    ; mutable restart_scheduler_total_time: ExecutionDuration.t }
   [@@deriving fields]
 end
 
@@ -43,9 +38,7 @@ let global_stats =
   ; proc_locker_lock_time= ExecutionDuration.zero
   ; proc_locker_unlock_time= ExecutionDuration.zero
   ; restart_scheduler_useful_time= ExecutionDuration.zero
-  ; restart_scheduler_total_time= ExecutionDuration.zero
-  ; scheduler_process_analysis_time= ExecutionDuration.zero
-  ; gc_stats= None }
+  ; restart_scheduler_total_time= ExecutionDuration.zero }
 
 
 let get () = global_stats
@@ -92,11 +85,6 @@ let add_to_restart_scheduler_total_time execution_duration =
   add Fields.restart_scheduler_total_time execution_duration
 
 
-let set_analysis_time stats execution_duration =
-  let set_opt = Field.setter Fields.scheduler_process_analysis_time in
-  Option.iter set_opt ~f:(fun set -> set stats execution_duration)
-
-
 let copy from ~into : unit =
   let { summary_file_try_load
       ; summary_read_from_disk
@@ -108,16 +96,13 @@ let copy from ~into : unit =
       ; proc_locker_lock_time
       ; proc_locker_unlock_time
       ; restart_scheduler_useful_time
-      ; restart_scheduler_total_time
-      ; scheduler_process_analysis_time
-      ; gc_stats } =
+      ; restart_scheduler_total_time } =
     from
   in
   Fields.Direct.set_all_mutable_fields into ~summary_file_try_load ~summary_read_from_disk
     ~summary_cache_hits ~summary_cache_misses ~ondemand_procs_analyzed ~ondemand_local_cache_hits
     ~ondemand_local_cache_misses ~proc_locker_lock_time ~proc_locker_unlock_time
-    ~restart_scheduler_useful_time ~restart_scheduler_total_time ~scheduler_process_analysis_time
-    ~gc_stats
+    ~restart_scheduler_useful_time ~restart_scheduler_total_time
 
 
 let merge stats1 stats2 =
@@ -138,8 +123,7 @@ let merge stats1 stats2 =
         stats2.restart_scheduler_useful_time
   ; restart_scheduler_total_time=
       ExecutionDuration.add stats1.restart_scheduler_total_time stats2.restart_scheduler_total_time
-  ; scheduler_process_analysis_time= ExecutionDuration.zero
-  ; gc_stats= Option.merge stats1.gc_stats stats2.gc_stats ~f:GCStats.merge }
+  }
 
 
 let initial =
@@ -153,22 +137,12 @@ let initial =
   ; proc_locker_lock_time= ExecutionDuration.zero
   ; proc_locker_unlock_time= ExecutionDuration.zero
   ; restart_scheduler_useful_time= ExecutionDuration.zero
-  ; restart_scheduler_total_time= ExecutionDuration.zero
-  ; scheduler_process_analysis_time= ExecutionDuration.zero
-  ; gc_stats= None }
-
+  ; restart_scheduler_total_time= ExecutionDuration.zero }
 
-let reset () =
-  copy initial ~into:global_stats ;
-  global_stats.gc_stats <- Some (GCStats.get ~since:ProgramStart)
 
+let reset () = copy initial ~into:global_stats
 
 let pp f stats =
-  let pp_field pp_value stats f field =
-    let field_value = Field.get field stats in
-    let field_name = Field.name field in
-    F.fprintf f "%s = %a@;" field_name pp_value field_value
-  in
   let pp_hit_percent hit miss f =
     let total = hit + miss in
     if Int.equal total 0 then F.pp_print_string f "N/A%%" else F.fprintf f "%d%%" (hit * 100 / total)
@@ -179,7 +153,7 @@ let pp f stats =
   let pp_execution_duration_field stats f field =
     let field_value = Field.get field stats in
     let field_name = Field.name field in
-    F.fprintf f "%a@;" (ExecutionDuration.pp ~field:field_name) field_value
+    F.fprintf f "%a@;" (ExecutionDuration.pp ~prefix:field_name) field_value
   in
   let pp_cache_hits stats cache_misses f cache_hits_field =
     let cache_hits = Field.get cache_hits_field stats in
@@ -197,8 +171,6 @@ let pp f stats =
       ~proc_locker_unlock_time:(pp_execution_duration_field stats f)
       ~restart_scheduler_useful_time:(pp_execution_duration_field stats f)
       ~restart_scheduler_total_time:(pp_execution_duration_field stats f)
-      ~scheduler_process_analysis_time:(pp_execution_duration_field stats f)
-      ~gc_stats:(pp_field (Pp.option GCStats.pp) stats f)
   in
   F.fprintf f "@[Backend stats:@\n@[<v2>  %t@]@]@." (pp_stats stats)
 
@@ -207,21 +179,9 @@ let log_to_scuba stats =
   let create_counter field =
     [LogEntry.mk_count ~label:("backend_stats." ^ Field.name field) ~value:(Field.get field stats)]
   in
-  let secs_to_ms s = s *. 1000. |> Float.to_int in
   let create_time_entry field =
-    let field_value = Field.get field stats in
-    [ LogEntry.mk_time
-        ~label:("backend_stats." ^ Field.name field ^ "_sys")
-        ~duration_ms:(ExecutionDuration.sys_time field_value |> secs_to_ms)
-    ; LogEntry.mk_time
-        ~label:("backend_stats." ^ Field.name field ^ "_user")
-        ~duration_ms:(ExecutionDuration.user_time field_value |> secs_to_ms)
-    ; LogEntry.mk_time
-        ~label:("backend_stats." ^ Field.name field ^ "_wall")
-        ~duration_ms:(ExecutionDuration.wall_time field_value |> secs_to_ms) ]
-  in
-  let create_scuba_option scuba_creator field =
-    match Field.get field stats with None -> [] | Some value -> scuba_creator value
+    Field.get field stats
+    |> ExecutionDuration.to_scuba_entries ~prefix:("backend_stats." ^ Field.name field)
   in
   let entries =
     Fields.to_list ~summary_file_try_load:create_counter ~summary_read_from_disk:create_counter
@@ -230,8 +190,16 @@ let log_to_scuba stats =
       ~ondemand_local_cache_misses:create_counter ~proc_locker_lock_time:create_time_entry
       ~proc_locker_unlock_time:create_time_entry ~restart_scheduler_useful_time:create_time_entry
       ~restart_scheduler_total_time:create_time_entry
-      ~scheduler_process_analysis_time:create_time_entry
-      ~gc_stats:(create_scuba_option (GCStats.to_scuba_entries ~prefix:"backend"))
     |> List.concat
   in
   ScubaLogging.log_many entries
+
+
+let log_aggregate stats_list =
+  match stats_list with
+  | [] ->
+      L.internal_error "Empty list of backend stats to aggregate, weird!@\n"
+  | one :: rest ->
+      let stats = List.fold rest ~init:one ~f:(fun aggregate one -> merge aggregate one) in
+      L.debug Analysis Quiet "%a" pp stats ;
+      log_to_scuba stats

infer/src/backend/BackendStats.mli

@@ -10,8 +10,6 @@ open! IStd
 
 type t
 
-val initial : t
-
 val incr_summary_file_try_load : unit -> unit
 (** a query to the filesystem attempting to load a summary file *)
 
@@ -36,18 +34,11 @@ val add_to_restart_scheduler_total_time : ExecutionDuration.t -> unit
 
 val add_to_restart_scheduler_useful_time : ExecutionDuration.t -> unit
 
-val set_analysis_time : t -> ExecutionDuration.t -> unit
-
 val reset : unit -> unit
 (** reset all stats *)
 
 val get : unit -> t
 (** get the stats so far *)
 
-val pp : Format.formatter -> t -> unit
-
-val merge : t -> t -> t
-(** return a new value that adds up the stats in both arguments *)
-
-val log_to_scuba : t -> unit
-(** Log aggregated backend stats to Scuba. Use after the stats have been fully calculated *)
+val log_aggregate : t list -> unit
+(** log aggregated stats to infer's log file and to Scuba *)

infer/src/backend/ExecutionDuration.ml

@@ -7,6 +7,7 @@
 
 open! IStd
 module F = Format
+module L = Logging
 
 module Duration = struct
   type t = {time: float; comp: float}
@@ -59,9 +60,9 @@ let sys_time exe_duration = Duration.secs exe_duration.sys
 
 let wall_time exe_duration = Mtime.Span.to_s exe_duration.wall
 
-let pp ~field fmt exe_duration =
-  F.fprintf fmt "%s_user= %.8f@;%s_sys= %.8f@;%s_wall= %.8f" field (user_time exe_duration) field
-    (sys_time exe_duration) field (wall_time exe_duration)
+let pp ~prefix fmt exe_duration =
+  F.fprintf fmt "%s_user= %.8f@;%s_sys= %.8f@;%s_wall= %.8f" prefix (user_time exe_duration) prefix
+    (sys_time exe_duration) prefix (wall_time exe_duration)
 
 
 let counter () = {process_times= Unix.times (); wall_time= Mtime_clock.counter ()}
@@ -70,3 +71,16 @@ let timed_evaluate ~f =
   let start = counter () in
   let result = f () in
   {result; execution_duration= since start}
+
+
+let to_scuba_entries ~prefix exe_duration =
+  let secs_to_ms s = s *. 1000. |> Float.to_int in
+  [ LogEntry.mk_time ~label:(prefix ^ "_sys") ~duration_ms:(sys_time exe_duration |> secs_to_ms)
+  ; LogEntry.mk_time ~label:(prefix ^ "_user") ~duration_ms:(user_time exe_duration |> secs_to_ms)
+  ; LogEntry.mk_time ~label:(prefix ^ "_wall") ~duration_ms:(wall_time exe_duration |> secs_to_ms)
+  ]
+
+
+let log ~prefix debug_kind exe_duration =
+  L.debug debug_kind Quiet "%a@\n" (pp ~prefix) exe_duration ;
+  ScubaLogging.log_many (to_scuba_entries ~prefix exe_duration)

infer/src/backend/ExecutionDuration.mli

@@ -23,12 +23,13 @@ val add_duration_since : t -> counter -> t
 
 val add : t -> t -> t
 
-val user_time : t -> float
-
-val sys_time : t -> float
-
 val wall_time : t -> float
 
-val pp : field:string -> Format.formatter -> t -> unit
+val pp : prefix:string -> Format.formatter -> t -> unit
 
 val timed_evaluate : f:(unit -> 'a) -> 'a evaluation_result
+
+val log : prefix:string -> Logging.debug_kind -> t -> unit
+(** log to debug logs and to Scuba *)
+
+val to_scuba_entries : prefix:string -> t -> LogEntry.t list

infer/src/backend/GCStats.ml

@@ -18,8 +18,7 @@ type t =
   ; minor_collections: int
   ; major_collections: int
   ; compactions: int
-  ; max_top_heap_words: int  (** like [Gc.top_heap_words], aggregated with [max] *)
-  ; added_top_heap_words: int  (** like [Gc.top_heap_words], aggregated with [(+)] *) }
+  ; top_heap_words: int }
 
 type since = ProgramStart | PreviousStats of t
 
@@ -33,8 +32,7 @@ let get ~since =
       ; minor_collections= stats.minor_collections
       ; major_collections= stats.major_collections
       ; compactions= stats.compactions
-      ; max_top_heap_words= stats.top_heap_words
-      ; added_top_heap_words= stats.top_heap_words }
+      ; top_heap_words= stats.top_heap_words }
   | PreviousStats stats_prev ->
       (* [top_heap_words] is going to be inaccurate if it was reached in the previous time period *)
       { minor_words= stats.minor_words -. stats_prev.minor_words
@@ -43,19 +41,7 @@ let get ~since =
       ; minor_collections= stats.minor_collections - stats_prev.minor_collections
       ; major_collections= stats.major_collections - stats_prev.major_collections
       ; compactions= stats.compactions - stats_prev.compactions
-      ; max_top_heap_words= stats.top_heap_words
-      ; added_top_heap_words= stats.top_heap_words }
-
-
-let merge stats1 stats2 =
-  { minor_words= stats1.minor_words +. stats2.minor_words
-  ; promoted_words= stats1.promoted_words +. stats2.promoted_words
-  ; major_words= stats1.major_words +. stats2.major_words
-  ; minor_collections= stats1.minor_collections + stats2.minor_collections
-  ; major_collections= stats1.major_collections + stats2.major_collections
-  ; compactions= stats1.compactions + stats2.compactions
-  ; max_top_heap_words= max stats1.max_top_heap_words stats2.max_top_heap_words
-  ; added_top_heap_words= stats1.added_top_heap_words + stats2.added_top_heap_words }
+      ; top_heap_words= stats.top_heap_words }
 
 
 let pp f
@@ -65,8 +51,7 @@ let pp f
      ; minor_collections
      ; major_collections
      ; compactions
-     ; max_top_heap_words
-     ; added_top_heap_words }[@warning "+9"]) =
+     ; top_heap_words }[@warning "+9"]) =
   F.fprintf f
     "@[<v2>  minor_words: %g@;\
      promoted_words: %g@;\
@@ -74,11 +59,10 @@ let pp f
      minor_collections: %d@;\
      major_collections: %d@;\
      compactions: %d@;\
-     max top_heap_words: %d@;\
-     cumulative top_heap_words: %d@;\
+     top_heap_words: %d@;\
      @]"
     minor_words promoted_words major_words minor_collections major_collections compactions
-    max_top_heap_words added_top_heap_words
+    top_heap_words
 
 
 let to_scuba_entries ~prefix (stats : t) =
@@ -91,8 +75,7 @@ let to_scuba_entries ~prefix (stats : t) =
   ; create_counter "minor_collections" stats.minor_collections
   ; create_counter "major_collections" stats.major_collections
   ; create_counter "compactions" stats.compactions
-  ; create_counter "max_top_heap_words" stats.max_top_heap_words
-  ; create_counter "added_top_heap_words" stats.added_top_heap_words ]
+  ; create_counter "top_heap_words" stats.top_heap_words ]
 
 
 let log_to_scuba ~prefix stats = ScubaLogging.log_many (to_scuba_entries ~prefix stats)
@@ -108,3 +91,49 @@ let log_f ~name debug_kind f =
   let stats_f = get ~since:(PreviousStats stats_before_f) in
   log ~name debug_kind stats_f ;
   r
+
+
+let merge_add stats1 stats2 =
+  { minor_words= stats1.minor_words +. stats2.minor_words
+  ; promoted_words= stats1.promoted_words +. stats2.promoted_words
+  ; major_words= stats1.major_words +. stats2.major_words
+  ; minor_collections= stats1.minor_collections + stats2.minor_collections
+  ; major_collections= stats1.major_collections + stats2.major_collections
+  ; compactions= stats1.compactions + stats2.compactions
+  ; top_heap_words= stats1.top_heap_words + stats2.top_heap_words }
+
+
+let merge_max stats1 stats2 =
+  { minor_words= Float.max stats1.minor_words stats2.minor_words
+  ; promoted_words= Float.max stats1.promoted_words stats2.promoted_words
+  ; major_words= Float.max stats1.major_words stats2.major_words
+  ; minor_collections= max stats1.minor_collections stats2.minor_collections
+  ; major_collections= max stats1.major_collections stats2.major_collections
+  ; compactions= max stats1.compactions stats2.compactions
+  ; top_heap_words= max stats1.top_heap_words stats2.top_heap_words }
+
+
+let log_aggregate ~prefix debug_kind stats_list =
+  match stats_list with
+  | [] ->
+      ()
+  | [stats] ->
+      log ~name:prefix debug_kind stats
+  | stats_one :: stats_rest ->
+      let stats_add = List.fold ~init:stats_one stats_rest ~f:merge_add in
+      let stats_max = List.fold ~init:stats_one stats_rest ~f:merge_max in
+      let n = List.length stats_list in
+      let stats_average =
+        let n_f = Float.of_int n in
+        { minor_words= stats_add.minor_words /. n_f
+        ; promoted_words= stats_add.promoted_words /. n_f
+        ; major_words= stats_add.major_words /. n_f
+        ; minor_collections= stats_add.minor_collections / n
+        ; major_collections= stats_add.major_collections / n
+        ; compactions= stats_add.compactions / n
+        ; top_heap_words= stats_add.top_heap_words / n }
+      in
+      log ~name:(prefix ^ "gc_stats_add.") debug_kind stats_add ;
+      log ~name:(prefix ^ "gc_stats_max.") debug_kind stats_max ;
+      L.debug debug_kind Quiet "Average over %d processes@\n" n ;
+      log ~name:(prefix ^ "gc_stats_average.") debug_kind stats_average

infer/src/backend/GCStats.mli

@@ -6,20 +6,10 @@
  *)
 
 open! IStd
-module F = Format
 module L = Logging
 
 type t
 
-val pp : F.formatter -> t -> unit
-
-val log : name:string -> L.debug_kind -> t -> unit
-(** log to infer's log file and to Scuba *)
-
-val log_f : name:string -> L.debug_kind -> (unit -> 'a) -> 'a
-(** log GC stats for the duration of the function passed as argument to infer's log file and to
-    Scuba *)
-
 type since =
   | ProgramStart  (** get GC stats from the beginning of the program *)
   | PreviousStats of t
@@ -28,7 +18,12 @@ type since =
 
 val get : since:since -> t
 
-val merge : t -> t -> t
-(** combine statistics from two processes *)
+val log : name:string -> L.debug_kind -> t -> unit
+(** log to infer's log file and to Scuba *)
+
+val log_aggregate : prefix:string -> L.debug_kind -> t list -> unit
+(** log aggregate to infer's log file and to Scuba *)
 
-val to_scuba_entries : prefix:string -> t -> LogEntry.t list
+val log_f : name:string -> L.debug_kind -> (unit -> 'a) -> 'a
+(** log GC stats for the duration of the function passed as argument to infer's log file and to
+    Scuba *)

infer/src/backend/InferAnalyze.ml

@@ -132,8 +132,9 @@ let analyze source_files_to_analyze =
     let target_files =
       List.rev_map (Lazy.force source_files_to_analyze) ~f:(fun sf -> TaskSchedulerTypes.File sf)
     in
+    let pre_analysis_gc_stats = GCStats.get ~since:ProgramStart in
     Tasks.run_sequentially ~f:analyze_target target_files ;
-    BackendStats.get () )
+    ([BackendStats.get ()], [GCStats.get ~since:(PreviousStats pre_analysis_gc_stats)]) )
   else (
     L.environment_info "Parallel jobs: %d@." Config.jobs ;
     let build_tasks_generator () =
@@ -142,18 +143,37 @@ let analyze source_files_to_analyze =
     (* Prepare tasks one file at a time while executing in parallel *)
     RestartScheduler.setup () ;
     let runner =
-      Tasks.Runner.create ~jobs:Config.jobs ~f:analyze_target ~child_epilogue:BackendStats.get
+      (* use a ref to pass data from prologue to epilogue without too much machinery *)
+      let gc_stats_pre_fork = ref None in
+      let child_prologue () =
+        BackendStats.reset () ;
+        gc_stats_pre_fork := Some (GCStats.get ~since:ProgramStart)
+      in
+      let child_epilogue () =
+        let gc_stats_in_fork =
+          match !gc_stats_pre_fork with
+          | Some stats ->
+              Some (GCStats.get ~since:(PreviousStats stats))
+          | None ->
+              L.internal_error "child did not store GC stats in its prologue, what happened?" ;
+              None
+        in
+        (BackendStats.get (), gc_stats_in_fork)
+      in
+      Tasks.Runner.create ~jobs:Config.jobs ~f:analyze_target ~child_prologue ~child_epilogue
         ~tasks:build_tasks_generator
     in
     let workers_stats = Tasks.Runner.run runner in
     RestartScheduler.clean () ;
     let collected_stats =
-      Array.fold workers_stats ~init:BackendStats.initial ~f:(fun collated_stats stats_opt ->
+      Array.fold workers_stats ~init:([], [])
+        ~f:(fun ((backend_stats_list, gc_stats_list) as stats_list) stats_opt ->
           match stats_opt with
           | None ->
-              collated_stats
-          | Some stats ->
-              BackendStats.merge stats collated_stats )
+              stats_list
+          | Some (backend_stats, gc_stats_opt) ->
+              ( backend_stats :: backend_stats_list
+              , Option.fold ~init:gc_stats_list ~f:(fun l x -> x :: l) gc_stats_opt ) )
     in
     collected_stats )
 
@@ -208,11 +228,12 @@ let main ~changed_files =
   let source_files = lazy (get_source_files_to_analyze ~changed_files) in
   (* empty all caches to minimize the process heap to have less work to do when forking *)
   clear_caches () ;
-  let stats = analyze source_files in
+  let backend_stats_list, gc_stats_list = analyze source_files in
+  BackendStats.log_aggregate backend_stats_list ;
+  GCStats.log_aggregate ~prefix:"backend_stats." Analysis gc_stats_list ;
   let analysis_duration = ExecutionDuration.since start in
-  BackendStats.set_analysis_time stats analysis_duration ;
   L.debug Analysis Quiet "Analysis phase finished in %a@\n" Mtime.Span.pp_float_s
     (ExecutionDuration.wall_time analysis_duration) ;
-  L.debug Analysis Quiet "Collected stats:@\n%a@." BackendStats.pp stats ;
-  BackendStats.log_to_scuba stats ;
+  ExecutionDuration.log ~prefix:"backend_stats.scheduler_process_analysis_time" Analysis
+    analysis_duration ;
   ()

infer/src/backend/Tasks.ml

@@ -9,11 +9,6 @@ open! IStd
 
 type ('a, 'b) doer = 'a -> 'b option
 
-let fork_protect ~f x =
-  BackendStats.reset () ;
-  ForkUtils.protect ~f x
-
-
 let with_new_db_connection ~f () =
   ResultsDatabase.new_database_connection () ;
   f ()
@@ -22,15 +17,15 @@ let with_new_db_connection ~f () =
 module Runner = struct
   type ('work, 'final, 'result) t = ('work, 'final, 'result) ProcessPool.t
 
-  let create ~jobs ~f ~child_epilogue ~tasks =
+  let create ~jobs ~child_prologue ~f ~child_epilogue ~tasks =
     PerfEvent.(
       log (fun logger -> log_begin_event logger ~categories:["sys"] ~name:"fork prepare" ())) ;
     ResultsDatabase.db_close () ;
     let pool =
       ProcessPool.create ~jobs ~f ~child_epilogue ~tasks:(with_new_db_connection ~f:tasks)
-        ~child_prelude:
-          ((* hack: run post-fork bookkeeping stuff by passing a dummy function to [fork_protect] *)
-           fork_protect ~f:(fun () -> ()))
+        ~child_prologue:
+          ((* hack: we'll continue executing after the function passed to [protect], despite what he name might suggest *)
+           ForkUtils.protect ~f:child_prologue)
     in
     PerfEvent.(log (fun logger -> log_end_event logger ())) ;
     pool

infer/src/backend/Tasks.mli

@@ -12,15 +12,13 @@ type ('a, 'b) doer = 'a -> 'b option
 val run_sequentially : f:('a, 'b) doer -> 'a list -> unit
 (** Run the tasks sequentially *)
 
-val fork_protect : f:('a -> 'b) -> 'a -> 'b
-(** does the bookkeeping necessary to safely execute an infer function [f] after a call to fork(2) *)
-
 (** A runner accepts new tasks repeatedly for parallel execution *)
 module Runner : sig
   type ('work, 'final, 'result) t
 
   val create :
        jobs:int
+    -> child_prologue:(unit -> unit)
     -> f:('work, 'result) doer
     -> child_epilogue:(unit -> 'final)
     -> tasks:(unit -> ('work, 'result) ProcessPool.TaskGenerator.t)

infer/src/base/ForkUtils.mli

@@ -0,0 +1,11 @@
+(*
+ * Copyright (c) Facebook, Inc. and its affiliates.
+ *
+ * This source code is licensed under the MIT license found in the
+ * LICENSE file in the root directory of this source tree.
+ *)
+
+open! IStd
+
+val protect : f:('a -> 'b) -> 'a -> 'b
+(** does the bookkeeping necessary to safely execute an infer function [f] after a call to fork(2) *)

infer/src/base/ProcessPool.ml

@@ -374,7 +374,7 @@ let rec child_loop ~slot send_to_parent send_final receive_from_parent ~f ~epilo
 
     The child inherits [updates_w] to send updates up to the parent, and a new pipe is set up for
     the parent to send instructions down to the child. *)
-let fork_child ~file_lock ~child_prelude ~slot (updates_r, updates_w) ~f ~epilogue =
+let fork_child ~file_lock ~child_prologue ~slot (updates_r, updates_w) ~f ~epilogue =
   let to_child_r, to_child_w = Unix.pipe () in
   match Unix.fork () with
   | `In_the_child ->
@@ -384,7 +384,7 @@ let fork_child ~file_lock ~child_prelude ~slot (updates_r, updates_w) ~f ~epilog
       Utils.set_best_cpu_for slot ;
       ProcessPoolState.in_child := true ;
       ProcessPoolState.reset_pid () ;
-      child_prelude () ;
+      child_prologue () ;
       let updates_oc = Unix.out_channel_of_descr updates_w in
       let send_to_parent (message : 'b worker_message) =
         marshal_to_pipe ~file_lock updates_oc message
@@ -432,19 +432,19 @@ let rec create_pipes n = if Int.equal n 0 then [] else Unix.pipe () :: create_pi
 
 let create :
        jobs:int
-    -> child_prelude:(unit -> unit)
+    -> child_prologue:(unit -> unit)
     -> f:('work -> 'result option)
     -> child_epilogue:(unit -> 'final)
     -> tasks:(unit -> ('work, 'result) TaskGenerator.t)
     -> ('work, 'final, 'result) t =
- fun ~jobs ~child_prelude ~f ~child_epilogue ~tasks ->
+ fun ~jobs ~child_prologue ~f ~child_epilogue ~tasks ->
   let file_lock = Utils.create_file_lock () in
   let task_bar = TaskBar.create ~jobs in
   let children_pipes = create_pipes jobs in
   let slots =
     Array.init jobs ~f:(fun slot ->
         let child_pipe = List.nth_exn children_pipes slot in
-        fork_child ~file_lock ~child_prelude ~slot child_pipe ~f ~epilogue:child_epilogue )
+        fork_child ~file_lock ~child_prologue ~slot child_pipe ~f ~epilogue:child_epilogue )
   in
   ProcessPoolState.has_running_children := true ;
   Epilogues.register ~description:"Wait children processes exit" ~f:(fun () ->

infer/src/base/ProcessPool.mli

@@ -55,7 +55,7 @@ type (_, _, _) t
 
 val create :
      jobs:int
-  -> child_prelude:(unit -> unit)
+  -> child_prologue:(unit -> unit)
   -> f:('work -> 'result option)
   -> child_epilogue:(unit -> 'final)
   -> tasks:(unit -> ('work, 'result) TaskGenerator.t)

infer/src/inferunit.ml

@@ -13,7 +13,7 @@ let rec mk_test_fork_proof test =
   let open OUnitTest in
   match test with
   | TestCase (length, f) ->
-      TestCase (length, Tasks.fork_protect ~f)
+      TestCase (length, ForkUtils.protect ~f)
   | TestList l ->
       TestList (List.map ~f:mk_test_fork_proof l)
   | TestLabel (label, test) ->

infer/src/integration/CaptureCompilationDatabase.ml

@@ -60,7 +60,11 @@ let run_compilation_database compilation_database should_capture_file =
   (* no stats to record so [child_epilogue] does nothing and we ignore the return
      {!Tasks.Runner.run} *)
   let runner =
-    Tasks.Runner.create ~jobs:Config.jobs ~f:invoke_cmd ~child_epilogue:(fun () -> ()) ~tasks
+    Tasks.Runner.create ~jobs:Config.jobs
+      ~child_prologue:(fun () -> ())
+      ~f:invoke_cmd
+      ~child_epilogue:(fun () -> ())
+      ~tasks
   in
   Tasks.Runner.run runner |> ignore ;
   L.progress "@." ;