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

[cfg][minor] do not duplicate the Hashtbl API

Browse Source 
Summary: Use the Hashtbl functions directly as `Cfg` knows that a cfg is a hashtbl.

Reviewed By: sblackshear, jeremydubreil

Differential Revision: D6727732

fbshipit-source-id: 2cdda91
master
Jules Villard 7 years ago committed by Facebook Github Bot
parent dbdfb24be4
commit 1a5ba13778
21 changed files with 442 additions and 439 deletions
Show Stats Download Patch File Download Diff File

379
infer/src/IR/Cfg.ml
Unescape View File

@ -15,25 +15,24 @@ module F = Format
(** data type for the control flow graph *) (** data type for the control flow graph *)
type t = Procdesc.t Typ.Procname.Hash.t type t = Procdesc.t Typ.Procname.Hash.t
(** create a new empty cfg *) let create () = Typ.Procname.Hash.create 16
let create_cfg () = Typ.Procname.Hash.create 16
let add_proc_desc cfg pname pdesc = Typ.Procname.Hash.add cfg pname pdesc let get_all_proc_descs cfg =
let procs = ref [] in
let remove_proc_desc cfg pname = Typ.Procname.Hash.remove cfg pname let f _ pdesc = procs := pdesc :: !procs in
Typ.Procname.Hash.iter f cfg ; !procs
let iter_proc_desc cfg f = Typ.Procname.Hash.iter f cfg
let fold_proc_desc cfg f init = Typ.Procname.Hash.fold f cfg init
let find_proc_desc_from_name cfg pname = let get_all_proc_names cfg =
try Some (Typ.Procname.Hash.find cfg pname) with Not_found -> None let procs = ref [] in
let f pname _ = procs := pname :: !procs in
Typ.Procname.Hash.iter f cfg ; !procs
(** Create a new procdesc *) (** Create a new procdesc *)
let create_proc_desc cfg (proc_attributes: ProcAttributes.t) = let create_proc_desc cfg (proc_attributes: ProcAttributes.t) =
let pdesc = Procdesc.from_proc_attributes ~called_from_cfg:true proc_attributes in let pdesc = Procdesc.from_proc_attributes proc_attributes in
add_proc_desc cfg proc_attributes.proc_name pdesc ; Typ.Procname.Hash.add cfg proc_attributes.proc_name pdesc ;
pdesc pdesc
@ -42,7 +41,7 @@ let iter_all_nodes ?(sorted= false) f cfg =
let do_proc_desc _ (pdesc: Procdesc.t) = let do_proc_desc _ (pdesc: Procdesc.t) =
List.iter ~f:(fun node -> f pdesc node) (Procdesc.get_nodes pdesc) List.iter ~f:(fun node -> f pdesc node) (Procdesc.get_nodes pdesc)
in 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 else
Typ.Procname.Hash.fold Typ.Procname.Hash.fold
(fun _ pdesc desc_nodes -> (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) |> 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 *) (** checks whether a cfg is connected or not *)
let check_cfg_connectedness cfg = let check_cfg_connectedness cfg =
let is_exit_node n = 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 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 L.(die InternalError) "Broken CFG on %a" Typ.Procname.pp pname
in in
iter_proc_desc cfg do_pdesc Typ.Procname.Hash.iter do_pdesc cfg
let load_statement = let load_statement =
@ -118,7 +110,7 @@ let save_attributes source_file cfg =
in in
Attributes.store attributes' Attributes.store attributes'
in in
iter_proc_desc cfg save_proc Typ.Procname.Hash.iter save_proc cfg
(** Inline a synthetic (access or bridge) method. *) (** 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 proc_inline_synthetic_methods cfg pdesc : unit =
let instr_inline_synthetic_method = function let instr_inline_synthetic_method = function
| Sil.Call (ret_id, Exp.Const Const.Cfun pn, etl, loc, _) -> ( | Sil.Call (ret_id, Exp.Const Const.Cfun pn, etl, loc, _) -> (
match find_proc_desc_from_name cfg pn with match Typ.Procname.Hash.find cfg pn with
| Some pd -> | pd ->
let is_access = Typ.Procname.java_is_access_method pn in let is_access = Typ.Procname.java_is_access_method pn in
let attributes = Procdesc.get_attributes pd in let attributes = Procdesc.get_attributes pd in
let is_synthetic = attributes.is_synthetic_method in let is_synthetic = attributes.is_synthetic_method in
let is_bridge = attributes.is_bridge_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 if is_access || is_bridge || is_synthetic then inline_synthetic_method ret_id etl pd loc
else None else None
| None -> | exception Not_found ->
None ) None )
| _ -> | _ ->
None None
@ -213,7 +205,7 @@ let proc_inline_synthetic_methods cfg pdesc : unit =
(** Inline the java synthetic methods in the cfg *) (** Inline the java synthetic methods in the cfg *)
let inline_java_synthetic_methods 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 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] *) (** 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 ) 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 = let pp_proc_signatures fmt cfg =
F.fprintf fmt "METHOD SIGNATURES@\n@." ; 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 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)

41
infer/src/IR/Cfg.mli
Unescape View File

@ -12,8 +12,8 @@ open! IStd
(** Control Flow Graph for Interprocedural Analysis *) (** Control Flow Graph for Interprocedural Analysis *)
(** A control-flow graph *) (** A control-flow graph is a collection of all the CFGs for the procedure names in a file *)
type t type t = Procdesc.t Typ.Procname.Hash.t
val load : SourceFile.t -> t option val load : SourceFile.t -> t option
(** Load the cfgs of the procedures of a source file *) (** 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 val store : SourceFile.t -> t -> unit
(** Save a cfg into the database *) (** 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} *) (** {2 Functions for manipulating an interprocedural CFG} *)
val create_cfg : unit -> t val create : unit -> t
(** create a new empty cfg *) (** create a new empty cfg *)
val create_proc_desc : t -> ProcAttributes.t -> Procdesc.t val create_proc_desc : t -> ProcAttributes.t -> Procdesc.t
(** Create a new procdesc *) (** Create a new procdesc and add it to the cfg *)
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. *)
val iter_all_nodes : ?sorted:bool -> (Procdesc.t -> Procdesc.Node.t -> unit) -> t -> unit val iter_all_nodes : ?sorted:bool -> (Procdesc.t -> Procdesc.Node.t -> unit) -> t -> unit
(** Iterate over all the nodes in the cfg *) (** 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 val check_cfg_connectedness : t -> unit
(** checks whether a cfg is connected or not *) (** 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 pp_proc_signatures : Format.formatter -> t -> unit
val exists_for_source_file : SourceFile.t -> bool
val get_captured_source_files : unit -> SourceFile.t list

316
infer/src/IR/Procdesc.ml
Unescape View File

@ -223,9 +223,7 @@ type t =
; mutable loop_heads: NodeSet.t option (** loop head nodes of this procedure *) } ; mutable loop_heads: NodeSet.t option (** loop head nodes of this procedure *) }
[@@deriving compare] [@@deriving compare]
(** Only call from Cfg *) let from_proc_attributes attributes =
let from_proc_attributes ~called_from_cfg attributes =
if not called_from_cfg then assert false ;
let pname_opt = Some attributes.ProcAttributes.proc_name in let pname_opt = Some attributes.ProcAttributes.proc_name in
let start_node = Node.dummy pname_opt in let start_node = Node.dummy pname_opt in
let exit_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 ) ProcAttributes.var_attribute_equal attr ProcAttributes.Modify_in_block )
in in
List.exists ~f:pvar_local_matches (get_locals procdesc) 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)

17
infer/src/IR/Procdesc.mli
Unescape View File

@ -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 val fold_nodes : ('a -> Node.t -> 'a) -> 'a -> t -> 'a
(** fold over all nodes *) (** fold over all nodes *)
val from_proc_attributes : called_from_cfg:bool -> ProcAttributes.t -> t val from_proc_attributes : ProcAttributes.t -> t
(** Only call from Cfg. *) (** Use [Cfg.create_proc_desc] if you are adding a proc desc to a cfg *)
val get_access : t -> PredSymb.access val get_access : t -> PredSymb.access
(** Return the visibility attribute *) (** Return the visibility attribute *)
@ -215,3 +215,16 @@ val is_specialized : t -> bool
val is_captured_var : t -> Pvar.t -> bool val is_captured_var : t -> Pvar.t -> bool
val has_modify_in_block_attr : 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 *)

2
infer/src/backend/InferAnalyze.ml
Unescape View File

@ -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 (* delete all specs when doing a full analysis so that we do not report on procedures that do
not exist anymore *) not exist anymore *)
if not Config.reactive_mode then DB.Results_dir.clean_specs_dir () ; 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 = let clusters_to_analyze =
List.filter ~f:(cluster_should_be_analyzed ~changed_files) all_clusters List.filter ~f:(cluster_should_be_analyzed ~changed_files) all_clusters
in in

2
infer/src/backend/OndemandCapture.ml
Unescape View File

@ -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 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 barrier - if it exists it means that all attributes files have been created - write logic
is defined in Cfg.store *) 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 ; L.(debug Capture Verbose) "Started capture of %a...@\n" SourceFile.pp definition_file ;
Timeout.suspend_existing_timeout ~keep_symop_total:true ; Timeout.suspend_existing_timeout ~keep_symop_total:true ;
protect protect

2
infer/src/backend/SymExecBlocks.ml
Unescape View File

@ -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 (* 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 *) replaced by the block arguments. The formals have also been expanded with the captured variables *)
let specialized_pdesc = 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 in
Logging.(debug Analysis Verbose) "Instructions of specialized method:@." ; Logging.(debug Analysis Verbose) "Instructions of specialized method:@." ;
Procdesc.iter_instrs Procdesc.iter_instrs

2
infer/src/backend/callbacks.ml
Unescape View File

@ -55,7 +55,7 @@ let iterate_procedure_callbacks get_proc_desc exe_env summary proc_desc =
let get_procs_in_file proc_name = let get_procs_in_file proc_name =
match Exe_env.get_cfg exe_env proc_name with match Exe_env.get_cfg exe_env proc_name with
| Some cfg -> | Some cfg ->
Cfg.fold_proc_desc cfg (fun pname _ accu -> pname :: accu) [] Cfg.get_all_proc_names cfg
| None -> | None ->
[] []
in in

8
infer/src/backend/exe_env.ml
Unescape View File

@ -175,8 +175,12 @@ let get_cfg exe_env pname =
(** return the proc desc associated to the procedure *) (** return the proc desc associated to the procedure *)
let get_proc_desc exe_env pname = let get_proc_desc exe_env pname =
match get_cfg exe_env pname with match get_cfg exe_env pname with
| Some cfg -> | Some cfg -> (
Cfg.find_proc_desc_from_name cfg pname match Typ.Procname.Hash.find cfg pname with
| proc_desc ->
Some proc_desc
| exception Not_found ->
None )
| None -> | None ->
None None

4
infer/src/backend/printer.ml
Unescape View File

@ -547,7 +547,7 @@ let write_all_html_files cluster =
Exe_env.iter_files Exe_env.iter_files
(fun _ cfg -> (fun _ cfg ->
let source_files_in_cfg, pdescs_in_cfg = let source_files_in_cfg, pdescs_in_cfg =
Cfg.fold_proc_desc cfg Typ.Procname.Hash.fold
(fun _ proc_desc (files, pdescs) -> (fun _ proc_desc (files, pdescs) ->
let updated_files = let updated_files =
if Procdesc.is_defined proc_desc then if Procdesc.is_defined proc_desc then
@ -556,7 +556,7 @@ let write_all_html_files cluster =
else files else files
in in
(updated_files, proc_desc :: pdescs) ) (updated_files, proc_desc :: pdescs) )
(SourceFile.Set.empty, []) cfg (SourceFile.Set.empty, [])
in in
SourceFile.Set.iter SourceFile.Set.iter
(fun file -> write_html_file linereader file pdescs_in_cfg) (fun file -> write_html_file linereader file pdescs_in_cfg)

2
infer/src/backend/specs.ml
Unescape View File

@ -736,7 +736,7 @@ let init_summary proc_desc =
let dummy = let dummy =
let dummy_attributes = ProcAttributes.default Typ.Procname.empty_block in 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 init_summary dummy_proc_desc

3
infer/src/backend/symExec.ml
Unescape View File

@ -700,7 +700,8 @@ let resolve_and_analyze tenv caller_pdesc prop args callee_proc_name call_flags
Some resolved_proc_desc Some resolved_proc_desc
| None -> | None ->
Option.map 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) (Ondemand.get_proc_desc callee_proc_name)
in in
Option.bind resolved_proc_desc_option ~f:analyze Option.bind resolved_proc_desc_option ~f:analyze

28
infer/src/base/SourceFiles.ml
Unescape View File

@ -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 )

14
infer/src/base/SourceFiles.mli
Unescape View File

@ -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? *)

2
infer/src/checkers/NullabilityPreanalysis.ml
Unescape View File

@ -107,5 +107,5 @@ let analysis cfg tenv =
domain domain
else domain else domain
in 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 add_nonnull_to_fields fields_assigned_in_constructor tenv

2
infer/src/clang/cFrontend.ml
Unescape View File

@ -21,7 +21,7 @@ let compute_icfg trans_unit_ctx tenv ast =
CFrontend_config.global_translation_unit_decls := decl_list ; CFrontend_config.global_translation_unit_decls := decl_list ;
L.(debug Capture Verbose) "@\n Start creating icfg@\n" ; L.(debug Capture Verbose) "@\n Start creating icfg@\n" ;
let cg = Cg.create trans_unit_ctx.CFrontend_config.source_file in 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 List.iter
~f:(CFrontend_declImpl.translate_one_declaration trans_unit_ctx tenv cg cfg `DeclTraversal) ~f:(CFrontend_declImpl.translate_one_declaration trans_unit_ctx tenv cg cfg `DeclTraversal)
decl_list ; decl_list ;

8
infer/src/clang/cFrontend_decl.ml
Unescape View File

@ -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 ; "@\n@\n>>---------- ADDING METHOD: '%a' ---------<<@\n@\n" Typ.Procname.pp procname ;
incr CFrontend_config.procedures_attempted ; incr CFrontend_config.procedures_attempted ;
let recover () = 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 CMethod_trans.create_external_procdesc cfg procname is_objc_method None
in in
let pp_context fmt () = let pp_context fmt () =
F.fprintf fmt "Aborting translation of method '%a'" Typ.Procname.pp procname F.fprintf fmt "Aborting translation of method '%a'" Typ.Procname.pp procname
in in
let f () = let f () =
match Cfg.find_proc_desc_from_name cfg procname with match Typ.Procname.Hash.find cfg procname with
| Some procdesc when Procdesc.is_defined procdesc && not (model_exists procname) -> | procdesc when Procdesc.is_defined procdesc && not (model_exists procname) ->
let vars_to_destroy = CTrans_utils.Scope.compute_vars_to_destroy body in let vars_to_destroy = CTrans_utils.Scope.compute_vars_to_destroy body in
let context = let context =
CContext.create_context trans_unit_ctx tenv cg cfg procdesc class_decl_opt 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) Cg.add_defined_node (CContext.get_cg context) (Procdesc.get_proc_name procdesc)
| _ -> | _ ->
() ()
| exception Not_found ->
()
in in
protect ~f ~recover ~pp_context protect ~f ~recover ~pp_context

37
infer/src/clang/cMethod_trans.ml
Unescape View File

@ -387,14 +387,14 @@ let sil_func_attributes_of_attributes attrs =
let should_create_procdesc cfg procname defined set_objc_accessor_attr = let should_create_procdesc cfg procname defined set_objc_accessor_attr =
match Cfg.find_proc_desc_from_name cfg procname with match Typ.Procname.Hash.find cfg procname with
| Some previous_procdesc -> | previous_procdesc ->
let is_defined_previous = Procdesc.is_defined previous_procdesc in let is_defined_previous = Procdesc.is_defined previous_procdesc in
if (defined || set_objc_accessor_attr) && not is_defined_previous then ( 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 ) true )
else false else false
| None -> | exception Not_found ->
true 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. *) (** Create a procdesc for objc methods whose signature cannot be found. *)
let create_external_procdesc cfg proc_name is_objc_inst_method type_opt = let create_external_procdesc cfg proc_name is_objc_inst_method type_opt =
match Cfg.find_proc_desc_from_name cfg proc_name with if not (Typ.Procname.Hash.mem cfg proc_name) then
| Some _ -> let ret_type, formals =
() match type_opt with
| None -> | Some (ret_type, arg_types) ->
let ret_type, formals = (ret_type, List.map ~f:(fun typ -> (Mangled.from_string "x", typ)) arg_types)
match type_opt with | None ->
| Some (ret_type, arg_types) -> (Typ.mk Typ.Tvoid, [])
(ret_type, List.map ~f:(fun typ -> (Mangled.from_string "x", typ)) arg_types) in
| None -> let proc_attributes =
(Typ.mk Typ.Tvoid, []) { (ProcAttributes.default proc_name) with
in ProcAttributes.formals; is_objc_instance_method= is_objc_inst_method; ret_type }
let proc_attributes = in
{ (ProcAttributes.default proc_name) with ignore (Cfg.create_proc_desc cfg proc_attributes)
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 = let create_procdesc_with_pointer context pointer class_name_opt name =

8
infer/src/java/jFrontend.ml
Unescape View File

@ -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 In the standard - mode, it translated all the classes that correspond to this
source file. *) source file. *)
let compute_source_icfg linereader classes program tenv source_basename package_opt source_file = let compute_source_icfg linereader classes program tenv source_basename package_opt source_file =
let icfg = let icfg = {JContext.cg= Cg.create source_file; JContext.cfg= Cfg.create (); JContext.tenv} in
{JContext.cg= Cg.create source_file; JContext.cfg= Cfg.create_cfg (); JContext.tenv}
in
let select test procedure cn node = let select test procedure cn node =
if test node then try procedure cn node with Bir.Subroutine -> () if test node then try procedure cn node with Bir.Subroutine -> ()
in 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 compute_class_icfg source_file linereader program tenv node =
let icfg = let icfg = {JContext.cg= Cg.create source_file; JContext.cfg= Cfg.create (); JContext.tenv} in
{JContext.cg= Cg.create source_file; JContext.cfg= Cfg.create_cfg (); JContext.tenv}
in
( try create_icfg source_file linereader program icfg (Javalib.get_name node) node ( try create_icfg source_file linereader program icfg (Javalib.get_name node) node
with Bir.Subroutine -> () ) ; with Bir.Subroutine -> () ) ;
(icfg.JContext.cg, icfg.JContext.cfg) (icfg.JContext.cg, icfg.JContext.cfg)

2
infer/src/unit/analyzerTester.ml
Unescape View File

@ -155,7 +155,7 @@ struct
module M = I.InvariantMap module M = I.InvariantMap
let structured_program_to_cfg program test_pname = 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 pdesc = Cfg.create_proc_desc cfg (ProcAttributes.default test_pname) in
let pname = Procdesc.get_proc_name pdesc in let pname = Procdesc.get_proc_name pdesc in
let create_node kind cmds = Procdesc.create_node pdesc dummy_loc kind cmds in let create_node kind cmds = Procdesc.create_node pdesc dummy_loc kind cmds in

2
infer/src/unit/procCfgTests.ml
Unescape View File

@ -14,7 +14,7 @@ module InstrCfg = ProcCfg.OneInstrPerNode (ProcCfg.Normal)
module BackwardInstrCfg = ProcCfg.Backward (InstrCfg) module BackwardInstrCfg = ProcCfg.Backward (InstrCfg)
let tests = 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 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_instr1 = Sil.Remove_temps ([], Location.dummy) in
let dummy_instr2 = Sil.Abstract Location.dummy in let dummy_instr2 = Sil.Abstract Location.dummy in

Write Preview
Loading…
Cancel
Save