pghs975uc
/
infer_clone
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Cleanup global state in module Fork.

Browse Source 
Reviewed By: jberdine

Differential Revision: D2936013

fb-gh-sync-id: 0feb830
shipit-source-id: 0feb830
master
Cristiano Calcagno 9 years ago committed by facebook-github-bot-5
parent de31246399
commit bf2909dd34
3 changed files with 81 additions and 75 deletions
Show Stats Download Patch File Download Diff File

129
infer/src/backend/fork.ml
Unescape View File

@ -11,30 +11,37 @@
module L = Logging module L = Logging
module F = Format module F = Format
module WeightedPnameSet = (** Procedure name with weight given by the number of in-calls.
Set.Make(struct Used to form a set ordered by weight. *)
module WeightedPname =
struct
type t = (Procname.t * Cg.in_out_calls) type t = (Procname.t * Cg.in_out_calls)
let compare let compare (pn1, calls1) (pn2, calls2) =
((pn1: Procname.t), (calls1: Cg.in_out_calls)) let n = int_compare calls1.Cg.in_calls calls2.Cg.in_calls in
((pn2: Procname.t), (calls2: Cg.in_out_calls)) = if n != 0 then n
let n = int_compare calls1.Cg.in_calls calls2.Cg.in_calls in if n != 0 then n
else Procname.compare pn1 pn2 else Procname.compare pn1 pn2
end) end
let weighted_pname_from_cg cg pname =
(pname, Cg.get_calls cg pname)
module WeightedPnameSet =
Set.Make(WeightedPname)
let pp_weightedpnameset fmt set = let pp_weightedpnameset fmt set =
let f (pname, _) = F.fprintf fmt "%a@ " Procname.pp pname in let f (pname, _) = F.fprintf fmt "%a@ " Procname.pp pname in
WeightedPnameSet.iter f set WeightedPnameSet.iter f set
let compute_weighed_pnameset gr = let compute_weighed_pnameset cg =
let pnameset = ref WeightedPnameSet.empty in let set = ref WeightedPnameSet.empty in
let add_pname_calls (pn, calls) = let add_pname_calls (pn, _) =
pnameset := WeightedPnameSet.add (pn, calls) !pnameset in set := WeightedPnameSet.add (weighted_pname_from_cg cg pn) !set in
IList.iter add_pname_calls (Cg.get_nodes_and_calls gr); IList.iter add_pname_calls (Cg.get_nodes_and_calls cg);
!pnameset !set
(* Return true if there are no children of [pname] whose specs (* Return true if there are no children of [pname] whose specs
have changed since [pname] was last analyzed. *) have changed since [pname] was last analyzed. *)
let proc_is_up_to_date gr pname = let proc_is_up_to_date cg pname =
match Specs.get_summary pname with match Specs.get_summary pname with
| None -> false | None -> false
| Some summary -> | Some summary ->
@ -44,18 +51,18 @@ let proc_is_up_to_date gr pname =
Procname.Map.find dependent_proc summary.Specs.dependency_map Procname.Map.find dependent_proc summary.Specs.dependency_map
with Not_found -> (* can happen in on-demand *) with Not_found -> (* can happen in on-demand *)
true in true in
Procname.Set.for_all filter (Cg.get_defined_children gr pname) Procname.Set.for_all filter (Cg.get_defined_children cg pname)
(** Return the list of procedures which should perform a phase (** Return the list of procedures which should perform a phase
transition from [FOOTPRINT] to [RE_EXECUTION] *) transition from [FOOTPRINT] to [RE_EXECUTION] *)
let should_perform_transition gr proc_name : Procname.t list = let should_perform_transition cg proc_name : Procname.t list =
let recursive_dependents = let recursive_dependents =
if !Config.ondemand_enabled then Procname.Set.empty if !Config.ondemand_enabled then Procname.Set.empty
else Cg.get_recursive_dependents gr proc_name in else Cg.get_recursive_dependents cg proc_name in
let recursive_dependents_plus_self = Procname.Set.add proc_name recursive_dependents in let recursive_dependents_plus_self = Procname.Set.add proc_name recursive_dependents in
let should_transition = let should_transition =
Specs.get_phase proc_name == Specs.FOOTPRINT && Specs.get_phase proc_name == Specs.FOOTPRINT &&
Procname.Set.for_all (proc_is_up_to_date gr) recursive_dependents in Procname.Set.for_all (proc_is_up_to_date cg) recursive_dependents in
if should_transition then Procname.Set.elements recursive_dependents_plus_self if should_transition then Procname.Set.elements recursive_dependents_plus_self
else [] else []
@ -156,29 +163,39 @@ let update_specs proc_name phase (new_specs : Specs.NormSpec.t list)
SpecMap.iter convert !current_specs; SpecMap.iter convert !current_specs;
!res,!changed !res,!changed
let tot_procs = ref 0 (** Total number of procedures to analyze *) module GlobalState =
let num_procs_done = ref 0 (** Number of procedures done *) struct
let wpnames_todo = ref WeightedPnameSet.empty (** Weighted pnames (procedure names with weight) to do *) (** Total number of procedures to analyze *)
let tot_files = ref 1 (** Total number of files in all the clusters *) let tot_procs =
let tot_files_done = ref 0 (** Total number of files done so far *) ref 0
let this_cluster_files = ref 1 (** Number of files in the current cluster *)
(** Number of procedures done *)
let num_procs_done =
ref 0
(** Weighted pnames (procedure names with weight) to do *)
let wpnames_todo =
ref WeightedPnameSet.empty
end
module G = GlobalState
(** Return true if [pname] is done and requires no further analysis *) (** Return true if [pname] is done and requires no further analysis *)
let proc_is_done gr pname = let proc_is_done cg pname =
not (WeightedPnameSet.mem (pname, Cg.get_calls gr pname) !wpnames_todo) not (WeightedPnameSet.mem (weighted_pname_from_cg cg pname) !G.wpnames_todo)
(** flag to activate tracing of the algorithm *) (** flag to activate tracing of the algorithm *)
let trace = ref false let trace = ref false
(** Return true if [pname] has just become done *) (** Return true if [pname] has just become done *)
let procs_become_done gr pname : Procname.t list = let procs_become_done cg pname : Procname.t list =
let recursive_dependents = Cg.get_recursive_dependents gr pname in let recursive_dependents = Cg.get_recursive_dependents cg pname in
let nonrecursive_dependents = Cg.get_nonrecursive_dependents gr pname in let nonrecursive_dependents = Cg.get_nonrecursive_dependents cg pname in
let summary = Specs.get_summary_unsafe "procs_become_done" pname in let summary = Specs.get_summary_unsafe "procs_become_done" pname in
let is_done = Specs.get_timestamp summary <> 0 && let is_done = Specs.get_timestamp summary <> 0 &&
(!Config.only_footprint || Specs.get_phase pname == Specs.RE_EXECUTION) && (!Config.only_footprint || Specs.get_phase pname == Specs.RE_EXECUTION) &&
Procname.Set.for_all (proc_is_done gr) nonrecursive_dependents && Procname.Set.for_all (proc_is_done cg) nonrecursive_dependents &&
Procname.Set.for_all (proc_is_up_to_date gr) recursive_dependents in Procname.Set.for_all (proc_is_up_to_date cg) recursive_dependents in
if !trace then L.err "proc is%s done@." (if is_done then "" else " not"); if !trace then L.err "proc is%s done@." (if is_done then "" else " not");
if is_done if is_done
then then
@ -197,11 +214,11 @@ let post_process_procs exe_env procs_done =
end in end in
let cg = Exe_env.get_cg exe_env in let cg = Exe_env.get_cg exe_env in
IList.iter (fun pn -> IList.iter (fun pn ->
let elem = (pn, Cg.get_calls cg pn) in let elem = weighted_pname_from_cg cg pn in
if WeightedPnameSet.mem elem !wpnames_todo then if WeightedPnameSet.mem elem !G.wpnames_todo then
begin begin
incr num_procs_done; incr G.num_procs_done;
wpnames_todo := WeightedPnameSet.remove (pn, Cg.get_calls cg pn) !wpnames_todo; G.wpnames_todo := WeightedPnameSet.remove elem !G.wpnames_todo;
let whole_seconds = false in let whole_seconds = false in
check_no_specs pn; check_no_specs pn;
Printer.proc_write_log whole_seconds (Exe_env.get_cfg exe_env pn) pn Printer.proc_write_log whole_seconds (Exe_env.get_cfg exe_env pn) pn
@ -219,19 +236,10 @@ let filter_max exe_env filter set priority_set =
Config.footprint := Specs.get_phase proc_name = Specs.FOOTPRINT; Config.footprint := Specs.get_phase proc_name = Specs.FOOTPRINT;
let file_name = Exe_env.get_source exe_env proc_name in let file_name = Exe_env.get_source exe_env proc_name in
let action = if !Config.footprint then "Discovering" else "Verifying" in let action = if !Config.footprint then "Discovering" else "Verifying" in
let pp_cluster_info fmt () =
let files_done_previous_clusters = float_of_int !tot_files_done in
let ratio_procs_this_cluster =
(float_of_int !num_procs_done) /. (float_of_int !tot_procs) in
let files_done_this_cluster =
(float_of_int !this_cluster_files) *. ratio_procs_this_cluster in
let files_done = files_done_previous_clusters +. files_done_this_cluster in
let perc_total = 100. *. files_done /. (float_of_int !tot_files) in
F.fprintf fmt " (%3.2f%% total)" perc_total in
L.err "@\n**%s specs: %a file: %s@\n" L.err "@\n**%s specs: %a file: %s@\n"
action Procname.pp proc_name (DB.source_file_to_string file_name); action Procname.pp proc_name (DB.source_file_to_string file_name);
L.err " %d/%d procedures done%a@." L.err " %d/%d procedures done@."
!num_procs_done !tot_procs pp_cluster_info (); !G.num_procs_done !G.tot_procs;
elem elem
end end
else else
@ -325,13 +333,14 @@ let main_algorithm exe_env analyze_proc filter_out process_result : unit =
let filter_initial (pname, _) = let filter_initial (pname, _) =
let summary = Specs.get_summary_unsafe "main_algorithm" pname in let summary = Specs.get_summary_unsafe "main_algorithm" pname in
Specs.get_timestamp summary = 0 in Specs.get_timestamp summary = 0 in
wpnames_todo := WeightedPnameSet.filter filter_initial (compute_weighed_pnameset call_graph); G.wpnames_todo :=
WeightedPnameSet.filter filter_initial (compute_weighed_pnameset call_graph);
let wpnames_address_of = (* subset of the procedures whose address is taken *) let wpnames_address_of = (* subset of the procedures whose address is taken *)
let address_taken_of n = let address_taken_of n =
Procname.Set.mem n (Cfg.get_priority_procnames (Exe_env.get_cfg exe_env n)) in Procname.Set.mem n (Cfg.get_priority_procnames (Exe_env.get_cfg exe_env n)) in
WeightedPnameSet.filter (fun (n, _) -> address_taken_of n) !wpnames_todo in WeightedPnameSet.filter (fun (n, _) -> address_taken_of n) !G.wpnames_todo in
tot_procs := WeightedPnameSet.cardinal !wpnames_todo; G.tot_procs := WeightedPnameSet.cardinal !G.wpnames_todo;
num_procs_done := 0; G.num_procs_done := 0;
let max_timeout = ref 1 in let max_timeout = ref 1 in
let wpname_can_be_analyzed (pname, _) : bool = let wpname_can_be_analyzed (pname, _) : bool =
(* Return true if [pname] is not up to date and it can be analyzed right now *) (* Return true if [pname] is not up to date and it can be analyzed right now *)
@ -351,7 +360,7 @@ let main_algorithm exe_env analyze_proc filter_out process_result : unit =
with Not_found -> false with Not_found -> false
else else
false in false in
let process_one_proc pname (calls: Cg.in_out_calls) = let process_one_proc ((pname, _) as elem) =
DB.current_source := DB.current_source :=
(Specs.get_summary_unsafe "main_algorithm" pname) (Specs.get_summary_unsafe "main_algorithm" pname)
.Specs.attributes.ProcAttributes.loc.Location.file; .Specs.attributes.ProcAttributes.loc.Location.file;
@ -371,31 +380,31 @@ let main_algorithm exe_env analyze_proc filter_out process_result : unit =
begin begin
max_timeout := max (Specs.get_iterations pname) !max_timeout; max_timeout := max (Specs.get_iterations pname) !max_timeout;
Specs.update_dependency_map pname; Specs.update_dependency_map pname;
process_result exe_env (pname, calls) (analyze_proc exe_env (pname, calls)); process_result exe_env elem (analyze_proc exe_env elem);
end in end in
while not (WeightedPnameSet.is_empty !wpnames_todo) do while not (WeightedPnameSet.is_empty !G.wpnames_todo) do
begin begin
if !trace then begin if !trace then begin
let analyzable_pnames = WeightedPnameSet.filter wpname_can_be_analyzed !wpnames_todo in let analyzable_pnames = WeightedPnameSet.filter wpname_can_be_analyzed !G.wpnames_todo in
L.err "Nodes todo: %a@\n" pp_weightedpnameset !wpnames_todo; L.err "Nodes todo: %a@\n" pp_weightedpnameset !G.wpnames_todo;
L.err "Analyzable procs: %a@\n" pp_weightedpnameset analyzable_pnames L.err "Analyzable procs: %a@\n" pp_weightedpnameset analyzable_pnames
end; end;
try try
let pname, calls = let elem =
(** find max analyzable proc *) (** find max analyzable proc *)
filter_max exe_env wpname_can_be_analyzed !wpnames_todo wpnames_address_of in filter_max exe_env wpname_can_be_analyzed !G.wpnames_todo wpnames_address_of in
process_one_proc pname calls process_one_proc elem
with Not_found -> (* no analyzable procs *) with Not_found -> (* no analyzable procs *)
L.err "Error: can't analyze any procs. Printing current spec table@\n@[<v>%a@]@." L.err "Error: can't analyze any procs. Printing current spec table@\n@[<v>%a@]@."
(Specs.pp_spec_table pe_text false) (); (Specs.pp_spec_table pe_text false) ();
if !Config.ondemand_enabled then wpnames_todo := WeightedPnameSet.empty if !Config.ondemand_enabled then G.wpnames_todo := WeightedPnameSet.empty
else raise (Failure "Stopping") else raise (Failure "Stopping")
end end
done done
type analyze_proc = Exe_env.t -> Procname.t -> Specs.summary type analyze_proc = Exe_env.t -> Procname.t -> Specs.summary
type process_result = Exe_env.t -> (Procname.t * Cg.in_out_calls) -> Specs.summary -> unit type process_result = Exe_env.t -> WeightedPname.t -> Specs.summary -> unit
type filter_out = Cg.t -> Procname.t -> bool type filter_out = Cg.t -> Procname.t -> bool

3
infer/src/backend/fork.mli
Unescape View File

@ -16,9 +16,6 @@ module Timeout : sig
val exe_timeout : int -> ('a -> unit) -> 'a -> Utils.failure_kind option val exe_timeout : int -> ('a -> unit) -> 'a -> Utils.failure_kind option
end end
val this_cluster_files : int ref (** Number of files in the current cluster *)
val tot_files : int ref (** Total number of files in all the clusters *)
val tot_files_done : int ref (** Total number of files done so far *)
(** {2 Algorithm} *) (** {2 Algorithm} *)

22
infer/src/backend/inferanalyze.ml
Unescape View File

@ -376,7 +376,10 @@ module Simulator = struct (** Simulate the analysis only *)
Fork.transition_footprint_re_exe proc_name joined_pres in Fork.transition_footprint_re_exe proc_name joined_pres in
IList.iter f proc_names IList.iter f proc_names
let process_result (exe_env: Exe_env.t) ((proc_name: Procname.t), (calls: Cg.in_out_calls)) (_summ: Specs.summary) : unit = let process_result
(exe_env: Exe_env.t)
((proc_name: Procname.t), (calls: Cg.in_out_calls))
(_summ: Specs.summary) : unit =
L.err "in process_result %a@." Procname.pp proc_name; L.err "in process_result %a@." Procname.pp proc_name;
let summ = let summ =
{ _summ with { _summ with
@ -788,15 +791,15 @@ let exe_env_from_cluster cluster =
(** Analyze a cluster of files *) (** Analyze a cluster of files *)
let analyze_cluster cluster_num tot_clusters (cluster : Cluster.t) = let analyze_cluster cluster_num tot_clusters (cluster : Cluster.t) =
incr cluster_num; let cluster_num_ref = ref cluster_num in
incr cluster_num_ref;
let exe_env = exe_env_from_cluster cluster in let exe_env = exe_env_from_cluster cluster in
let num_files = IList.length cluster in let num_files = IList.length cluster in
let defined_procs = Cg.get_defined_nodes (Exe_env.get_cg exe_env) in let defined_procs = Cg.get_defined_nodes (Exe_env.get_cg exe_env) in
let num_procs = IList.length defined_procs in let num_procs = IList.length defined_procs in
L.err "@.Processing cluster #%d/%d with %d files and %d procedures@." !cluster_num tot_clusters num_files num_procs; L.err "@.Processing cluster #%d/%d with %d files and %d procedures@."
Fork.this_cluster_files := num_files; !cluster_num_ref tot_clusters num_files num_procs;
analyze exe_env; analyze exe_env
Fork.tot_files_done := num_files + !Fork.tot_files_done
let process_cluster_cmdline_exit () = let process_cluster_cmdline_exit () =
match !cluster_cmdline with match !cluster_cmdline with
@ -807,9 +810,7 @@ let process_cluster_cmdline_exit () =
L.err "Cannot find cluster file %s@." fname; L.err "Cannot find cluster file %s@." fname;
exit 0 exit 0
| Some (nr, tot_nr, cluster) -> | Some (nr, tot_nr, cluster) ->
Fork.tot_files_done := (nr - 1) * IList.length cluster; analyze_cluster (nr - 1) tot_nr cluster;
Fork.tot_files := tot_nr * IList.length cluster;
analyze_cluster (ref (nr -1)) tot_nr cluster;
exit 0) exit 0)
let open_output_file f fname = let open_output_file f fname =
@ -914,7 +915,6 @@ let () =
let tot_clusters = IList.length clusters in let tot_clusters = IList.length clusters in
Fork.tot_files := IList.fold_left (fun n cluster -> n + IList.length cluster) 0 clusters; IList.iter (analyze_cluster 0 tot_clusters) clusters;
IList.iter (analyze_cluster (ref 0) tot_clusters) clusters;
teardown_logging analyzer_out_of analyzer_err_of; teardown_logging analyzer_out_of analyzer_err_of;
if !cluster_cmdline = None then L.stdout "Analysis finished in %as@." pp_elapsed_time () if !cluster_cmdline = None then L.stdout "Analysis finished in %as@." pp_elapsed_time ()

Write Preview
Loading…
Cancel
Save