diff --git a/infer/src/IR/Cfg.ml b/infer/src/IR/Cfg.ml index 2405085d7..69d39eff4 100644 --- a/infer/src/IR/Cfg.ml +++ b/infer/src/IR/Cfg.ml @@ -15,25 +15,24 @@ module F = Format (** data type for the control flow graph *) type t = Procdesc.t Typ.Procname.Hash.t -(** create a new empty cfg *) -let create_cfg () = Typ.Procname.Hash.create 16 +let create () = Typ.Procname.Hash.create 16 -let add_proc_desc cfg pname pdesc = Typ.Procname.Hash.add cfg pname pdesc - -let remove_proc_desc cfg pname = Typ.Procname.Hash.remove cfg pname - -let iter_proc_desc cfg f = Typ.Procname.Hash.iter f cfg +let get_all_proc_descs cfg = + let procs = ref [] in + let f _ pdesc = procs := pdesc :: !procs in + Typ.Procname.Hash.iter f cfg ; !procs -let fold_proc_desc cfg f init = Typ.Procname.Hash.fold f cfg init -let find_proc_desc_from_name cfg pname = - try Some (Typ.Procname.Hash.find cfg pname) with Not_found -> None +let get_all_proc_names cfg = + let procs = ref [] in + let f pname _ = procs := pname :: !procs in + Typ.Procname.Hash.iter f cfg ; !procs (** Create a new procdesc *) let create_proc_desc cfg (proc_attributes: ProcAttributes.t) = - let pdesc = Procdesc.from_proc_attributes ~called_from_cfg:true proc_attributes in - add_proc_desc cfg proc_attributes.proc_name pdesc ; + let pdesc = Procdesc.from_proc_attributes proc_attributes in + Typ.Procname.Hash.add cfg proc_attributes.proc_name pdesc ; pdesc @@ -42,7 +41,7 @@ let iter_all_nodes ?(sorted= false) f cfg = let do_proc_desc _ (pdesc: Procdesc.t) = List.iter ~f:(fun node -> f pdesc node) (Procdesc.get_nodes pdesc) in - if not sorted then iter_proc_desc cfg do_proc_desc + if not sorted then Typ.Procname.Hash.iter do_proc_desc cfg else Typ.Procname.Hash.fold (fun _ pdesc desc_nodes -> @@ -54,13 +53,6 @@ let iter_all_nodes ?(sorted= false) f cfg = |> List.iter ~f:(fun (d, n) -> f d n) -(** Get all the procdescs (defined and declared) *) -let get_all_procs cfg = - let procs = ref [] in - let f _ pdesc = procs := pdesc :: !procs in - iter_proc_desc cfg f ; !procs - - (** checks whether a cfg is connected or not *) let check_cfg_connectedness cfg = let is_exit_node n = @@ -88,7 +80,7 @@ let check_cfg_connectedness cfg = if not Config.keep_going && Typ.Procname.is_java pname && List.exists ~f:broken_node nodes then L.(die InternalError) "Broken CFG on %a" Typ.Procname.pp pname in - iter_proc_desc cfg do_pdesc + Typ.Procname.Hash.iter do_pdesc cfg let load_statement = @@ -118,7 +110,7 @@ let save_attributes source_file cfg = in Attributes.store attributes' in - iter_proc_desc cfg save_proc + Typ.Procname.Hash.iter save_proc cfg (** Inline a synthetic (access or bridge) method. *) @@ -180,15 +172,15 @@ let inline_synthetic_method ret_id etl pdesc loc_call : Sil.instr option = let proc_inline_synthetic_methods cfg pdesc : unit = let instr_inline_synthetic_method = function | Sil.Call (ret_id, Exp.Const Const.Cfun pn, etl, loc, _) -> ( - match find_proc_desc_from_name cfg pn with - | Some pd -> + match Typ.Procname.Hash.find cfg pn with + | pd -> let is_access = Typ.Procname.java_is_access_method pn in let attributes = Procdesc.get_attributes pd in let is_synthetic = attributes.is_synthetic_method in let is_bridge = attributes.is_bridge_method in if is_access || is_bridge || is_synthetic then inline_synthetic_method ret_id etl pd loc else None - | None -> + | exception Not_found -> None ) | _ -> None @@ -213,7 +205,7 @@ let proc_inline_synthetic_methods cfg pdesc : unit = (** Inline the java synthetic methods in the cfg *) let inline_java_synthetic_methods cfg = let f pname pdesc = if Typ.Procname.is_java pname then proc_inline_synthetic_methods cfg pdesc in - iter_proc_desc cfg f + Typ.Procname.Hash.iter f cfg (** compute the list of procedures added or changed in [cfg_new] over [cfg_old] *) @@ -298,340 +290,7 @@ let store source_file cfg = SqliteUtils.sqlite_unit_step ~finalize:false ~log:"Cfg.store" db store_stmt ) -(** Applies convert_instr_list to all the instructions in all the nodes of the cfg *) -let convert_cfg ~callee_pdesc ~resolved_pdesc convert_instr_list = - let resolved_pname = Procdesc.get_proc_name resolved_pdesc - and callee_start_node = Procdesc.get_start_node callee_pdesc - and callee_exit_node = Procdesc.get_exit_node callee_pdesc in - let convert_node_kind = function - | Procdesc.Node.Start_node _ -> - Procdesc.Node.Start_node resolved_pname - | Procdesc.Node.Exit_node _ -> - Procdesc.Node.Exit_node resolved_pname - | node_kind -> - node_kind - in - let node_map = ref Procdesc.NodeMap.empty in - let rec convert_node node = - let loc = Procdesc.Node.get_loc node - and kind = convert_node_kind (Procdesc.Node.get_kind node) - and instrs = convert_instr_list (Procdesc.Node.get_instrs node) in - Procdesc.create_node resolved_pdesc loc kind instrs - and loop callee_nodes = - match callee_nodes with - | [] -> - [] - | node :: other_node -> - let converted_node = - try Procdesc.NodeMap.find node !node_map with Not_found -> - let new_node = convert_node node - and successors = Procdesc.Node.get_succs node - and exn_nodes = Procdesc.Node.get_exn node in - node_map := Procdesc.NodeMap.add node new_node !node_map ; - if Procdesc.Node.equal node callee_start_node then - Procdesc.set_start_node resolved_pdesc new_node ; - if Procdesc.Node.equal node callee_exit_node then - Procdesc.set_exit_node resolved_pdesc new_node ; - Procdesc.node_set_succs_exn callee_pdesc new_node (loop successors) (loop exn_nodes) ; - new_node - in - converted_node :: loop other_node - in - ignore (loop [callee_start_node]) ; - resolved_pdesc - - -(** clone a procedure description and apply the type substitutions where - the parameters are used *) -let specialize_types_proc callee_pdesc resolved_pdesc substitutions = - let resolved_pname = Procdesc.get_proc_name resolved_pdesc in - let convert_pvar pvar = Pvar.mk (Pvar.get_name pvar) resolved_pname in - let mk_ptr_typ typename = - (* Only consider pointers from Java objects for now *) - Typ.mk (Tptr (Typ.mk (Tstruct typename), Typ.Pk_pointer)) - in - let convert_exp = function - | Exp.Lvar origin_pvar -> - Exp.Lvar (convert_pvar origin_pvar) - | exp -> - exp - in - let subst_map = ref Ident.IdentMap.empty in - let redirect_typename origin_id = - try Some (Ident.IdentMap.find origin_id !subst_map) with Not_found -> None - in - let convert_instr instrs = function - | Sil.Load - ( id - , (Exp.Lvar origin_pvar as origin_exp) - , {Typ.desc= Tptr ({desc= Tstruct origin_typename}, Pk_pointer)} - , loc ) -> - let specialized_typname = - try Mangled.Map.find (Pvar.get_name origin_pvar) substitutions with Not_found -> - origin_typename - in - subst_map := Ident.IdentMap.add id specialized_typname !subst_map ; - Sil.Load (id, convert_exp origin_exp, mk_ptr_typ specialized_typname, loc) :: instrs - | Sil.Load (id, (Exp.Var origin_id as origin_exp), ({Typ.desc= Tstruct _} as origin_typ), loc) -> - let updated_typ : Typ.t = - try Typ.mk ~default:origin_typ (Tstruct (Ident.IdentMap.find origin_id !subst_map)) - with Not_found -> origin_typ - in - Sil.Load (id, convert_exp origin_exp, updated_typ, loc) :: instrs - | Sil.Load (id, origin_exp, origin_typ, loc) -> - Sil.Load (id, convert_exp origin_exp, origin_typ, loc) :: instrs - | Sil.Store (assignee_exp, origin_typ, origin_exp, loc) -> - let set_instr = - Sil.Store (convert_exp assignee_exp, origin_typ, convert_exp origin_exp, loc) - in - set_instr :: instrs - | Sil.Call - ( return_ids - , Exp.Const Const.Cfun Typ.Procname.Java callee_pname_java - , (Exp.Var id, _) :: origin_args - , loc - , call_flags ) - when call_flags.CallFlags.cf_virtual && redirect_typename id <> None -> - let redirected_typename = Option.value_exn (redirect_typename id) in - let redirected_typ = mk_ptr_typ redirected_typename in - let redirected_pname = - Typ.Procname.replace_class (Typ.Procname.Java callee_pname_java) redirected_typename - in - let args = - let other_args = List.map ~f:(fun (exp, typ) -> (convert_exp exp, typ)) origin_args in - (Exp.Var id, redirected_typ) :: other_args - in - let call_instr = - Sil.Call (return_ids, Exp.Const (Const.Cfun redirected_pname), args, loc, call_flags) - in - call_instr :: instrs - | Sil.Call (return_ids, origin_call_exp, origin_args, loc, call_flags) -> - let converted_args = List.map ~f:(fun (exp, typ) -> (convert_exp exp, typ)) origin_args in - let call_instr = - Sil.Call (return_ids, convert_exp origin_call_exp, converted_args, loc, call_flags) - in - call_instr :: instrs - | Sil.Prune (origin_exp, loc, is_true_branch, if_kind) -> - Sil.Prune (convert_exp origin_exp, loc, is_true_branch, if_kind) :: instrs - | Sil.Declare_locals (typed_vars, loc) -> - let new_typed_vars = - List.map ~f:(fun (pvar, typ) -> (convert_pvar pvar, typ)) typed_vars - in - Sil.Declare_locals (new_typed_vars, loc) :: instrs - | Sil.Nullify _ | Abstract _ | Sil.Remove_temps _ -> - (* these are generated instructions that will be replaced by the preanalysis *) - instrs - in - let convert_instr_list instrs = List.fold ~f:convert_instr ~init:[] instrs |> List.rev in - convert_cfg ~callee_pdesc ~resolved_pdesc convert_instr_list - - -(** Creates a copy of a procedure description and a list of type substitutions of the form - (name, typ) where name is a parameter. The resulting proc desc is isomorphic but - all the type of the parameters are replaced in the instructions according to the list. - The virtual calls are also replaced to match the parameter types *) -let specialize_types callee_pdesc resolved_pname args = - let callee_attributes = Procdesc.get_attributes callee_pdesc in - let resolved_params, substitutions = - List.fold2_exn - ~f:(fun (params, subts) (param_name, param_typ) (_, arg_typ) -> - match arg_typ.Typ.desc with - | Tptr ({desc= Tstruct typename}, Pk_pointer) -> - (* Replace the type of the parameter by the type of the argument *) - ((param_name, arg_typ) :: params, Mangled.Map.add param_name typename subts) - | _ -> - ((param_name, param_typ) :: params, subts) ) - ~init:([], Mangled.Map.empty) callee_attributes.formals args - in - let resolved_attributes = - { callee_attributes with - formals= List.rev resolved_params - ; proc_name= resolved_pname - ; is_specialized= true - ; err_log= Errlog.empty () } - in - Attributes.store resolved_attributes ; - let resolved_pdesc = - let tmp_cfg = create_cfg () in - create_proc_desc tmp_cfg resolved_attributes - in - specialize_types_proc callee_pdesc resolved_pdesc substitutions - - -let specialize_with_block_args_instrs resolved_pdesc substitutions = - let resolved_pname = Procdesc.get_proc_name resolved_pdesc in - let convert_pvar pvar = Pvar.mk (Pvar.get_name pvar) resolved_pname in - let convert_exp exp = - match exp with - | Exp.Lvar origin_pvar -> - let new_pvar = convert_pvar origin_pvar in - Exp.Lvar new_pvar - | _ -> - exp - in - let convert_instr (instrs, id_map) instr = - let convert_generic_call return_ids exp origin_args loc call_flags = - let converted_args = List.map ~f:(fun (exp, typ) -> (convert_exp exp, typ)) origin_args in - let call_instr = Sil.Call (return_ids, exp, converted_args, loc, call_flags) in - (call_instr :: instrs, id_map) - in - match instr with - | Sil.Load (id, Exp.Lvar block_param, _, _) - when Mangled.Map.mem (Pvar.get_name block_param) substitutions -> - let id_map = Ident.IdentMap.add id (Pvar.get_name block_param) id_map in - (* we don't need the load the block param instruction anymore *) - (instrs, id_map) - | Sil.Load (id, origin_exp, origin_typ, loc) -> - (Sil.Load (id, convert_exp origin_exp, origin_typ, loc) :: instrs, id_map) - | Sil.Store (assignee_exp, origin_typ, origin_exp, loc) -> - let set_instr = - Sil.Store (convert_exp assignee_exp, origin_typ, convert_exp origin_exp, loc) - in - (set_instr :: instrs, id_map) - | Sil.Call (return_ids, Exp.Var id, origin_args, loc, call_flags) -> ( - try - let block_name, extra_formals = - let block_var = Ident.IdentMap.find id id_map in - Mangled.Map.find block_var substitutions - in - (* once we find the block in the map, it means that we need to subsitute it with the - call to the concrete block, and pass the fresh formals as arguments *) - let ids_typs, load_instrs = - let captured_ids_instrs = - List.map extra_formals ~f:(fun (var, typ) -> - let id = Ident.create_fresh Ident.knormal in - let pvar = Pvar.mk var resolved_pname in - ((id, typ), Sil.Load (id, Exp.Lvar pvar, typ, loc)) ) - in - List.unzip captured_ids_instrs - in - let call_instr = - let id_exps = List.map ~f:(fun (id, typ) -> (Exp.Var id, typ)) ids_typs in - let converted_args = - List.map ~f:(fun (exp, typ) -> (convert_exp exp, typ)) origin_args - in - Sil.Call - ( return_ids - , Exp.Const (Const.Cfun block_name) - , id_exps @ converted_args - , loc - , call_flags ) - in - let remove_temps_instrs = - let ids = List.map ~f:(fun (id, _) -> id) ids_typs in - Sil.Remove_temps (ids, loc) - in - let instrs = remove_temps_instrs :: call_instr :: load_instrs @ instrs in - (instrs, id_map) - with Not_found -> convert_generic_call return_ids (Exp.Var id) origin_args loc call_flags ) - | Sil.Call (return_ids, origin_call_exp, origin_args, loc, call_flags) -> - convert_generic_call return_ids origin_call_exp origin_args loc call_flags - | Sil.Prune (origin_exp, loc, is_true_branch, if_kind) -> - (Sil.Prune (convert_exp origin_exp, loc, is_true_branch, if_kind) :: instrs, id_map) - | Sil.Declare_locals (typed_vars, loc) -> - let new_typed_vars = - List.map ~f:(fun (pvar, typ) -> (convert_pvar pvar, typ)) typed_vars - in - (Sil.Declare_locals (new_typed_vars, loc) :: instrs, id_map) - | Sil.Nullify _ | Abstract _ | Sil.Remove_temps _ -> - (* these are generated instructions that will be replaced by the preanalysis *) - (instrs, id_map) - in - let convert_instr_list instrs = - let instrs, _ = List.fold ~f:convert_instr ~init:([], Ident.IdentMap.empty) instrs in - List.rev instrs - in - convert_instr_list - - -let specialize_with_block_args callee_pdesc pname_with_block_args block_args = - let callee_attributes = Procdesc.get_attributes callee_pdesc in - (* Substitution from a block parameter to the block name and the new formals - that correspond to the captured variables *) - let substitutions : (Typ.Procname.t * (Mangled.t * Typ.t) list) Mangled.Map.t = - List.fold2_exn callee_attributes.formals block_args ~init:Mangled.Map.empty ~f: - (fun subts (param_name, _) block_arg_opt -> - match block_arg_opt with - | Some (cl: Exp.closure) -> - let formals_from_captured = - List.map - ~f:(fun (_, var, typ) -> - (* Here we create fresh names for the new formals, based on the names of the captured - variables annotated with the name of the caller method *) - (Pvar.get_name_of_local_with_procname var, typ) ) - cl.captured_vars - in - Mangled.Map.add param_name (cl.name, formals_from_captured) subts - | None -> - subts ) - in - (* Extend formals with fresh variables for the captured variables of the block arguments, - without duplications. *) - let new_formals_blocks_captured_vars, extended_formals_annots = - let new_formals_blocks_captured_vars_with_annots = - let formals_annots = - List.zip_exn callee_attributes.formals (snd callee_attributes.method_annotation) - in - let append_no_duplicates_formals_and_annot list1 list2 = - IList.append_no_duplicates - (fun ((name1, _), _) ((name2, _), _) -> Mangled.equal name1 name2) - list1 list2 - in - List.fold formals_annots ~init:[] ~f:(fun acc ((param_name, typ), annot) -> - try - let _, captured = Mangled.Map.find param_name substitutions in - append_no_duplicates_formals_and_annot acc - (List.map captured ~f:(fun captured_var -> (captured_var, Annot.Item.empty))) - with Not_found -> append_no_duplicates_formals_and_annot acc [((param_name, typ), annot)] - ) - in - List.unzip new_formals_blocks_captured_vars_with_annots - in - let source_file_captured = - let pname = Procdesc.get_proc_name callee_pdesc in - match Attributes.find_file_capturing_procedure pname with - | Some (source_file, _) -> - source_file - | None -> - Logging.die InternalError - "specialize_with_block_args ahould only be called with defined procedures, but we cannot find the captured file of procname %a" - Typ.Procname.pp pname - in - let resolved_attributes = - { callee_attributes with - proc_name= pname_with_block_args - ; is_defined= true - ; err_log= Errlog.empty () - ; formals= new_formals_blocks_captured_vars - ; method_annotation= (fst callee_attributes.method_annotation, extended_formals_annots) - ; source_file_captured } - in - Attributes.store resolved_attributes ; - let resolved_pdesc = - let tmp_cfg = create_cfg () in - create_proc_desc tmp_cfg resolved_attributes - in - Logging.(debug Analysis Verbose) - "signature of base method %a@." Procdesc.pp_signature callee_pdesc ; - Logging.(debug Analysis Verbose) - "signature of specialized method %a@." Procdesc.pp_signature resolved_pdesc ; - convert_cfg ~callee_pdesc ~resolved_pdesc - (specialize_with_block_args_instrs resolved_pdesc substitutions) - - let pp_proc_signatures fmt cfg = F.fprintf fmt "METHOD SIGNATURES@\n@." ; - let sorted_procs = List.sort ~cmp:Procdesc.compare (get_all_procs cfg) in + let sorted_procs = List.sort ~cmp:Procdesc.compare (get_all_proc_descs cfg) in List.iter ~f:(fun pdesc -> F.fprintf fmt "%a@." Procdesc.pp_signature pdesc) sorted_procs - - -let exists_for_source_file source = - (* simplistic implementation that allocates the cfg as this is only used for reactive capture for now *) - load source |> Option.is_some - - -let get_captured_source_files () = - let db = ResultsDatabase.get_database () in - Sqlite3.prepare db "SELECT source_file FROM source_files" - |> SqliteUtils.sqlite_result_rev_list_step db ~log:"getting all source files" - |> List.filter_map ~f:(Option.map ~f:SourceFile.SQLite.deserialize) diff --git a/infer/src/IR/Cfg.mli b/infer/src/IR/Cfg.mli index 7c315c1c4..46ce7ab42 100644 --- a/infer/src/IR/Cfg.mli +++ b/infer/src/IR/Cfg.mli @@ -12,8 +12,8 @@ open! IStd (** Control Flow Graph for Interprocedural Analysis *) -(** A control-flow graph *) -type t +(** A control-flow graph is a collection of all the CFGs for the procedure names in a file *) +type t = Procdesc.t Typ.Procname.Hash.t val load : SourceFile.t -> t option (** Load the cfgs of the procedures of a source file *) @@ -21,19 +21,19 @@ val load : SourceFile.t -> t option val store : SourceFile.t -> t -> unit (** Save a cfg into the database *) +val get_all_proc_descs : t -> Procdesc.t list +(** get all the values from the hashtable *) + +val get_all_proc_names : t -> Typ.Procname.t list +(** get all the keys from the hashtable *) + (** {2 Functions for manipulating an interprocedural CFG} *) -val create_cfg : unit -> t +val create : unit -> t (** create a new empty cfg *) val create_proc_desc : t -> ProcAttributes.t -> Procdesc.t -(** Create a new procdesc *) - -val fold_proc_desc : t -> (Typ.Procname.t -> Procdesc.t -> 'a -> 'a) -> 'a -> 'a -(** Fold over all the procdesc's *) - -val find_proc_desc_from_name : t -> Typ.Procname.t -> Procdesc.t option -(** Find the procdesc given the proc name. Return None if not found. *) +(** Create a new procdesc and add it to the cfg *) val iter_all_nodes : ?sorted:bool -> (Procdesc.t -> Procdesc.Node.t -> unit) -> t -> unit (** Iterate over all the nodes in the cfg *) @@ -41,25 +41,4 @@ val iter_all_nodes : ?sorted:bool -> (Procdesc.t -> Procdesc.Node.t -> unit) -> val check_cfg_connectedness : t -> unit (** checks whether a cfg is connected or not *) -val remove_proc_desc : t -> Typ.Procname.t -> unit -(** Remove the procdesc from the control flow graph. *) - -val specialize_types : Procdesc.t -> Typ.Procname.t -> (Exp.t * Typ.t) list -> Procdesc.t -(** Creates a copy of a procedure description and a list of type substitutions of the form - (name, typ) where name is a parameter. The resulting procdesc is isomorphic but - all the type of the parameters are replaced in the instructions according to the list. - The virtual calls are also replaced to match the parameter types *) - -val specialize_with_block_args : - Procdesc.t -> Typ.Procname.t -> Exp.closure option list -> Procdesc.t -(** Creates a copy of a procedure description given a list of possible closures - that are passed as arguments to the method. The resulting procdesc is isomorphic but - a) the block parameters are replaces with the closures - b) the parameters of the method are extended with parameters for the captured variables - in the closures *) - val pp_proc_signatures : Format.formatter -> t -> unit - -val exists_for_source_file : SourceFile.t -> bool - -val get_captured_source_files : unit -> SourceFile.t list diff --git a/infer/src/IR/Procdesc.ml b/infer/src/IR/Procdesc.ml index 6ac3b9ca7..2df9d506f 100644 --- a/infer/src/IR/Procdesc.ml +++ b/infer/src/IR/Procdesc.ml @@ -223,9 +223,7 @@ type t = ; mutable loop_heads: NodeSet.t option (** loop head nodes of this procedure *) } [@@deriving compare] -(** Only call from Cfg *) -let from_proc_attributes ~called_from_cfg attributes = - if not called_from_cfg then assert false ; +let from_proc_attributes attributes = let pname_opt = Some attributes.ProcAttributes.proc_name in let start_node = Node.dummy pname_opt in let exit_node = Node.dummy pname_opt in @@ -489,3 +487,315 @@ let has_modify_in_block_attr procdesc pvar = ProcAttributes.var_attribute_equal attr ProcAttributes.Modify_in_block ) in List.exists ~f:pvar_local_matches (get_locals procdesc) + + +(** Applies f_instr_list to all the instructions in all the nodes of the cfg *) +let convert_cfg ~callee_pdesc ~resolved_pdesc ~f_instr_list = + let resolved_pname = get_proc_name resolved_pdesc + and callee_start_node = get_start_node callee_pdesc + and callee_exit_node = get_exit_node callee_pdesc in + let convert_node_kind = function + | Node.Start_node _ -> + Node.Start_node resolved_pname + | Node.Exit_node _ -> + Node.Exit_node resolved_pname + | node_kind -> + node_kind + in + let node_map = ref NodeMap.empty in + let rec convert_node node = + let loc = Node.get_loc node + and kind = convert_node_kind (Node.get_kind node) + and instrs = f_instr_list (Node.get_instrs node) in + create_node resolved_pdesc loc kind instrs + and loop callee_nodes = + match callee_nodes with + | [] -> + [] + | node :: other_node -> + let converted_node = + try NodeMap.find node !node_map with Not_found -> + let new_node = convert_node node + and successors = Node.get_succs node + and exn_nodes = Node.get_exn node in + node_map := NodeMap.add node new_node !node_map ; + if Node.equal node callee_start_node then set_start_node resolved_pdesc new_node ; + if Node.equal node callee_exit_node then set_exit_node resolved_pdesc new_node ; + node_set_succs_exn callee_pdesc new_node (loop successors) (loop exn_nodes) ; + new_node + in + converted_node :: loop other_node + in + ignore (loop [callee_start_node]) ; + resolved_pdesc + + +(** clone a procedure description and apply the type substitutions where + the parameters are used *) +let specialize_types_proc callee_pdesc resolved_pdesc substitutions = + let resolved_pname = get_proc_name resolved_pdesc in + let convert_pvar pvar = Pvar.mk (Pvar.get_name pvar) resolved_pname in + let mk_ptr_typ typename = + (* Only consider pointers from Java objects for now *) + Typ.mk (Tptr (Typ.mk (Tstruct typename), Typ.Pk_pointer)) + in + let convert_exp = function + | Exp.Lvar origin_pvar -> + Exp.Lvar (convert_pvar origin_pvar) + | exp -> + exp + in + let subst_map = ref Ident.IdentMap.empty in + let redirect_typename origin_id = + try Some (Ident.IdentMap.find origin_id !subst_map) with Not_found -> None + in + let convert_instr instrs = function + | Sil.Load + ( id + , (Exp.Lvar origin_pvar as origin_exp) + , {Typ.desc= Tptr ({desc= Tstruct origin_typename}, Pk_pointer)} + , loc ) -> + let specialized_typname = + try Mangled.Map.find (Pvar.get_name origin_pvar) substitutions with Not_found -> + origin_typename + in + subst_map := Ident.IdentMap.add id specialized_typname !subst_map ; + Sil.Load (id, convert_exp origin_exp, mk_ptr_typ specialized_typname, loc) :: instrs + | Sil.Load (id, (Exp.Var origin_id as origin_exp), ({Typ.desc= Tstruct _} as origin_typ), loc) -> + let updated_typ : Typ.t = + try Typ.mk ~default:origin_typ (Tstruct (Ident.IdentMap.find origin_id !subst_map)) + with Not_found -> origin_typ + in + Sil.Load (id, convert_exp origin_exp, updated_typ, loc) :: instrs + | Sil.Load (id, origin_exp, origin_typ, loc) -> + Sil.Load (id, convert_exp origin_exp, origin_typ, loc) :: instrs + | Sil.Store (assignee_exp, origin_typ, origin_exp, loc) -> + let set_instr = + Sil.Store (convert_exp assignee_exp, origin_typ, convert_exp origin_exp, loc) + in + set_instr :: instrs + | Sil.Call + ( return_ids + , Exp.Const Const.Cfun Typ.Procname.Java callee_pname_java + , (Exp.Var id, _) :: origin_args + , loc + , call_flags ) + when call_flags.CallFlags.cf_virtual && redirect_typename id <> None -> + let redirected_typename = Option.value_exn (redirect_typename id) in + let redirected_typ = mk_ptr_typ redirected_typename in + let redirected_pname = + Typ.Procname.replace_class (Typ.Procname.Java callee_pname_java) redirected_typename + in + let args = + let other_args = List.map ~f:(fun (exp, typ) -> (convert_exp exp, typ)) origin_args in + (Exp.Var id, redirected_typ) :: other_args + in + let call_instr = + Sil.Call (return_ids, Exp.Const (Const.Cfun redirected_pname), args, loc, call_flags) + in + call_instr :: instrs + | Sil.Call (return_ids, origin_call_exp, origin_args, loc, call_flags) -> + let converted_args = List.map ~f:(fun (exp, typ) -> (convert_exp exp, typ)) origin_args in + let call_instr = + Sil.Call (return_ids, convert_exp origin_call_exp, converted_args, loc, call_flags) + in + call_instr :: instrs + | Sil.Prune (origin_exp, loc, is_true_branch, if_kind) -> + Sil.Prune (convert_exp origin_exp, loc, is_true_branch, if_kind) :: instrs + | Sil.Declare_locals (typed_vars, loc) -> + let new_typed_vars = + List.map ~f:(fun (pvar, typ) -> (convert_pvar pvar, typ)) typed_vars + in + Sil.Declare_locals (new_typed_vars, loc) :: instrs + | Sil.Nullify _ | Abstract _ | Sil.Remove_temps _ -> + (* these are generated instructions that will be replaced by the preanalysis *) + instrs + in + let f_instr_list instrs = List.fold ~f:convert_instr ~init:[] instrs |> List.rev in + convert_cfg ~callee_pdesc ~resolved_pdesc ~f_instr_list + + +(** Creates a copy of a procedure description and a list of type substitutions of the form + (name, typ) where name is a parameter. The resulting proc desc is isomorphic but + all the type of the parameters are replaced in the instructions according to the list. + The virtual calls are also replaced to match the parameter types *) +let specialize_types callee_pdesc resolved_pname args = + let callee_attributes = get_attributes callee_pdesc in + let resolved_params, substitutions = + List.fold2_exn + ~f:(fun (params, subts) (param_name, param_typ) (_, arg_typ) -> + match arg_typ.Typ.desc with + | Tptr ({desc= Tstruct typename}, Pk_pointer) -> + (* Replace the type of the parameter by the type of the argument *) + ((param_name, arg_typ) :: params, Mangled.Map.add param_name typename subts) + | _ -> + ((param_name, param_typ) :: params, subts) ) + ~init:([], Mangled.Map.empty) callee_attributes.formals args + in + let resolved_attributes = + { callee_attributes with + formals= List.rev resolved_params + ; proc_name= resolved_pname + ; is_specialized= true + ; err_log= Errlog.empty () } + in + Attributes.store resolved_attributes ; + let resolved_pdesc = from_proc_attributes resolved_attributes in + specialize_types_proc callee_pdesc resolved_pdesc substitutions + + +let specialize_with_block_args_instrs resolved_pdesc substitutions = + let resolved_pname = get_proc_name resolved_pdesc in + let convert_pvar pvar = Pvar.mk (Pvar.get_name pvar) resolved_pname in + let convert_exp exp = + match exp with + | Exp.Lvar origin_pvar -> + let new_pvar = convert_pvar origin_pvar in + Exp.Lvar new_pvar + | _ -> + exp + in + let convert_instr (instrs, id_map) instr = + let convert_generic_call return_ids exp origin_args loc call_flags = + let converted_args = List.map ~f:(fun (exp, typ) -> (convert_exp exp, typ)) origin_args in + let call_instr = Sil.Call (return_ids, exp, converted_args, loc, call_flags) in + (call_instr :: instrs, id_map) + in + match instr with + | Sil.Load (id, Exp.Lvar block_param, _, _) + when Mangled.Map.mem (Pvar.get_name block_param) substitutions -> + let id_map = Ident.IdentMap.add id (Pvar.get_name block_param) id_map in + (* we don't need the load the block param instruction anymore *) + (instrs, id_map) + | Sil.Load (id, origin_exp, origin_typ, loc) -> + (Sil.Load (id, convert_exp origin_exp, origin_typ, loc) :: instrs, id_map) + | Sil.Store (assignee_exp, origin_typ, origin_exp, loc) -> + let set_instr = + Sil.Store (convert_exp assignee_exp, origin_typ, convert_exp origin_exp, loc) + in + (set_instr :: instrs, id_map) + | Sil.Call (return_ids, Exp.Var id, origin_args, loc, call_flags) -> ( + try + let block_name, extra_formals = + let block_var = Ident.IdentMap.find id id_map in + Mangled.Map.find block_var substitutions + in + (* once we find the block in the map, it means that we need to subsitute it with the + call to the concrete block, and pass the fresh formals as arguments *) + let ids_typs, load_instrs = + let captured_ids_instrs = + List.map extra_formals ~f:(fun (var, typ) -> + let id = Ident.create_fresh Ident.knormal in + let pvar = Pvar.mk var resolved_pname in + ((id, typ), Sil.Load (id, Exp.Lvar pvar, typ, loc)) ) + in + List.unzip captured_ids_instrs + in + let call_instr = + let id_exps = List.map ~f:(fun (id, typ) -> (Exp.Var id, typ)) ids_typs in + let converted_args = + List.map ~f:(fun (exp, typ) -> (convert_exp exp, typ)) origin_args + in + Sil.Call + ( return_ids + , Exp.Const (Const.Cfun block_name) + , id_exps @ converted_args + , loc + , call_flags ) + in + let remove_temps_instrs = + let ids = List.map ~f:(fun (id, _) -> id) ids_typs in + Sil.Remove_temps (ids, loc) + in + let instrs = remove_temps_instrs :: call_instr :: load_instrs @ instrs in + (instrs, id_map) + with Not_found -> convert_generic_call return_ids (Exp.Var id) origin_args loc call_flags ) + | Sil.Call (return_ids, origin_call_exp, origin_args, loc, call_flags) -> + convert_generic_call return_ids origin_call_exp origin_args loc call_flags + | Sil.Prune (origin_exp, loc, is_true_branch, if_kind) -> + (Sil.Prune (convert_exp origin_exp, loc, is_true_branch, if_kind) :: instrs, id_map) + | Sil.Declare_locals (typed_vars, loc) -> + let new_typed_vars = + List.map ~f:(fun (pvar, typ) -> (convert_pvar pvar, typ)) typed_vars + in + (Sil.Declare_locals (new_typed_vars, loc) :: instrs, id_map) + | Sil.Nullify _ | Abstract _ | Sil.Remove_temps _ -> + (* these are generated instructions that will be replaced by the preanalysis *) + (instrs, id_map) + in + let f_instr_list instrs = + let instrs, _ = List.fold ~f:convert_instr ~init:([], Ident.IdentMap.empty) instrs in + List.rev instrs + in + f_instr_list + + +let specialize_with_block_args callee_pdesc pname_with_block_args block_args = + let callee_attributes = get_attributes callee_pdesc in + (* Substitution from a block parameter to the block name and the new formals + that correspond to the captured variables *) + let substitutions : (Typ.Procname.t * (Mangled.t * Typ.t) list) Mangled.Map.t = + List.fold2_exn callee_attributes.formals block_args ~init:Mangled.Map.empty ~f: + (fun subts (param_name, _) block_arg_opt -> + match block_arg_opt with + | Some (cl: Exp.closure) -> + let formals_from_captured = + List.map + ~f:(fun (_, var, typ) -> + (* Here we create fresh names for the new formals, based on the names of the captured + variables annotated with the name of the caller method *) + (Pvar.get_name_of_local_with_procname var, typ) ) + cl.captured_vars + in + Mangled.Map.add param_name (cl.name, formals_from_captured) subts + | None -> + subts ) + in + (* Extend formals with fresh variables for the captured variables of the block arguments, + without duplications. *) + let new_formals_blocks_captured_vars, extended_formals_annots = + let new_formals_blocks_captured_vars_with_annots = + let formals_annots = + List.zip_exn callee_attributes.formals (snd callee_attributes.method_annotation) + in + let append_no_duplicates_formals_and_annot list1 list2 = + IList.append_no_duplicates + (fun ((name1, _), _) ((name2, _), _) -> Mangled.equal name1 name2) + list1 list2 + in + List.fold formals_annots ~init:[] ~f:(fun acc ((param_name, typ), annot) -> + try + let _, captured = Mangled.Map.find param_name substitutions in + append_no_duplicates_formals_and_annot acc + (List.map captured ~f:(fun captured_var -> (captured_var, Annot.Item.empty))) + with Not_found -> append_no_duplicates_formals_and_annot acc [((param_name, typ), annot)] + ) + in + List.unzip new_formals_blocks_captured_vars_with_annots + in + let source_file_captured = + let pname = get_proc_name callee_pdesc in + match Attributes.find_file_capturing_procedure pname with + | Some (source_file, _) -> + source_file + | None -> + Logging.die InternalError + "specialize_with_block_args ahould only be called with defined procedures, but we cannot find the captured file of procname %a" + Typ.Procname.pp pname + in + let resolved_attributes = + { callee_attributes with + proc_name= pname_with_block_args + ; is_defined= true + ; err_log= Errlog.empty () + ; formals= new_formals_blocks_captured_vars + ; method_annotation= (fst callee_attributes.method_annotation, extended_formals_annots) + ; source_file_captured } + in + Attributes.store resolved_attributes ; + let resolved_pdesc = from_proc_attributes resolved_attributes in + Logging.(debug Analysis Verbose) "signature of base method %a@." pp_signature callee_pdesc ; + Logging.(debug Analysis Verbose) + "signature of specialized method %a@." pp_signature resolved_pdesc ; + convert_cfg ~callee_pdesc ~resolved_pdesc + ~f_instr_list:(specialize_with_block_args_instrs resolved_pdesc substitutions) diff --git a/infer/src/IR/Procdesc.mli b/infer/src/IR/Procdesc.mli index e77a15c62..6334195c9 100644 --- a/infer/src/IR/Procdesc.mli +++ b/infer/src/IR/Procdesc.mli @@ -142,8 +142,8 @@ val fold_instrs : ('a -> Node.t -> Sil.instr -> 'a) -> 'a -> t -> 'a val fold_nodes : ('a -> Node.t -> 'a) -> 'a -> t -> 'a (** fold over all nodes *) -val from_proc_attributes : called_from_cfg:bool -> ProcAttributes.t -> t -(** Only call from Cfg. *) +val from_proc_attributes : ProcAttributes.t -> t +(** Use [Cfg.create_proc_desc] if you are adding a proc desc to a cfg *) val get_access : t -> PredSymb.access (** Return the visibility attribute *) @@ -215,3 +215,16 @@ val is_specialized : t -> bool val is_captured_var : t -> Pvar.t -> bool val has_modify_in_block_attr : t -> Pvar.t -> bool + +val specialize_types : t -> Typ.Procname.t -> (Exp.t * Typ.t) list -> t +(** Creates a copy of a procedure description and a list of type substitutions of the form + (name, typ) where name is a parameter. The resulting procdesc is isomorphic but + all the type of the parameters are replaced in the instructions according to the list. + The virtual calls are also replaced to match the parameter types *) + +val specialize_with_block_args : t -> Typ.Procname.t -> Exp.closure option list -> t +(** Creates a copy of a procedure description given a list of possible closures + that are passed as arguments to the method. The resulting procdesc is isomorphic but + a) the block parameters are replaces with the closures + b) the parameters of the method are extended with parameters for the captured variables + in the closures *) diff --git a/infer/src/backend/InferAnalyze.ml b/infer/src/backend/InferAnalyze.ml index 564d9f595..733478a22 100644 --- a/infer/src/backend/InferAnalyze.ml +++ b/infer/src/backend/InferAnalyze.ml @@ -119,7 +119,7 @@ let main ~changed_files ~makefile = (* delete all specs when doing a full analysis so that we do not report on procedures that do not exist anymore *) if not Config.reactive_mode then DB.Results_dir.clean_specs_dir () ; - let all_clusters = Cfg.get_captured_source_files () in + let all_clusters = SourceFiles.get_all () in let clusters_to_analyze = List.filter ~f:(cluster_should_be_analyzed ~changed_files) all_clusters in diff --git a/infer/src/backend/OndemandCapture.ml b/infer/src/backend/OndemandCapture.ml index c14ea4ab2..5a9e20ad3 100644 --- a/infer/src/backend/OndemandCapture.ml +++ b/infer/src/backend/OndemandCapture.ml @@ -24,7 +24,7 @@ let try_capture (attributes: ProcAttributes.t) : ProcAttributes.t option = was, there is no point in trying to capture it again. Treat existance of the cfg as a barrier - if it exists it means that all attributes files have been created - write logic is defined in Cfg.store *) - if not (Cfg.exists_for_source_file decl_file) then ( + if not (SourceFiles.is_captured decl_file) then ( L.(debug Capture Verbose) "Started capture of %a...@\n" SourceFile.pp definition_file ; Timeout.suspend_existing_timeout ~keep_symop_total:true ; protect diff --git a/infer/src/backend/SymExecBlocks.ml b/infer/src/backend/SymExecBlocks.ml index 52b025d01..cb566320e 100644 --- a/infer/src/backend/SymExecBlocks.ml +++ b/infer/src/backend/SymExecBlocks.ml @@ -81,7 +81,7 @@ let resolve_method_with_block_args_and_analyze caller_pdesc pname act_params = (* new procdesc cloned from the original one, where the block parameters have been replaced by the block arguments. The formals have also been expanded with the captured variables *) let specialized_pdesc = - Cfg.specialize_with_block_args pdesc pname_with_block_args block_args + Procdesc.specialize_with_block_args pdesc pname_with_block_args block_args in Logging.(debug Analysis Verbose) "Instructions of specialized method:@." ; Procdesc.iter_instrs diff --git a/infer/src/backend/callbacks.ml b/infer/src/backend/callbacks.ml index 86575ac29..74a149e97 100644 --- a/infer/src/backend/callbacks.ml +++ b/infer/src/backend/callbacks.ml @@ -55,7 +55,7 @@ let iterate_procedure_callbacks get_proc_desc exe_env summary proc_desc = let get_procs_in_file proc_name = match Exe_env.get_cfg exe_env proc_name with | Some cfg -> - Cfg.fold_proc_desc cfg (fun pname _ accu -> pname :: accu) [] + Cfg.get_all_proc_names cfg | None -> [] in diff --git a/infer/src/backend/exe_env.ml b/infer/src/backend/exe_env.ml index 9349710ce..1cdc8a8d9 100644 --- a/infer/src/backend/exe_env.ml +++ b/infer/src/backend/exe_env.ml @@ -175,8 +175,12 @@ let get_cfg exe_env pname = (** return the proc desc associated to the procedure *) let get_proc_desc exe_env pname = match get_cfg exe_env pname with - | Some cfg -> - Cfg.find_proc_desc_from_name cfg pname + | Some cfg -> ( + match Typ.Procname.Hash.find cfg pname with + | proc_desc -> + Some proc_desc + | exception Not_found -> + None ) | None -> None diff --git a/infer/src/backend/printer.ml b/infer/src/backend/printer.ml index 098ebc778..88e8f6d59 100644 --- a/infer/src/backend/printer.ml +++ b/infer/src/backend/printer.ml @@ -547,7 +547,7 @@ let write_all_html_files cluster = Exe_env.iter_files (fun _ cfg -> let source_files_in_cfg, pdescs_in_cfg = - Cfg.fold_proc_desc cfg + Typ.Procname.Hash.fold (fun _ proc_desc (files, pdescs) -> let updated_files = if Procdesc.is_defined proc_desc then @@ -556,7 +556,7 @@ let write_all_html_files cluster = else files in (updated_files, proc_desc :: pdescs) ) - (SourceFile.Set.empty, []) + cfg (SourceFile.Set.empty, []) in SourceFile.Set.iter (fun file -> write_html_file linereader file pdescs_in_cfg) diff --git a/infer/src/backend/specs.ml b/infer/src/backend/specs.ml index c35e59c23..efd351a6f 100644 --- a/infer/src/backend/specs.ml +++ b/infer/src/backend/specs.ml @@ -736,7 +736,7 @@ let init_summary proc_desc = let dummy = let dummy_attributes = ProcAttributes.default Typ.Procname.empty_block in - let dummy_proc_desc = Procdesc.from_proc_attributes ~called_from_cfg:true dummy_attributes in + let dummy_proc_desc = Procdesc.from_proc_attributes dummy_attributes in init_summary dummy_proc_desc diff --git a/infer/src/backend/symExec.ml b/infer/src/backend/symExec.ml index 770e699db..03c9512d9 100644 --- a/infer/src/backend/symExec.ml +++ b/infer/src/backend/symExec.ml @@ -700,7 +700,8 @@ let resolve_and_analyze tenv caller_pdesc prop args callee_proc_name call_flags Some resolved_proc_desc | None -> Option.map - ~f:(fun callee_proc_desc -> Cfg.specialize_types callee_proc_desc resolved_pname args) + ~f:(fun callee_proc_desc -> + Procdesc.specialize_types callee_proc_desc resolved_pname args ) (Ondemand.get_proc_desc callee_proc_name) in Option.bind resolved_proc_desc_option ~f:analyze diff --git a/infer/src/base/SourceFiles.ml b/infer/src/base/SourceFiles.ml new file mode 100644 index 000000000..505d9757d --- /dev/null +++ b/infer/src/base/SourceFiles.ml @@ -0,0 +1,28 @@ +(* + * Copyright (c) 2018 - present Facebook, Inc. + * All rights reserved. + * + * This source code is licensed under the BSD style license found in the + * LICENSE file in the root directory of this source tree. An additional grant + * of patent rights can be found in the PATENTS file in the same directory. + *) +open! IStd + +let get_all () = + let db = ResultsDatabase.get_database () in + Sqlite3.prepare db "SELECT source_file FROM source_files" + |> SqliteUtils.sqlite_result_rev_list_step db ~log:"getting all source files" + |> List.filter_map ~f:(Option.map ~f:SourceFile.SQLite.deserialize) + + +let exists_statement = + ResultsDatabase.register_statement "SELECT 1 FROM source_files WHERE source_file = :k" + + +let is_captured source = + ResultsDatabase.with_registered_statement exists_statement ~f:(fun db exists_stmt -> + SourceFile.SQLite.serialize source |> Sqlite3.bind exists_stmt 1 + (* :k *) + |> SqliteUtils.check_sqlite_error db ~log:"load captured source file" ; + SqliteUtils.sqlite_result_step ~finalize:false ~log:"SourceFiles.is_captured" db exists_stmt + |> Option.is_some ) diff --git a/infer/src/base/SourceFiles.mli b/infer/src/base/SourceFiles.mli new file mode 100644 index 000000000..5b179eb58 --- /dev/null +++ b/infer/src/base/SourceFiles.mli @@ -0,0 +1,14 @@ +(* + * Copyright (c) 2018 - present Facebook, Inc. + * All rights reserved. + * + * This source code is licensed under the BSD style license found in the + * LICENSE file in the root directory of this source tree. An additional grant + * of patent rights can be found in the PATENTS file in the same directory. + *) + +val get_all : unit -> SourceFile.t list +(** get all the source files in the database *) + +val is_captured : SourceFile.t -> bool +(** has the source file been captured? *) diff --git a/infer/src/checkers/NullabilityPreanalysis.ml b/infer/src/checkers/NullabilityPreanalysis.ml index 007ae8cf1..266ac9a9a 100644 --- a/infer/src/checkers/NullabilityPreanalysis.ml +++ b/infer/src/checkers/NullabilityPreanalysis.ml @@ -107,5 +107,5 @@ let analysis cfg tenv = domain else domain in - let fields_assigned_in_constructor = Cfg.fold_proc_desc cfg f initial in + let fields_assigned_in_constructor = Typ.Procname.Hash.fold f cfg initial in add_nonnull_to_fields fields_assigned_in_constructor tenv diff --git a/infer/src/clang/cFrontend.ml b/infer/src/clang/cFrontend.ml index 08bd43a14..5be5da6b5 100644 --- a/infer/src/clang/cFrontend.ml +++ b/infer/src/clang/cFrontend.ml @@ -21,7 +21,7 @@ let compute_icfg trans_unit_ctx tenv ast = CFrontend_config.global_translation_unit_decls := decl_list ; L.(debug Capture Verbose) "@\n Start creating icfg@\n" ; let cg = Cg.create trans_unit_ctx.CFrontend_config.source_file in - let cfg = Cfg.create_cfg () in + let cfg = Cfg.create () in List.iter ~f:(CFrontend_declImpl.translate_one_declaration trans_unit_ctx tenv cg cfg `DeclTraversal) decl_list ; diff --git a/infer/src/clang/cFrontend_decl.ml b/infer/src/clang/cFrontend_decl.ml index 5c34a1d1d..18cc76fc6 100644 --- a/infer/src/clang/cFrontend_decl.ml +++ b/infer/src/clang/cFrontend_decl.ml @@ -51,15 +51,15 @@ module CFrontend_decl_funct (T : CModule_type.CTranslation) : CModule_type.CFron "@\n@\n>>---------- ADDING METHOD: '%a' ---------<<@\n@\n" Typ.Procname.pp procname ; incr CFrontend_config.procedures_attempted ; let recover () = - Cfg.remove_proc_desc cfg procname ; + Typ.Procname.Hash.remove cfg procname ; CMethod_trans.create_external_procdesc cfg procname is_objc_method None in let pp_context fmt () = F.fprintf fmt "Aborting translation of method '%a'" Typ.Procname.pp procname in let f () = - match Cfg.find_proc_desc_from_name cfg procname with - | Some procdesc when Procdesc.is_defined procdesc && not (model_exists procname) -> + match Typ.Procname.Hash.find cfg procname with + | procdesc when Procdesc.is_defined procdesc && not (model_exists procname) -> let vars_to_destroy = CTrans_utils.Scope.compute_vars_to_destroy body in let context = CContext.create_context trans_unit_ctx tenv cg cfg procdesc class_decl_opt @@ -80,6 +80,8 @@ module CFrontend_decl_funct (T : CModule_type.CTranslation) : CModule_type.CFron Cg.add_defined_node (CContext.get_cg context) (Procdesc.get_proc_name procdesc) | _ -> () + | exception Not_found -> + () in protect ~f ~recover ~pp_context diff --git a/infer/src/clang/cMethod_trans.ml b/infer/src/clang/cMethod_trans.ml index 8b82259af..c87cf0e08 100644 --- a/infer/src/clang/cMethod_trans.ml +++ b/infer/src/clang/cMethod_trans.ml @@ -387,14 +387,14 @@ let sil_func_attributes_of_attributes attrs = let should_create_procdesc cfg procname defined set_objc_accessor_attr = - match Cfg.find_proc_desc_from_name cfg procname with - | Some previous_procdesc -> + match Typ.Procname.Hash.find cfg procname with + | previous_procdesc -> let is_defined_previous = Procdesc.is_defined previous_procdesc in if (defined || set_objc_accessor_attr) && not is_defined_previous then ( - Cfg.remove_proc_desc cfg (Procdesc.get_proc_name previous_procdesc) ; + Typ.Procname.Hash.remove cfg procname ; true ) else false - | None -> + | exception Not_found -> true @@ -634,22 +634,19 @@ let create_local_procdesc ?(set_objc_accessor_attr= false) trans_unit_ctx cfg te (** Create a procdesc for objc methods whose signature cannot be found. *) let create_external_procdesc cfg proc_name is_objc_inst_method type_opt = - match Cfg.find_proc_desc_from_name cfg proc_name with - | Some _ -> - () - | None -> - let ret_type, formals = - match type_opt with - | Some (ret_type, arg_types) -> - (ret_type, List.map ~f:(fun typ -> (Mangled.from_string "x", typ)) arg_types) - | None -> - (Typ.mk Typ.Tvoid, []) - in - let proc_attributes = - { (ProcAttributes.default proc_name) with - ProcAttributes.formals; is_objc_instance_method= is_objc_inst_method; ret_type } - in - ignore (Cfg.create_proc_desc cfg proc_attributes) + if not (Typ.Procname.Hash.mem cfg proc_name) then + let ret_type, formals = + match type_opt with + | Some (ret_type, arg_types) -> + (ret_type, List.map ~f:(fun typ -> (Mangled.from_string "x", typ)) arg_types) + | None -> + (Typ.mk Typ.Tvoid, []) + in + let proc_attributes = + { (ProcAttributes.default proc_name) with + ProcAttributes.formals; is_objc_instance_method= is_objc_inst_method; ret_type } + in + ignore (Cfg.create_proc_desc cfg proc_attributes) let create_procdesc_with_pointer context pointer class_name_opt name = diff --git a/infer/src/java/jFrontend.ml b/infer/src/java/jFrontend.ml index f8d7a5b6e..524f20c93 100644 --- a/infer/src/java/jFrontend.ml +++ b/infer/src/java/jFrontend.ml @@ -192,9 +192,7 @@ let should_capture classes package_opt source_basename node = In the standard - mode, it translated all the classes that correspond to this source file. *) let compute_source_icfg linereader classes program tenv source_basename package_opt source_file = - let icfg = - {JContext.cg= Cg.create source_file; JContext.cfg= Cfg.create_cfg (); JContext.tenv} - in + let icfg = {JContext.cg= Cg.create source_file; JContext.cfg= Cfg.create (); JContext.tenv} in let select test procedure cn node = if test node then try procedure cn node with Bir.Subroutine -> () in @@ -209,9 +207,7 @@ let compute_source_icfg linereader classes program tenv source_basename package_ let compute_class_icfg source_file linereader program tenv node = - let icfg = - {JContext.cg= Cg.create source_file; JContext.cfg= Cfg.create_cfg (); JContext.tenv} - in + let icfg = {JContext.cg= Cg.create source_file; JContext.cfg= Cfg.create (); JContext.tenv} in ( try create_icfg source_file linereader program icfg (Javalib.get_name node) node with Bir.Subroutine -> () ) ; (icfg.JContext.cg, icfg.JContext.cfg) diff --git a/infer/src/unit/analyzerTester.ml b/infer/src/unit/analyzerTester.ml index be2c79f24..acdff58ee 100644 --- a/infer/src/unit/analyzerTester.ml +++ b/infer/src/unit/analyzerTester.ml @@ -155,7 +155,7 @@ struct module M = I.InvariantMap let structured_program_to_cfg program test_pname = - let cfg = Cfg.create_cfg () in + let cfg = Cfg.create () in let pdesc = Cfg.create_proc_desc cfg (ProcAttributes.default test_pname) in let pname = Procdesc.get_proc_name pdesc in let create_node kind cmds = Procdesc.create_node pdesc dummy_loc kind cmds in diff --git a/infer/src/unit/procCfgTests.ml b/infer/src/unit/procCfgTests.ml index 00848f16f..38d9efb46 100644 --- a/infer/src/unit/procCfgTests.ml +++ b/infer/src/unit/procCfgTests.ml @@ -14,7 +14,7 @@ module InstrCfg = ProcCfg.OneInstrPerNode (ProcCfg.Normal) module BackwardInstrCfg = ProcCfg.Backward (InstrCfg) let tests = - let cfg = Cfg.create_cfg () in + let cfg = Cfg.create () in let test_pdesc = Cfg.create_proc_desc cfg (ProcAttributes.default Typ.Procname.empty_block) in let dummy_instr1 = Sil.Remove_temps ([], Location.dummy) in let dummy_instr2 = Sil.Abstract Location.dummy in