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)