diff --git a/infer/src/backend/CallbackOfChecker.ml b/infer/src/backend/CallbackOfChecker.ml new file mode 100644 index 000000000..a1fc5e51c --- /dev/null +++ b/infer/src/backend/CallbackOfChecker.ml @@ -0,0 +1,54 @@ +(* + * 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 + +(* make sure callbacks are set or the checkers will not be able to call into them (and get a nice + crash) *) +let () = + AnalysisCallbacks.set_callbacks + { get_proc_desc_f= Ondemand.get_proc_desc + ; html_debug_new_node_session_f= NodePrinter.with_session + ; proc_resolve_attributes_f= Summary.OnDisk.proc_resolve_attributes } + + +let interprocedural payload_field checker {Callbacks.summary; exe_env} = + let analyze_dependency proc_name = + let summary = Ondemand.analyze_proc_name ~caller_summary:summary proc_name in + Option.bind summary ~f:(fun {Summary.payloads; proc_desc; _} -> + Field.get payload_field payloads |> Option.map ~f:(fun payload -> (proc_desc, payload)) ) + in + let analyze_pdesc_dependency proc_desc = + let summary = Ondemand.analyze_proc_desc ~caller_summary:summary proc_desc in + Option.bind summary ~f:(fun {Summary.payloads; _} -> + Field.get payload_field payloads |> Option.map ~f:(fun payload -> payload) ) + in + let stats = ref summary.Summary.stats in + let update_stats ?add_symops ?failure_kind () = + stats := Summary.Stats.update ?add_symops ?failure_kind !stats + in + let result = + checker + { InterproceduralAnalysis.proc_desc= Summary.get_proc_desc summary + ; tenv= Exe_env.get_tenv exe_env (Summary.get_proc_name summary) + ; err_log= Summary.get_err_log summary + ; exe_env + ; analyze_dependency + ; analyze_pdesc_dependency + ; update_stats } + in + {summary with payloads= Field.fset payload_field summary.payloads result; stats= !stats} + + +let interprocedural_file payload_field checker {Callbacks.procedures; exe_env; source_file} = + let analyze_file_dependency proc_name = + let summary = Ondemand.analyze_proc_name_no_caller proc_name in + Option.bind summary ~f:(fun {Summary.payloads; proc_desc; _} -> + Field.get payload_field payloads |> Option.map ~f:(fun payload -> (proc_desc, payload)) ) + in + checker + {InterproceduralAnalysis.procedures; source_file; file_exe_env= exe_env; analyze_file_dependency} diff --git a/infer/src/backend/CallbackOfChecker.mli b/infer/src/backend/CallbackOfChecker.mli new file mode 100644 index 000000000..2a9900a30 --- /dev/null +++ b/infer/src/backend/CallbackOfChecker.mli @@ -0,0 +1,26 @@ +(* + * 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 + +(** Conversions from checkers taking "functional" {!Interprocedural.t} et al. payloads to + {!Callbacks.proc_callback_t} and friends. *) + +val interprocedural : + (Payloads.t, 'payload option) Field.t + -> ('payload InterproceduralAnalysis.t -> 'payload option) + -> Callbacks.proc_callback_t +(** [interprocedural field checker] expects [checker] to compute a payload (option) suitable for + [field], given an inter-procedural analysis of callees that computes the same payload type *) + +val interprocedural_file : + (Payloads.t, 'payload option) Field.t + -> ('payload InterproceduralAnalysis.file_t -> IssueLog.t) + -> Callbacks.file_callback_t +(** [interprocedural_file field checker] expects [checker] to compute an {!IssueLog.t} from the + file-level analysis, given an inter-procedural analysis of dependencies that computes the + payload type corresponding to [field] *) diff --git a/infer/src/backend/registerCheckers.ml b/infer/src/backend/registerCheckers.ml index 37354a052..7013c296a 100644 --- a/infer/src/backend/registerCheckers.ml +++ b/infer/src/backend/registerCheckers.ml @@ -18,63 +18,17 @@ let () = () -let () = - AnalysisCallbacks.set_callbacks - { get_proc_desc_f= Ondemand.get_proc_desc - ; html_debug_new_node_session_f= NodePrinter.with_session - ; proc_resolve_attributes_f= Summary.OnDisk.proc_resolve_attributes } - - type callback_fun = | Procedure of Callbacks.proc_callback_t | DynamicDispatch of Callbacks.proc_callback_t | File of {callback: Callbacks.file_callback_t; issue_dir: ResultsDirEntryName.id} -let proc_callback_of_interprocedural payload_field checker {Callbacks.summary; exe_env} = - let analyze_dependency proc_name = - let summary = Ondemand.analyze_proc_name ~caller_summary:summary proc_name in - Option.bind summary ~f:(fun {Summary.payloads; proc_desc; _} -> - Field.get payload_field payloads |> Option.map ~f:(fun payload -> (proc_desc, payload)) ) - in - let analyze_pdesc_dependency proc_desc = - let summary = Ondemand.analyze_proc_desc ~caller_summary:summary proc_desc in - Option.bind summary ~f:(fun {Summary.payloads; _} -> - Field.get payload_field payloads |> Option.map ~f:(fun payload -> payload) ) - in - let stats = ref summary.Summary.stats in - let update_stats ?add_symops ?failure_kind () = - stats := Summary.Stats.update ?add_symops ?failure_kind !stats - in - let result = - checker - { InterproceduralAnalysis.proc_desc= Summary.get_proc_desc summary - ; tenv= Exe_env.get_tenv exe_env (Summary.get_proc_name summary) - ; err_log= Summary.get_err_log summary - ; exe_env - ; analyze_dependency - ; analyze_pdesc_dependency - ; update_stats } - in - {summary with payloads= Field.fset payload_field summary.payloads result; stats= !stats} - - let dynamic_dispatch payload_field checker = - DynamicDispatch (proc_callback_of_interprocedural payload_field checker) - - -let file_callback_of_interprocedural_file payload_field checker - {Callbacks.procedures; exe_env; source_file} = - let analyze_file_dependency proc_name = - let summary = Ondemand.analyze_proc_name_no_caller proc_name in - Option.bind summary ~f:(fun {Summary.payloads; proc_desc; _} -> - Field.get payload_field payloads |> Option.map ~f:(fun payload -> (proc_desc, payload)) ) - in - checker - {InterproceduralAnalysis.procedures; source_file; file_exe_env= exe_env; analyze_file_dependency} + DynamicDispatch (CallbackOfChecker.interprocedural payload_field checker) let file issue_dir payload_field checker = - File {callback= file_callback_of_interprocedural_file payload_field checker; issue_dir} + File {callback= CallbackOfChecker.interprocedural_file payload_field checker; issue_dir} let proc_callback_of_intraprocedural ?payload_field checker {Callbacks.summary; exe_env} =