diff --git a/infer/src/backend/CallGraph.ml b/infer/src/backend/CallGraph.ml index 2c3e01b52..fd89e8f61 100644 --- a/infer/src/backend/CallGraph.ml +++ b/infer/src/backend/CallGraph.ml @@ -70,7 +70,10 @@ let n_procs {node_map} = NodeMap.length node_map let node_of_procname g pname = id_of_procname g pname |> Option.bind ~f:(node_of_id g) -let remove (g : t) pname id = IdMap.remove g.id_map pname ; NodeMap.remove g.node_map id +let remove (g : t) pname = + IdMap.remove g.id_map pname ; + id_of_procname g pname |> Option.iter ~f:(NodeMap.remove g.node_map) + let get_or_set_id ({id_map} as graph) procname = match id_of_procname graph procname with @@ -106,18 +109,7 @@ let add_edge ({node_map} as graph) ~pname ~successor_pname = Node.add_successor node successor -let remove_reachable g start_pname = - let add_live_successors_and_remove_self init (n : Node.t) = - remove g n.pname n.id ; - List.fold n.successors ~init ~f:(fun init succ_id -> - node_of_id g succ_id |> Option.fold ~init ~f:(fun acc s -> s :: acc) ) - in - let rec remove_list frontier = - if not (List.is_empty frontier) then - remove_list (List.fold frontier ~init:[] ~f:add_live_successors_and_remove_self) - in - node_of_procname g start_pname |> Option.iter ~f:(fun start_node -> remove_list [start_node]) - +let flag g pname = node_of_procname g pname |> Option.iter ~f:Node.set_flag let flag_reachable g start_pname = let process_node init (n : Node.t) = diff --git a/infer/src/backend/CallGraph.mli b/infer/src/backend/CallGraph.mli index bcf5d1583..1715ace50 100644 --- a/infer/src/backend/CallGraph.mli +++ b/infer/src/backend/CallGraph.mli @@ -38,14 +38,15 @@ val n_procs : t -> int val mem : t -> int -> bool (** is an int [id] the index of a node in the graph? *) +val flag : t -> Typ.Procname.t -> unit + val flag_reachable : t -> Typ.Procname.t -> unit (** flag all nodes reachable from the node of the given procname, if it exists *) val get_unflagged_leaves : t -> Node.t list (** get all leaves that have their flag set to false *) -val remove_reachable : t -> Typ.Procname.t -> unit -(** remove all nodes reachable from procname *) +val remove : t -> Typ.Procname.t -> unit val to_dotty : t -> string -> unit (** output call graph in dotty format with the given filename in results dir *) diff --git a/infer/src/backend/SyntacticCallGraph.ml b/infer/src/backend/SyntacticCallGraph.ml index f97afb9e4..5c3182fed 100644 --- a/infer/src/backend/SyntacticCallGraph.ml +++ b/infer/src/backend/SyntacticCallGraph.ml @@ -71,7 +71,7 @@ let bottom_up sources : SchedulerTypes.target ProcessPool.TaskGenerator.t = let empty = !initialized && List.is_empty !pending && Typ.Procname.Set.is_empty !scheduled in if empty then ( remaining := 0 ; - L.progress "Finished call graph scheduling, %d procs remaining (in cycles).@." + L.progress "Finished call graph scheduling, %d procs remaining (in, or reaching, cycles).@." (CallGraph.n_procs syntactic_call_graph) ; if Config.debug_level_analysis > 0 then CallGraph.to_dotty syntactic_call_graph "cycles.dot" ; (* save some memory *) @@ -89,7 +89,7 @@ let bottom_up sources : SchedulerTypes.target ProcessPool.TaskGenerator.t = | n :: ns -> pending := ns ; scheduled := Typ.Procname.Set.add n.pname !scheduled ; - CallGraph.flag_reachable syntactic_call_graph n.pname ; + CallGraph.flag syntactic_call_graph n.pname ; Some (Procname n.pname) in let finished = function @@ -98,7 +98,7 @@ let bottom_up sources : SchedulerTypes.target ProcessPool.TaskGenerator.t = | Procname pname -> decr remaining ; scheduled := Typ.Procname.Set.remove pname !scheduled ; - CallGraph.remove_reachable syntactic_call_graph pname + CallGraph.remove syntactic_call_graph pname in let next () = (* do construction here, to avoid having the call graph into forked workers *)