From dfc15372c43a5560c6014e31934efda0793fedb5 Mon Sep 17 00:00:00 2001
From: Sam Blackshear <shb@fb.com>
Date: Tue, 26 Sep 2017 10:58:22 -0700
Subject: [PATCH] [checkers] make get_proc_desc usable from cluster checkers

Reviewed By: ngorogiannis

Differential Revision: D5912546

fbshipit-source-id: 880bf2d
---
 infer/src/backend/callbacks.ml     | 14 +++++++++-----
 infer/src/backend/callbacks.mli    |  8 +++++---
 infer/src/checkers/ThreadSafety.ml |  4 ++--
 3 files changed, 16 insertions(+), 10 deletions(-)

diff --git a/infer/src/backend/callbacks.ml b/infer/src/backend/callbacks.ml
index 381791429..b9c36a006 100644
--- a/infer/src/backend/callbacks.ml
+++ b/infer/src/backend/callbacks.ml
@@ -22,7 +22,10 @@ type proc_callback_args =
 
 type proc_callback_t = proc_callback_args -> Specs.summary
 
-type cluster_callback_t = (Tenv.t * Procdesc.t) list -> unit
+type cluster_callback_args =
+  {procedures: (Tenv.t * Procdesc.t) list; get_proc_desc: Typ.Procname.t -> Procdesc.t option}
+
+type cluster_callback_t = cluster_callback_args -> unit
 
 let procedure_callbacks = ref []
 
@@ -65,10 +68,11 @@ let iterate_procedure_callbacks exe_env summary caller_pname =
         !procedure_callbacks
 
 (** Invoke all registered cluster callbacks on a cluster of procedures. *)
-let iterate_cluster_callbacks all_procs exe_env =
-  let environment = List.filter_map ~f:(get_procedure_definition exe_env) all_procs in
+let iterate_cluster_callbacks all_procs exe_env get_proc_desc =
+  let procedures = List.filter_map ~f:(get_procedure_definition exe_env) all_procs in
+  let environment = {procedures; get_proc_desc} in
   let language_matches language =
-    match environment with
+    match procedures with
     | (_, pdesc) :: _
      -> Config.equal_language language (get_language (Procdesc.get_proc_name pdesc))
     | _
@@ -112,7 +116,7 @@ let iterate_callbacks call_graph exe_env =
   (* Invoke procedure callbacks using on-demand anlaysis schedulling *)
   List.iter ~f:analyze_proc_name procs_to_analyze ;
   (* Invoke cluster callbacks. *)
-  iterate_cluster_callbacks procs_to_analyze exe_env ;
+  iterate_cluster_callbacks procs_to_analyze exe_env get_proc_desc ;
   (* Unregister callbacks *)
   Ondemand.unset_callbacks () ;
   Config.curr_language := saved_language
diff --git a/infer/src/backend/callbacks.mli b/infer/src/backend/callbacks.mli
index 74201cf57..18f390e74 100644
--- a/infer/src/backend/callbacks.mli
+++ b/infer/src/backend/callbacks.mli
@@ -20,13 +20,15 @@ type proc_callback_args =
 
 (** Type of a procedure callback:
     - List of all the procedures the callback will be called on.
-    - get_proc_desc to get a proc desc from a proc name.
-    - Idenv to look up the definition of ids in a cfg.
+    - get_proc_desc to get a proc desc from a proc name
     - Type environment.
     - Procedure for the callback to act on. *)
 type proc_callback_t = proc_callback_args -> Specs.summary
 
-type cluster_callback_t = (Tenv.t * Procdesc.t) list -> unit
+type cluster_callback_args =
+  {procedures: (Tenv.t * Procdesc.t) list; get_proc_desc: Typ.Procname.t -> Procdesc.t option}
+
+type cluster_callback_t = cluster_callback_args -> unit
 
 val register_procedure_callback : Config.language -> proc_callback_t -> unit
 (** register a procedure callback *)
diff --git a/infer/src/checkers/ThreadSafety.ml b/infer/src/checkers/ThreadSafety.ml
index 3ae5c2820..f0f728359 100644
--- a/infer/src/checkers/ThreadSafety.ml
+++ b/infer/src/checkers/ThreadSafety.ml
@@ -1669,7 +1669,7 @@ let aggregate_by_class file_env =
 
 (* Gathers results by analyzing all the methods in a file, then post-processes the results to check
    an (approximation of) thread safety *)
-let file_analysis file_env =
+let file_analysis {Callbacks.procedures} =
   String.Map.iter
     ~f:(fun class_env -> report_unsafe_accesses (make_results_table class_env))
-    (aggregate_by_class file_env)
+    (aggregate_by_class procedures)