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

[IR] Move Procdesc module to a separate file.

Browse Source 
Reviewed By: jvillard

Differential Revision: D4159580

fbshipit-source-id: e83ebd5
master
Cristiano Calcagno 8 years ago committed by Facebook Github Bot
parent e8b61f6dbb
commit c5159bae1c
99 changed files with 1839 additions and 1715 deletions
Show Stats Download Patch File Download Diff File

590
infer/src/IR/Cfg.re
Unescape View File

@ -16,504 +16,13 @@ let module L = Logging;
let module F = Format;
/* =============== START of module Node =============== */
let module Node = {
type id = int;
type nodekind =
| Start_node Procname.t
| Exit_node Procname.t
| Stmt_node string
| Join_node
| Prune_node bool Sil.if_kind string /** (true/false branch, if_kind, comment) */
| Skip_node string;
/** a node */
type t = {
/** unique id of the node */
id: id,
/** distance to the exit node */
mutable dist_exit: option int,
/** exception nodes in the cfg */
mutable exn: list t,
/** instructions for symbolic execution */
mutable instrs: list Sil.instr,
/** kind of node */
kind: nodekind,
/** location in the source code */
loc: Location.t,
/** predecessor nodes in the cfg */
mutable preds: list t,
/** name of the procedure the node belongs to */
pname: option Procname.t,
/** successor nodes in the cfg */
mutable succs: list t
};
let exn_handler_kind = Stmt_node "exception handler";
let exn_sink_kind = Stmt_node "exceptions sink";
let throw_kind = Stmt_node "throw";
let dummy () => {
id: 0,
dist_exit: None,
instrs: [],
kind: Skip_node "dummy",
loc: Location.dummy,
pname: None,
succs: [],
preds: [],
exn: []
};
let compare node1 node2 => int_compare node1.id node2.id;
let hash node => Hashtbl.hash node.id;
let equal node1 node2 => compare node1 node2 == 0;
/** Get the unique id of the node */
let get_id node => node.id;
/** compare node ids */
let id_compare = int_compare;
let get_succs node => node.succs;
type node = t;
let module NodeSet = Set.Make {
type t = node;
let compare = compare;
};
let module IdMap = Map.Make {
type t = id;
let compare = id_compare;
};
let get_sliced_succs node f => {
let visited = ref NodeSet.empty;
let rec slice_nodes nodes :NodeSet.t => {
let do_node acc n => {
visited := NodeSet.add n !visited;
if (f n) {
NodeSet.singleton n
} else {
NodeSet.union
acc (slice_nodes (IList.filter (fun s => not (NodeSet.mem s !visited)) n.succs))
}
};
IList.fold_left do_node NodeSet.empty nodes
};
NodeSet.elements (slice_nodes node.succs)
};
let get_sliced_preds node f => {
let visited = ref NodeSet.empty;
let rec slice_nodes nodes :NodeSet.t => {
let do_node acc n => {
visited := NodeSet.add n !visited;
if (f n) {
NodeSet.singleton n
} else {
NodeSet.union
acc (slice_nodes (IList.filter (fun s => not (NodeSet.mem s !visited)) n.preds))
}
};
IList.fold_left do_node NodeSet.empty nodes
};
NodeSet.elements (slice_nodes node.preds)
};
let get_exn node => node.exn;
/** Get the name of the procedure the node belongs to */
let get_proc_name node =>
switch node.pname {
| None =>
L.out "get_proc_name: at node %d@\n" node.id;
assert false
| Some pname => pname
};
/** Get the predecessors of the node */
let get_preds node => node.preds;
/** Generates a list of nodes starting at a given node
and recursively adding the results of the generator */
let get_generated_slope start_node generator => {
let visited = ref NodeSet.empty;
let rec nodes n => {
visited := NodeSet.add n !visited;
let succs = IList.filter (fun n => not (NodeSet.mem n !visited)) (generator n);
switch (IList.length succs) {
| 1 => [n, ...nodes (IList.hd succs)]
| _ => [n]
}
};
nodes start_node
};
/** Get the node kind */
let get_kind node => node.kind;
/** Comparison for node kind */
let kind_compare k1 k2 =>
switch (k1, k2) {
| (Start_node pn1, Start_node pn2) => Procname.compare pn1 pn2
| (Start_node _, _) => (-1)
| (_, Start_node _) => 1
| (Exit_node pn1, Exit_node pn2) => Procname.compare pn1 pn2
| (Exit_node _, _) => (-1)
| (_, Exit_node _) => 1
| (Stmt_node s1, Stmt_node s2) => string_compare s1 s2
| (Stmt_node _, _) => (-1)
| (_, Stmt_node _) => 1
| (Join_node, Join_node) => 0
| (Join_node, _) => (-1)
| (_, Join_node) => 1
| (Prune_node is_true_branch1 if_kind1 descr1, Prune_node is_true_branch2 if_kind2 descr2) =>
let n = bool_compare is_true_branch1 is_true_branch2;
if (n != 0) {
n
} else {
let n = Pervasives.compare if_kind1 if_kind2;
if (n != 0) {
n
} else {
string_compare descr1 descr2
}
}
| (Prune_node _, _) => (-1)
| (_, Prune_node _) => 1
| (Skip_node s1, Skip_node s2) => string_compare s1 s2
};
/** Get the instructions to be executed */
let get_instrs node => node.instrs;
/** Get the list of callee procnames from the node */
let get_callees node => {
let collect callees instr =>
switch instr {
| Sil.Call _ exp _ _ _ =>
switch exp {
| Exp.Const (Const.Cfun procname) => [procname, ...callees]
| _ => callees
}
| _ => callees
};
IList.fold_left collect [] (get_instrs node)
};
/** Get the location of the node */
let get_loc n => n.loc;
/** Get the source location of the last instruction in the node */
let get_last_loc n =>
switch (IList.rev (get_instrs n)) {
| [instr, ..._] => Sil.instr_get_loc instr
| [] => n.loc
};
let pp_id f id => F.fprintf f "%d" id;
let pp f node => pp_id f (get_id node);
let get_distance_to_exit node => node.dist_exit;
/** Append the instructions to the list of instructions to execute */
let append_instrs node instrs => node.instrs = node.instrs @ instrs;
/** Add the instructions at the beginning of the list of instructions to execute */
let prepend_instrs node instrs => node.instrs = instrs @ node.instrs;
/** Replace the instructions to be executed. */
let replace_instrs node instrs => node.instrs = instrs;
/** Add declarations for local variables and return variable to the node */
let add_locals_ret_declaration node (proc_attributes: ProcAttributes.t) locals => {
let loc = get_loc node;
let pname = proc_attributes.proc_name;
let ret_var = {
let ret_type = proc_attributes.ret_type;
(Pvar.get_ret_pvar pname, ret_type)
};
let construct_decl (x, typ) => (Pvar.mk x pname, typ);
let ptl = [ret_var, ...IList.map construct_decl locals];
let instr = Sil.Declare_locals ptl loc;
prepend_instrs node [instr]
};
/** Print extended instructions for the node,
highlighting the given subinstruction if present */
let pp_instrs pe0 sub_instrs::sub_instrs instro fmt node => {
let pe =
switch instro {
| None => pe0
| Some instr => pe_extend_colormap pe0 (Obj.repr instr) Red
};
let instrs = get_instrs node;
let pp_loc fmt () => F.fprintf fmt " %a " Location.pp (get_loc node);
let print_sub_instrs () => F.fprintf fmt "%a" (Sil.pp_instr_list pe) instrs;
switch (get_kind node) {
| Stmt_node s =>
if sub_instrs {
print_sub_instrs ()
} else {
F.fprintf fmt "statements (%s) %a" s pp_loc ()
}
| Prune_node _ _ descr =>
if sub_instrs {
print_sub_instrs ()
} else {
F.fprintf fmt "assume %s %a" descr pp_loc ()
}
| Exit_node _ =>
if sub_instrs {
print_sub_instrs ()
} else {
F.fprintf fmt "exit %a" pp_loc ()
}
| Skip_node s =>
if sub_instrs {
print_sub_instrs ()
} else {
F.fprintf fmt "skip (%s) %a" s pp_loc ()
}
| Start_node _ =>
if sub_instrs {
print_sub_instrs ()
} else {
F.fprintf fmt "start %a" pp_loc ()
}
| Join_node =>
if sub_instrs {
print_sub_instrs ()
} else {
F.fprintf fmt "join %a" pp_loc ()
}
}
};
/** Dump extended instructions for the node */
let d_instrs sub_instrs::(sub_instrs: bool) (curr_instr: option Sil.instr) (node: t) => L.add_print_action (
L.PTnode_instrs,
Obj.repr (sub_instrs, curr_instr, node)
);
/** Return a description of the cfg node */
let get_description pe node => {
let str =
switch (get_kind node) {
| Stmt_node _ => "Instructions"
| Prune_node _ _ descr => "Conditional" ^ " " ^ descr
| Exit_node _ => "Exit"
| Skip_node _ => "Skip"
| Start_node _ => "Start"
| Join_node => "Join"
};
let pp fmt () => F.fprintf fmt "%s\n%a@?" str (pp_instrs pe None sub_instrs::true) node;
pp_to_string pp ()
};
};
/* =============== END of module Node =============== */
/** Map over nodes */
let module NodeMap = Map.Make Node;
/** Hash table with nodes as keys. */
let module NodeHash = Hashtbl.Make Node;
/** Set of nodes. */
let module NodeSet = Node.NodeSet;
/** Map with node id keys. */
let module IdMap = Node.IdMap;
/* =============== START of module Procdesc =============== */
let module Procdesc = {
/** procedure description */
type t = {
attributes: ProcAttributes.t, /** attributes of the procedure */
id: int, /** unique proc_desc identifier */
mutable nodes: list Node.t, /** list of nodes of this procedure */
mutable nodes_num: int, /** number of nodes */
mutable start_node: Node.t, /** start node of this procedure */
mutable exit_node: Node.t /** exit node of ths procedure */
};
/** Compute the distance of each node to the exit node, if not computed already */
let compute_distance_to_exit_node pdesc => {
let exit_node = pdesc.exit_node;
let rec mark_distance dist nodes => {
let next_nodes = ref [];
let do_node (node: Node.t) =>
switch node.dist_exit {
| Some _ => ()
| None =>
node.dist_exit = Some dist;
next_nodes := node.preds @ !next_nodes
};
IList.iter do_node nodes;
if (!next_nodes !== []) {
mark_distance (dist + 1) !next_nodes
}
};
mark_distance 0 [exit_node]
};
/** check or indicate if we have performed preanalysis on the CFG */
let did_preanalysis pdesc => pdesc.attributes.did_preanalysis;
let signal_did_preanalysis pdesc => pdesc.attributes.did_preanalysis = true;
let get_attributes pdesc => pdesc.attributes;
let get_err_log pdesc => pdesc.attributes.err_log;
let get_exit_node pdesc => pdesc.exit_node;
/** Get flags for the proc desc */
let get_flags pdesc => pdesc.attributes.proc_flags;
/** Return name and type of formal parameters */
let get_formals pdesc => pdesc.attributes.formals;
let get_loc pdesc => pdesc.attributes.loc;
/** Return name and type of local variables */
let get_locals pdesc => pdesc.attributes.locals;
/** Return name and type of captured variables */
let get_captured pdesc => pdesc.attributes.captured;
/** Return the visibility attribute */
let get_access pdesc => pdesc.attributes.access;
let get_nodes pdesc => pdesc.nodes;
let get_proc_name pdesc => pdesc.attributes.proc_name;
/** Return the return type of the procedure */
let get_ret_type pdesc => pdesc.attributes.ret_type;
let get_ret_var pdesc => Pvar.mk Ident.name_return (get_proc_name pdesc);
let get_start_node pdesc => pdesc.start_node;
/** List of nodes in the procedure sliced by a predicate up to the first branching */
let get_sliced_slope pdesc f =>
Node.get_generated_slope (get_start_node pdesc) (fun n => Node.get_sliced_succs n f);
/** List of nodes in the procedure up to the first branching */
let get_slope pdesc => Node.get_generated_slope (get_start_node pdesc) Node.get_succs;
/** Return [true] iff the procedure is defined, and not just declared */
let is_defined pdesc => pdesc.attributes.is_defined;
let is_java_synchronized pdesc => pdesc.attributes.is_java_synchronized_method;
let iter_nodes f pdesc => IList.iter f (IList.rev (get_nodes pdesc));
let fold_calls f acc pdesc => {
let do_node a node =>
IList.fold_left
(fun b callee_pname => f b (callee_pname, Node.get_loc node)) a (Node.get_callees node);
IList.fold_left do_node acc (get_nodes pdesc)
};
/** iterate over the calls from the procedure: (callee,location) pairs */
let iter_calls f pdesc => fold_calls (fun _ call => f call) () pdesc;
let iter_instrs f pdesc => {
let do_node node => IList.iter (fun i => f node i) (Node.get_instrs node);
iter_nodes do_node pdesc
};
let fold_nodes f acc pdesc => IList.fold_left f acc (IList.rev (get_nodes pdesc));
let fold_instrs f acc pdesc => {
let fold_node acc node =>
IList.fold_left (fun acc instr => f acc node instr) acc (Node.get_instrs node);
fold_nodes fold_node acc pdesc
};
let iter_slope f pdesc => {
let visited = ref NodeSet.empty;
let rec do_node node => {
visited := NodeSet.add node !visited;
f node;
switch (Node.get_succs node) {
| [n] =>
if (not (NodeSet.mem n !visited)) {
do_node n
}
| _ => ()
}
};
do_node (get_start_node pdesc)
};
let iter_slope_calls f pdesc => {
let do_node node => IList.iter (fun callee_pname => f callee_pname) (Node.get_callees node);
iter_slope do_node pdesc
};
/** iterate between two nodes or until we reach a branching structure */
let iter_slope_range f src_node dst_node => {
let visited = ref NodeSet.empty;
let rec do_node node => {
visited := NodeSet.add node !visited;
f node;
switch (Node.get_succs node) {
| [n] =>
if (not (NodeSet.mem n !visited) && not (Node.equal node dst_node)) {
do_node n
}
| _ => ()
}
};
do_node src_node
};
/** Set the exit node of the proc desc */
let set_exit_node pdesc node => pdesc.exit_node = node;
/** Set a flag for the proc desc */
let set_flag pdesc key value => proc_flags_add pdesc.attributes.proc_flags key value;
/** Set the start node of the proc desc */
let set_start_node pdesc node => pdesc.start_node = node;
/** Append the locals to the list of local variables */
let append_locals pdesc new_locals =>
pdesc.attributes.locals = pdesc.attributes.locals @ new_locals;
/** Set the successor nodes and exception nodes, and build predecessor links */
let set_succs_exn_base (node: Node.t) succs exn => {
node.succs = succs;
node.exn = exn;
IList.iter (fun (n: Node.t) => n.preds = [node, ...n.preds]) succs
};
/** Create a new cfg node */
let create_node pdesc loc kind instrs => {
pdesc.nodes_num = pdesc.nodes_num + 1;
let node_id = pdesc.nodes_num;
let node = {
Node.id: node_id,
dist_exit: None,
instrs,
kind,
loc,
preds: [],
pname: Some pdesc.attributes.proc_name,
succs: [],
exn: []
};
pdesc.nodes = [node, ...pdesc.nodes];
node
};
/** Set the successor and exception nodes.
If this is a join node right before the exit node, add an extra node in the middle,
otherwise nullify and abstract instructions cannot be added after a conditional. */
let node_set_succs_exn pdesc (node: Node.t) succs exn =>
switch (node.kind, succs) {
| (Join_node, [{Node.kind: Exit_node _} as exit_node]) =>
let kind = Node.Stmt_node "between_join_and_exit";
let node' = create_node pdesc node.loc kind node.instrs;
set_succs_exn_base node [node'] exn;
set_succs_exn_base node' [exit_node] exn
| _ => set_succs_exn_base node succs exn
};
};
/* =============== END of module Procdesc =============== */
/** data type for the control flow graph */
type cfg = {
mutable proc_desc_id_counter: int /** Counter for identifiers of procdescs */,
proc_desc_table: Procname.Hash.t Procdesc.t /** Map proc name to procdesc */
};
type cfg = {proc_desc_table: Procname.Hash.t Procdesc.t /** Map proc name to procdesc */};
/** create a new empty cfg */
let create_cfg () => {proc_desc_id_counter: 0, proc_desc_table: Procname.Hash.create 16};
let create_cfg () => {proc_desc_table: Procname.Hash.create 16};
let add_proc_desc cfg pname pdesc => Procname.Hash.add cfg.proc_desc_table pname pdesc;
@ -529,15 +38,7 @@ let find_proc_desc_from_name cfg pname =>
/** Create a new procdesc */
let create_proc_desc cfg (proc_attributes: ProcAttributes.t) => {
cfg.proc_desc_id_counter = cfg.proc_desc_id_counter + 1;
let pdesc = {
Procdesc.attributes: proc_attributes,
id: cfg.proc_desc_id_counter,
nodes: [],
nodes_num: 0,
start_node: Node.dummy (),
exit_node: Node.dummy ()
};
let pdesc = Procdesc.from_proc_attributes called_from_cfg::true proc_attributes;
add_proc_desc cfg proc_attributes.proc_name pdesc;
pdesc
};
@ -545,7 +46,8 @@ let create_proc_desc cfg (proc_attributes: ProcAttributes.t) => {
/** Iterate over all the nodes in the cfg */
let iter_all_nodes f cfg => {
let do_proc_desc _ (pdesc: Procdesc.t) => IList.iter (fun node => f pdesc node) pdesc.nodes;
let do_proc_desc _ (pdesc: Procdesc.t) =>
IList.iter (fun node => f pdesc node) (Procdesc.get_nodes pdesc);
iter_proc_desc cfg do_proc_desc
};
@ -566,20 +68,20 @@ let get_defined_procs cfg => IList.filter Procdesc.is_defined (get_all_procs cfg
/** checks whether a cfg is connected or not */
let check_cfg_connectedness cfg => {
let is_exit_node n =>
switch (Node.get_kind n) {
| Node.Exit_node _ => true
switch (Procdesc.Node.get_kind n) {
| Procdesc.Node.Exit_node _ => true
| _ => false
};
let broken_node n => {
let succs = Node.get_succs n;
let preds = Node.get_preds n;
switch (Node.get_kind n) {
| Node.Start_node _ => IList.length succs == 0 || IList.length preds > 0
| Node.Exit_node _ => IList.length succs > 0 || IList.length preds == 0
| Node.Stmt_node _
| Node.Prune_node _
| Node.Skip_node _ => IList.length succs == 0 || IList.length preds == 0
| Node.Join_node =>
let succs = Procdesc.Node.get_succs n;
let preds = Procdesc.Node.get_preds n;
switch (Procdesc.Node.get_kind n) {
| Procdesc.Node.Start_node _ => IList.length succs == 0 || IList.length preds > 0
| Procdesc.Node.Exit_node _ => IList.length succs > 0 || IList.length preds == 0
| Procdesc.Node.Stmt_node _
| Procdesc.Node.Prune_node _
| Procdesc.Node.Skip_node _ => IList.length succs == 0 || IList.length preds == 0
| Procdesc.Node.Join_node =>
/* Join node has the exception that it may be without predecessors
and pointing to an exit node */
/* if the if brances end with a return */
@ -741,10 +243,10 @@ let proc_inline_synthetic_methods cfg pdesc :unit => {
modified := true;
instr'
};
let instrs = Node.get_instrs node;
let instrs = Procdesc.Node.get_instrs node;
let instrs' = IList.map do_instr instrs;
if !modified {
Node.replace_instrs node instrs'
Procdesc.Node.replace_instrs node instrs'
}
};
Procdesc.iter_nodes node_inline_synthetic_methods pdesc
@ -767,26 +269,24 @@ let mark_unchanged_pdescs cfg_new cfg_old => {
/* map of exp names in pd1 -> exp names in pd2 */
let exp_map = ref Exp.Map.empty;
/* map of node id's in pd1 -> node id's in pd2 */
let id_map = ref IntMap.empty;
let node_map = ref Procdesc.NodeMap.empty;
/* formals are the same if their types are the same */
let formals_eq formals1 formals2 =>
IList.equal (fun (_, typ1) (_, typ2) => Typ.compare typ1 typ2) formals1 formals2;
let nodes_eq n1s n2s => {
/* nodes are the same if they have the same id, instructions, and succs/preds up to renaming
with [exp_map] and [id_map] */
let node_eq (n1: Node.t) (n2: Node.t) => {
let id_compare (n1: Node.t) (n2: Node.t) => {
let (id1, id2) = (n1.id, n2.id);
let node_eq (n1: Procdesc.Node.t) (n2: Procdesc.Node.t) => {
let id_compare (n1: Procdesc.Node.t) (n2: Procdesc.Node.t) =>
try {
let id1_mapping = IntMap.find id1 !id_map;
Pervasives.compare id1_mapping id2
let n1_mapping = Procdesc.NodeMap.find n1 !node_map;
Procdesc.Node.compare n1_mapping n2
} {
| Not_found =>
/* assume id's are equal and enforce by adding to [id_map] */
id_map := IntMap.add id1 id2 !id_map;
node_map := Procdesc.NodeMap.add n1 n2 !node_map;
0
}
};
};
let instrs_eq instrs1 instrs2 =>
IList.equal
(
@ -799,18 +299,20 @@ let mark_unchanged_pdescs cfg_new cfg_old => {
instrs1
instrs2;
id_compare n1 n2 == 0 &&
IList.equal id_compare n1.succs n2.succs &&
IList.equal id_compare n1.preds n2.preds && instrs_eq n1.instrs n2.instrs
IList.equal Procdesc.Node.compare (Procdesc.Node.get_succs n1) (Procdesc.Node.get_succs n2) &&
IList.equal Procdesc.Node.compare (Procdesc.Node.get_preds n1) (Procdesc.Node.get_preds n2) &&
instrs_eq (Procdesc.Node.get_instrs n1) (Procdesc.Node.get_instrs n2)
};
try (IList.for_all2 node_eq n1s n2s) {
| Invalid_argument _ => false
}
};
let att1 = pd1.attributes
and att2 = pd2.attributes;
let att1 = Procdesc.get_attributes pd1
and att2 = Procdesc.get_attributes pd2;
att1.is_defined == att2.is_defined &&
Typ.equal att1.ret_type att2.ret_type &&
formals_eq att1.formals att2.formals && nodes_eq pd1.nodes pd2.nodes
formals_eq att1.formals att2.formals &&
nodes_eq (Procdesc.get_nodes pd1) (Procdesc.get_nodes pd2)
};
let old_procs = cfg_old.proc_desc_table;
let new_procs = cfg_new.proc_desc_table;
@ -819,9 +321,9 @@ let mark_unchanged_pdescs cfg_new cfg_old => {
let old_pdesc = Procname.Hash.find old_procs pname;
let changed =
/* in continue_capture mode keep the old changed bit */
Config.continue_capture && old_pdesc.attributes.changed ||
Config.continue_capture && (Procdesc.get_attributes old_pdesc).changed ||
not (pdescs_eq old_pdesc new_pdesc);
new_pdesc.attributes.changed = changed
(Procdesc.get_attributes new_pdesc).changed = changed
} {
| Not_found => ()
};
@ -940,14 +442,14 @@ let specialize_types_proc callee_pdesc resolved_pdesc substitutions => {
instrs;
let convert_node_kind =
fun
| Node.Start_node _ => Node.Start_node resolved_pname
| Node.Exit_node _ => Node.Exit_node resolved_pname
| Procdesc.Node.Start_node _ => Procdesc.Node.Start_node resolved_pname
| Procdesc.Node.Exit_node _ => Procdesc.Node.Exit_node resolved_pname
| node_kind => node_kind;
let node_map = ref NodeMap.empty;
let node_map = ref Procdesc.NodeMap.empty;
let rec convert_node node => {
let loc = Node.get_loc node
and kind = convert_node_kind (Node.get_kind node)
and instrs = IList.fold_left convert_instr [] (Node.get_instrs node) |> IList.rev;
let loc = Procdesc.Node.get_loc node
and kind = convert_node_kind (Procdesc.Node.get_kind node)
and instrs = IList.fold_left convert_instr [] (Procdesc.Node.get_instrs node) |> IList.rev;
Procdesc.create_node resolved_pdesc loc kind instrs
}
and loop callee_nodes =>
@ -955,16 +457,16 @@ let specialize_types_proc callee_pdesc resolved_pdesc substitutions => {
| [] => []
| [node, ...other_node] =>
let converted_node =
try (NodeMap.find node !node_map) {
try (Procdesc.NodeMap.find node !node_map) {
| Not_found =>
let new_node = convert_node node
and successors = Node.get_succs node
and exn_nodes = Node.get_exn node;
node_map := NodeMap.add node new_node !node_map;
if (Node.equal node callee_start_node) {
and successors = Procdesc.Node.get_succs node
and exn_nodes = Procdesc.Node.get_exn node;
node_map := Procdesc.NodeMap.add node new_node !node_map;
if (Procdesc.Node.equal node callee_start_node) {
Procdesc.set_start_node resolved_pdesc new_node
};
if (Node.equal node callee_exit_node) {
if (Procdesc.Node.equal node callee_exit_node) {
Procdesc.set_exit_node resolved_pdesc new_node
};
Procdesc.node_set_succs_exn callee_pdesc new_node (loop successors) (loop exn_nodes);

229
infer/src/IR/Cfg.rei
Unescape View File

@ -15,221 +15,6 @@ open! Utils;
/** Control Flow Graph for Interprocedural Analysis */
/** node of the control flow graph */
let module Node: {
/** type of nodes */
type t;
/** node id */
type id = private int;
/** kind of cfg node */
type nodekind =
| Start_node Procname.t
| Exit_node Procname.t
| Stmt_node string
| Join_node
| Prune_node bool Sil.if_kind string /** (true/false branch, if_kind, comment) */
| Skip_node string;
/** kind of Stmt_node for an exception handler. */
let exn_handler_kind: nodekind;
/** kind of Stmt_node for an exceptions sink. */
let exn_sink_kind: nodekind;
/** kind of Stmt_node for a throw instruction. */
let throw_kind: nodekind;
/** Add declarations for local variables and return variable to the node */
let add_locals_ret_declaration: t => ProcAttributes.t => list (Mangled.t, Typ.t) => unit;
/** Append the instructions to the list of instructions to execute */
let append_instrs: t => list Sil.instr => unit;
/** Compare two nodes */
let compare: t => t => int;
/** Dump extended instructions for the node */
let d_instrs: sub_instrs::bool => option Sil.instr => t => unit;
/** Create a dummy node */
let dummy: unit => t;
/** Check if two nodes are equal */
let equal: t => t => bool;
/** Get the list of callee procnames from the node */
let get_callees: t => list Procname.t;
/** Return a description of the node */
let get_description: printenv => t => string;
/** Get the distance to the exit node, if it has been computed */
let get_distance_to_exit: t => option int;
/** Get the exception nodes from the current node */
let get_exn: t => list t;
/** Get a list of unique nodes until the first branch starting
from a node with subsequent applications of a generator function */
let get_generated_slope: t => (t => list t) => list t;
/** Get the unique id of the node */
let get_id: t => id;
/** Get the instructions to be executed */
let get_instrs: t => list Sil.instr;
/** Get the kind of the current node */
let get_kind: t => nodekind;
/** Get the source location of the last instruction in the node */
let get_last_loc: t => Location.t;
/** Get the source location of the node */
let get_loc: t => Location.t;
/** Get the predecessor nodes of the current node */
let get_preds: t => list t;
/** Get the name of the procedure the node belongs to */
let get_proc_name: t => Procname.t;
/** Get the predecessor nodes of a node where the given predicate evaluates to true */
let get_sliced_preds: t => (t => bool) => list t;
/** Get the successor nodes of a node where the given predicate evaluates to true */
let get_sliced_succs: t => (t => bool) => list t;
/** Get the successor nodes of the current node */
let get_succs: t => list t;
/** Hash function for nodes */
let hash: t => int;
/** compare node ids */
let id_compare: id => id => int;
/** Comparison for node kind */
let kind_compare: nodekind => nodekind => int;
/** Pretty print the node */
let pp: Format.formatter => t => unit;
/** Pretty print a node id */
let pp_id: Format.formatter => id => unit;
/** Print extended instructions for the node,
highlighting the given subinstruction if present */
let pp_instrs: printenv => sub_instrs::bool => option Sil.instr => Format.formatter => t => unit;
/** Replace the instructions to be executed. */
let replace_instrs: t => list Sil.instr => unit;
};
/** procedure description */
let module Procdesc: {
/** proc description */
type t;
/** append a list of new local variables to the existing list of local variables */
let append_locals: t => list (Mangled.t, Typ.t) => unit;
/** Compute the distance of each node to the exit node, if not computed already */
let compute_distance_to_exit_node: t => unit;
/** Create a new cfg node with the given location, kind, list of instructions,
and add it to the procdesc. */
let create_node: t => Location.t => Node.nodekind => list Sil.instr => Node.t;
/** true if we ran the preanalysis on the CFG associated with [t] */
let did_preanalysis: t => bool;
/** fold over the calls from the procedure: (callee, location) pairs */
let fold_calls: ('a => (Procname.t, Location.t) => 'a) => 'a => t => 'a;
/** fold over all nodes and their instructions */
let fold_instrs: ('a => Node.t => Sil.instr => 'a) => 'a => t => 'a;
/** Return the visibility attribute */
let get_access: t => PredSymb.access;
/** Get the attributes of the procedure. */
let get_attributes: t => ProcAttributes.t;
/** Return name and type of block's captured variables */
let get_captured: t => list (Mangled.t, Typ.t);
let get_err_log: t => Errlog.t;
let get_exit_node: t => Node.t;
/** Get flags for the proc desc */
let get_flags: t => proc_flags;
/** Return name and type of formal parameters */
let get_formals: t => list (Mangled.t, Typ.t);
/** Return loc information for the procedure */
let get_loc: t => Location.t;
/** Return name and type of local variables */
let get_locals: t => list (Mangled.t, Typ.t);
let get_nodes: t => list Node.t;
let get_proc_name: t => Procname.t;
/** Return the return type of the procedure and type string */
let get_ret_type: t => Typ.t;
let get_ret_var: t => Pvar.t;
/** Get the sliced procedure's nodes up until the first branching */
let get_sliced_slope: t => (Node.t => bool) => list Node.t;
/** Get the procedure's nodes up until the first branching */
let get_slope: t => list Node.t;
let get_start_node: t => Node.t;
/** Return [true] iff the procedure is defined, and not just declared */
let is_defined: t => bool;
/** Return [true] if the procedure signature has the Java synchronized keyword */
let is_java_synchronized: t => bool;
/** iterate over the calls from the procedure: (callee, location) pairs */
let iter_calls: ((Procname.t, Location.t) => unit) => t => unit;
/** iterate over all nodes and their instructions */
let iter_instrs: (Node.t => Sil.instr => unit) => t => unit;
/** iterate over all the nodes of a procedure */
let iter_nodes: (Node.t => unit) => t => unit;
/** iterate over all nodes until we reach a branching structure */
let iter_slope: (Node.t => unit) => t => unit;
/** iterate over all calls until we reach a branching structure */
let iter_slope_calls: (Procname.t => unit) => t => unit;
/** iterate between two nodes or until we reach a branching structure */
let iter_slope_range: (Node.t => unit) => Node.t => Node.t => unit;
/** Set the successor nodes and exception nodes, and build predecessor links */
let node_set_succs_exn: t => Node.t => list Node.t => list Node.t => unit;
/** Set the exit node of the procedure */
let set_exit_node: t => Node.t => unit;
/** Set a flag for the proc desc */
let set_flag: t => string => string => unit;
let set_start_node: t => Node.t => unit;
/** indicate that we have performed preanalysis on the CFG assoociated with [t] */
let signal_did_preanalysis: t => unit;
};
/** A control-flow graph */
type cfg;
@ -243,18 +28,6 @@ let store_cfg_to_file:
save_sources::bool? => source_file::DB.source_file => DB.filename => cfg => unit;
/** Hash table with nodes as keys. */
let module NodeHash: Hashtbl.S with type key = Node.t;
/** Set of nodes. */
let module NodeSet: Set.S with type elt = Node.t;
/** Map with node id keys. */
let module IdMap: Map.S with type key = Node.id;
/** {2 Functions for manipulating an interprocedural CFG} */
/** create a new empty cfg */
@ -282,7 +55,7 @@ let get_defined_procs: cfg => list Procdesc.t;
/** Iterate over all the nodes in the cfg */
let iter_all_nodes: (Procdesc.t => Node.t => unit) => cfg => unit;
let iter_all_nodes: (Procdesc.t => Procdesc.Node.t => unit) => cfg => unit;
/** checks whether a cfg is connected or not */

546
infer/src/IR/Procdesc.re
Unescape View File

@ -0,0 +1,546 @@
/*
* vim: set ft=rust:
* vim: set ft=reason:
*
* Copyright (c) 2009 - 2013 Monoidics ltd.
* Copyright (c) 2013 - 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! Utils;
let module L = Logging;
let module F = Format;
/* =============== START of module Node =============== */
let module Node = {
type id = int;
type nodekind =
| Start_node Procname.t
| Exit_node Procname.t
| Stmt_node string
| Join_node
| Prune_node bool Sil.if_kind string /** (true/false branch, if_kind, comment) */
| Skip_node string;
/** a node */
type t = {
/** unique id of the node */
id: id,
/** distance to the exit node */
mutable dist_exit: option int,
/** exception nodes in the cfg */
mutable exn: list t,
/** instructions for symbolic execution */
mutable instrs: list Sil.instr,
/** kind of node */
kind: nodekind,
/** location in the source code */
loc: Location.t,
/** predecessor nodes in the cfg */
mutable preds: list t,
/** name of the procedure the node belongs to */
pname: option Procname.t,
/** successor nodes in the cfg */
mutable succs: list t
};
let exn_handler_kind = Stmt_node "exception handler";
let exn_sink_kind = Stmt_node "exceptions sink";
let throw_kind = Stmt_node "throw";
let dummy () => {
id: 0,
dist_exit: None,
instrs: [],
kind: Skip_node "dummy",
loc: Location.dummy,
pname: None,
succs: [],
preds: [],
exn: []
};
let compare node1 node2 => int_compare node1.id node2.id;
let hash node => Hashtbl.hash node.id;
let equal node1 node2 => compare node1 node2 == 0;
/** Get the unique id of the node */
let get_id node => node.id;
/** compare node ids */
let id_compare = int_compare;
let get_succs node => node.succs;
type node = t;
let module NodeSet = Set.Make {
type t = node;
let compare = compare;
};
let module IdMap = Map.Make {
type t = id;
let compare = id_compare;
};
let get_sliced_succs node f => {
let visited = ref NodeSet.empty;
let rec slice_nodes nodes :NodeSet.t => {
let do_node acc n => {
visited := NodeSet.add n !visited;
if (f n) {
NodeSet.singleton n
} else {
NodeSet.union
acc (slice_nodes (IList.filter (fun s => not (NodeSet.mem s !visited)) n.succs))
}
};
IList.fold_left do_node NodeSet.empty nodes
};
NodeSet.elements (slice_nodes node.succs)
};
let get_sliced_preds node f => {
let visited = ref NodeSet.empty;
let rec slice_nodes nodes :NodeSet.t => {
let do_node acc n => {
visited := NodeSet.add n !visited;
if (f n) {
NodeSet.singleton n
} else {
NodeSet.union
acc (slice_nodes (IList.filter (fun s => not (NodeSet.mem s !visited)) n.preds))
}
};
IList.fold_left do_node NodeSet.empty nodes
};
NodeSet.elements (slice_nodes node.preds)
};
let get_exn node => node.exn;
/** Get the name of the procedure the node belongs to */
let get_proc_name node =>
switch node.pname {
| None =>
L.out "get_proc_name: at node %d@\n" node.id;
assert false
| Some pname => pname
};
/** Get the predecessors of the node */
let get_preds node => node.preds;
/** Generates a list of nodes starting at a given node
and recursively adding the results of the generator */
let get_generated_slope start_node generator => {
let visited = ref NodeSet.empty;
let rec nodes n => {
visited := NodeSet.add n !visited;
let succs = IList.filter (fun n => not (NodeSet.mem n !visited)) (generator n);
switch (IList.length succs) {
| 1 => [n, ...nodes (IList.hd succs)]
| _ => [n]
}
};
nodes start_node
};
/** Get the node kind */
let get_kind node => node.kind;
/** Comparison for node kind */
let kind_compare k1 k2 =>
switch (k1, k2) {
| (Start_node pn1, Start_node pn2) => Procname.compare pn1 pn2
| (Start_node _, _) => (-1)
| (_, Start_node _) => 1
| (Exit_node pn1, Exit_node pn2) => Procname.compare pn1 pn2
| (Exit_node _, _) => (-1)
| (_, Exit_node _) => 1
| (Stmt_node s1, Stmt_node s2) => string_compare s1 s2
| (Stmt_node _, _) => (-1)
| (_, Stmt_node _) => 1
| (Join_node, Join_node) => 0
| (Join_node, _) => (-1)
| (_, Join_node) => 1
| (Prune_node is_true_branch1 if_kind1 descr1, Prune_node is_true_branch2 if_kind2 descr2) =>
let n = bool_compare is_true_branch1 is_true_branch2;
if (n != 0) {
n
} else {
let n = Pervasives.compare if_kind1 if_kind2;
if (n != 0) {
n
} else {
string_compare descr1 descr2
}
}
| (Prune_node _, _) => (-1)
| (_, Prune_node _) => 1
| (Skip_node s1, Skip_node s2) => string_compare s1 s2
};
/** Get the instructions to be executed */
let get_instrs node => node.instrs;
/** Get the list of callee procnames from the node */
let get_callees node => {
let collect callees instr =>
switch instr {
| Sil.Call _ exp _ _ _ =>
switch exp {
| Exp.Const (Const.Cfun procname) => [procname, ...callees]
| _ => callees
}
| _ => callees
};
IList.fold_left collect [] (get_instrs node)
};
/** Get the location of the node */
let get_loc n => n.loc;
/** Get the source location of the last instruction in the node */
let get_last_loc n =>
switch (IList.rev (get_instrs n)) {
| [instr, ..._] => Sil.instr_get_loc instr
| [] => n.loc
};
let pp_id f id => F.fprintf f "%d" id;
let pp f node => pp_id f (get_id node);
let get_distance_to_exit node => node.dist_exit;
/** Append the instructions to the list of instructions to execute */
let append_instrs node instrs => node.instrs = node.instrs @ instrs;
/** Add the instructions at the beginning of the list of instructions to execute */
let prepend_instrs node instrs => node.instrs = instrs @ node.instrs;
/** Replace the instructions to be executed. */
let replace_instrs node instrs => node.instrs = instrs;
/** Add declarations for local variables and return variable to the node */
let add_locals_ret_declaration node (proc_attributes: ProcAttributes.t) locals => {
let loc = get_loc node;
let pname = proc_attributes.proc_name;
let ret_var = {
let ret_type = proc_attributes.ret_type;
(Pvar.get_ret_pvar pname, ret_type)
};
let construct_decl (x, typ) => (Pvar.mk x pname, typ);
let ptl = [ret_var, ...IList.map construct_decl locals];
let instr = Sil.Declare_locals ptl loc;
prepend_instrs node [instr]
};
/** Print extended instructions for the node,
highlighting the given subinstruction if present */
let pp_instrs pe0 sub_instrs::sub_instrs instro fmt node => {
let pe =
switch instro {
| None => pe0
| Some instr => pe_extend_colormap pe0 (Obj.repr instr) Red
};
let instrs = get_instrs node;
let pp_loc fmt () => F.fprintf fmt " %a " Location.pp (get_loc node);
let print_sub_instrs () => F.fprintf fmt "%a" (Sil.pp_instr_list pe) instrs;
switch (get_kind node) {
| Stmt_node s =>
if sub_instrs {
print_sub_instrs ()
} else {
F.fprintf fmt "statements (%s) %a" s pp_loc ()
}
| Prune_node _ _ descr =>
if sub_instrs {
print_sub_instrs ()
} else {
F.fprintf fmt "assume %s %a" descr pp_loc ()
}
| Exit_node _ =>
if sub_instrs {
print_sub_instrs ()
} else {
F.fprintf fmt "exit %a" pp_loc ()
}
| Skip_node s =>
if sub_instrs {
print_sub_instrs ()
} else {
F.fprintf fmt "skip (%s) %a" s pp_loc ()
}
| Start_node _ =>
if sub_instrs {
print_sub_instrs ()
} else {
F.fprintf fmt "start %a" pp_loc ()
}
| Join_node =>
if sub_instrs {
print_sub_instrs ()
} else {
F.fprintf fmt "join %a" pp_loc ()
}
}
};
/** Dump extended instructions for the node */
let d_instrs sub_instrs::(sub_instrs: bool) (curr_instr: option Sil.instr) (node: t) => L.add_print_action (
L.PTnode_instrs,
Obj.repr (sub_instrs, curr_instr, node)
);
/** Return a description of the cfg node */
let get_description pe node => {
let str =
switch (get_kind node) {
| Stmt_node _ => "Instructions"
| Prune_node _ _ descr => "Conditional" ^ " " ^ descr
| Exit_node _ => "Exit"
| Skip_node _ => "Skip"
| Start_node _ => "Start"
| Join_node => "Join"
};
let pp fmt () => F.fprintf fmt "%s\n%a@?" str (pp_instrs pe None sub_instrs::true) node;
pp_to_string pp ()
};
};
/* =============== END of module Node =============== */
/** Map over nodes */
let module NodeMap = Map.Make Node;
/** Hash table with nodes as keys. */
let module NodeHash = Hashtbl.Make Node;
/** Set of nodes. */
let module NodeSet = Node.NodeSet;
/** Map with node id keys. */
let module IdMap = Node.IdMap;
/** procedure description */
type t = {
attributes: ProcAttributes.t, /** attributes of the procedure */
mutable nodes: list Node.t, /** list of nodes of this procedure */
mutable nodes_num: int, /** number of nodes */
mutable start_node: Node.t, /** start node of this procedure */
mutable exit_node: Node.t /** exit node of ths procedure */
};
/** Only call from Cfg */
let from_proc_attributes called_from_cfg::called_from_cfg attributes => {
if (not called_from_cfg) {
assert false
};
{attributes, nodes: [], nodes_num: 0, start_node: Node.dummy (), exit_node: Node.dummy ()}
};
/** Compute the distance of each node to the exit node, if not computed already */
let compute_distance_to_exit_node pdesc => {
let exit_node = pdesc.exit_node;
let rec mark_distance dist nodes => {
let next_nodes = ref [];
let do_node (node: Node.t) =>
switch node.dist_exit {
| Some _ => ()
| None =>
node.dist_exit = Some dist;
next_nodes := node.preds @ !next_nodes
};
IList.iter do_node nodes;
if (!next_nodes !== []) {
mark_distance (dist + 1) !next_nodes
}
};
mark_distance 0 [exit_node]
};
/** check or indicate if we have performed preanalysis on the CFG */
let did_preanalysis pdesc => pdesc.attributes.did_preanalysis;
let signal_did_preanalysis pdesc => pdesc.attributes.did_preanalysis = true;
let get_attributes pdesc => pdesc.attributes;
let get_err_log pdesc => pdesc.attributes.err_log;
let get_exit_node pdesc => pdesc.exit_node;
/** Get flags for the proc desc */
let get_flags pdesc => pdesc.attributes.proc_flags;
/** Return name and type of formal parameters */
let get_formals pdesc => pdesc.attributes.formals;
let get_loc pdesc => pdesc.attributes.loc;
/** Return name and type of local variables */
let get_locals pdesc => pdesc.attributes.locals;
/** Return name and type of captured variables */
let get_captured pdesc => pdesc.attributes.captured;
/** Return the visibility attribute */
let get_access pdesc => pdesc.attributes.access;
let get_nodes pdesc => pdesc.nodes;
let get_proc_name pdesc => pdesc.attributes.proc_name;
/** Return the return type of the procedure */
let get_ret_type pdesc => pdesc.attributes.ret_type;
let get_ret_var pdesc => Pvar.mk Ident.name_return (get_proc_name pdesc);
let get_start_node pdesc => pdesc.start_node;
/** List of nodes in the procedure sliced by a predicate up to the first branching */
let get_sliced_slope pdesc f =>
Node.get_generated_slope (get_start_node pdesc) (fun n => Node.get_sliced_succs n f);
/** List of nodes in the procedure up to the first branching */
let get_slope pdesc => Node.get_generated_slope (get_start_node pdesc) Node.get_succs;
/** Return [true] iff the procedure is defined, and not just declared */
let is_defined pdesc => pdesc.attributes.is_defined;
let is_java_synchronized pdesc => pdesc.attributes.is_java_synchronized_method;
let iter_nodes f pdesc => IList.iter f (IList.rev (get_nodes pdesc));
let fold_calls f acc pdesc => {
let do_node a node =>
IList.fold_left
(fun b callee_pname => f b (callee_pname, Node.get_loc node)) a (Node.get_callees node);
IList.fold_left do_node acc (get_nodes pdesc)
};
/** iterate over the calls from the procedure: (callee,location) pairs */
let iter_calls f pdesc => fold_calls (fun _ call => f call) () pdesc;
let iter_instrs f pdesc => {
let do_node node => IList.iter (fun i => f node i) (Node.get_instrs node);
iter_nodes do_node pdesc
};
let fold_nodes f acc pdesc => IList.fold_left f acc (IList.rev (get_nodes pdesc));
let fold_instrs f acc pdesc => {
let fold_node acc node =>
IList.fold_left (fun acc instr => f acc node instr) acc (Node.get_instrs node);
fold_nodes fold_node acc pdesc
};
let iter_slope f pdesc => {
let visited = ref NodeSet.empty;
let rec do_node node => {
visited := NodeSet.add node !visited;
f node;
switch (Node.get_succs node) {
| [n] =>
if (not (NodeSet.mem n !visited)) {
do_node n
}
| _ => ()
}
};
do_node (get_start_node pdesc)
};
let iter_slope_calls f pdesc => {
let do_node node => IList.iter (fun callee_pname => f callee_pname) (Node.get_callees node);
iter_slope do_node pdesc
};
/** iterate between two nodes or until we reach a branching structure */
let iter_slope_range f src_node dst_node => {
let visited = ref NodeSet.empty;
let rec do_node node => {
visited := NodeSet.add node !visited;
f node;
switch (Node.get_succs node) {
| [n] =>
if (not (NodeSet.mem n !visited) && not (Node.equal node dst_node)) {
do_node n
}
| _ => ()
}
};
do_node src_node
};
/** Set the exit node of the proc desc */
let set_exit_node pdesc node => pdesc.exit_node = node;
/** Set a flag for the proc desc */
let set_flag pdesc key value => proc_flags_add pdesc.attributes.proc_flags key value;
/** Set the start node of the proc desc */
let set_start_node pdesc node => pdesc.start_node = node;
/** Append the locals to the list of local variables */
let append_locals pdesc new_locals =>
pdesc.attributes.locals = pdesc.attributes.locals @ new_locals;
/** Set the successor nodes and exception nodes, and build predecessor links */
let set_succs_exn_base (node: Node.t) succs exn => {
node.succs = succs;
node.exn = exn;
IList.iter (fun (n: Node.t) => n.preds = [node, ...n.preds]) succs
};
/** Create a new cfg node */
let create_node pdesc loc kind instrs => {
pdesc.nodes_num = pdesc.nodes_num + 1;
let node_id = pdesc.nodes_num;
let node = {
Node.id: node_id,
dist_exit: None,
instrs,
kind,
loc,
preds: [],
pname: Some pdesc.attributes.proc_name,
succs: [],
exn: []
};
pdesc.nodes = [node, ...pdesc.nodes];
node
};
/** Set the successor and exception nodes.
If this is a join node right before the exit node, add an extra node in the middle,
otherwise nullify and abstract instructions cannot be added after a conditional. */
let node_set_succs_exn pdesc (node: Node.t) succs exn =>
switch (node.kind, succs) {
| (Join_node, [{Node.kind: Exit_node _} as exit_node]) =>
let kind = Node.Stmt_node "between_join_and_exit";
let node' = create_node pdesc node.loc kind node.instrs;
set_succs_exn_base node [node'] exn;
set_succs_exn_base node' [exit_node] exn
| _ => set_succs_exn_base node succs exn
};

281
infer/src/IR/Procdesc.rei
Unescape View File

@ -0,0 +1,281 @@
/*
* vim: set ft=rust:
* vim: set ft=reason:
*
* Copyright (c) 2009 - 2013 Monoidics ltd.
* Copyright (c) 2013 - 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! Utils;
/** node of the control flow graph */
let module Node: {
/** type of nodes */
type t;
/** node id */
type id = private int;
/** kind of cfg node */
type nodekind =
| Start_node Procname.t
| Exit_node Procname.t
| Stmt_node string
| Join_node
| Prune_node bool Sil.if_kind string /** (true/false branch, if_kind, comment) */
| Skip_node string;
/** kind of Stmt_node for an exception handler. */
let exn_handler_kind: nodekind;
/** kind of Stmt_node for an exceptions sink. */
let exn_sink_kind: nodekind;
/** kind of Stmt_node for a throw instruction. */
let throw_kind: nodekind;
/** Add declarations for local variables and return variable to the node */
let add_locals_ret_declaration: t => ProcAttributes.t => list (Mangled.t, Typ.t) => unit;
/** Append the instructions to the list of instructions to execute */
let append_instrs: t => list Sil.instr => unit;
/** Compare two nodes */
let compare: t => t => int;
/** Dump extended instructions for the node */
let d_instrs: sub_instrs::bool => option Sil.instr => t => unit;
/** Create a dummy node */
let dummy: unit => t;
/** Check if two nodes are equal */
let equal: t => t => bool;
/** Get the list of callee procnames from the node */
let get_callees: t => list Procname.t;
/** Return a description of the node */
let get_description: printenv => t => string;
/** Get the distance to the exit node, if it has been computed */
let get_distance_to_exit: t => option int;
/** Get the exception nodes from the current node */
let get_exn: t => list t;
/** Get a list of unique nodes until the first branch starting
from a node with subsequent applications of a generator function */
let get_generated_slope: t => (t => list t) => list t;
/** Get the unique id of the node */
let get_id: t => id;
/** Get the instructions to be executed */
let get_instrs: t => list Sil.instr;
/** Get the kind of the current node */
let get_kind: t => nodekind;
/** Get the source location of the last instruction in the node */
let get_last_loc: t => Location.t;
/** Get the source location of the node */
let get_loc: t => Location.t;
/** Get the predecessor nodes of the current node */
let get_preds: t => list t;
/** Get the name of the procedure the node belongs to */
let get_proc_name: t => Procname.t;
/** Get the predecessor nodes of a node where the given predicate evaluates to true */
let get_sliced_preds: t => (t => bool) => list t;
/** Get the successor nodes of a node where the given predicate evaluates to true */
let get_sliced_succs: t => (t => bool) => list t;
/** Get the successor nodes of the current node */
let get_succs: t => list t;
/** Hash function for nodes */
let hash: t => int;
/** compare node ids */
let id_compare: id => id => int;
/** Comparison for node kind */
let kind_compare: nodekind => nodekind => int;
/** Pretty print the node */
let pp: Format.formatter => t => unit;
/** Pretty print a node id */
let pp_id: Format.formatter => id => unit;
/** Print extended instructions for the node,
highlighting the given subinstruction if present */
let pp_instrs: printenv => sub_instrs::bool => option Sil.instr => Format.formatter => t => unit;
/** Replace the instructions to be executed. */
let replace_instrs: t => list Sil.instr => unit;
};
/** Map with node id keys. */
let module IdMap: Map.S with type key = Node.id;
/** Hash table with nodes as keys. */
let module NodeHash: Hashtbl.S with type key = Node.t;
/** Map over nodes. */
let module NodeMap: Map.S with type key = Node.t;
/** Set of nodes. */
let module NodeSet: Set.S with type elt = Node.t;
/** procedure descriptions */
/** proc description */
type t;
/** append a list of new local variables to the existing list of local variables */
let append_locals: t => list (Mangled.t, Typ.t) => unit;
/** Compute the distance of each node to the exit node, if not computed already */
let compute_distance_to_exit_node: t => unit;
/** Create a new cfg node with the given location, kind, list of instructions,
and add it to the procdesc. */
let create_node: t => Location.t => Node.nodekind => list Sil.instr => Node.t;
/** true if we ran the preanalysis on the CFG associated with [t] */
let did_preanalysis: t => bool;
/** fold over the calls from the procedure: (callee, location) pairs */
let fold_calls: ('a => (Procname.t, Location.t) => 'a) => 'a => t => 'a;
/** fold over all nodes and their instructions */
let fold_instrs: ('a => Node.t => Sil.instr => 'a) => 'a => t => 'a;
/** Only call from Cfg. */
let from_proc_attributes: called_from_cfg::bool => ProcAttributes.t => t;
/** Return the visibility attribute */
let get_access: t => PredSymb.access;
/** Get the attributes of the procedure. */
let get_attributes: t => ProcAttributes.t;
/** Return name and type of block's captured variables */
let get_captured: t => list (Mangled.t, Typ.t);
let get_err_log: t => Errlog.t;
let get_exit_node: t => Node.t;
/** Get flags for the proc desc */
let get_flags: t => proc_flags;
/** Return name and type of formal parameters */
let get_formals: t => list (Mangled.t, Typ.t);
/** Return loc information for the procedure */
let get_loc: t => Location.t;
/** Return name and type of local variables */
let get_locals: t => list (Mangled.t, Typ.t);
let get_nodes: t => list Node.t;
let get_proc_name: t => Procname.t;
/** Return the return type of the procedure and type string */
let get_ret_type: t => Typ.t;
let get_ret_var: t => Pvar.t;
/** Get the sliced procedure's nodes up until the first branching */
let get_sliced_slope: t => (Node.t => bool) => list Node.t;
/** Get the procedure's nodes up until the first branching */
let get_slope: t => list Node.t;
let get_start_node: t => Node.t;
/** Return [true] iff the procedure is defined, and not just declared */
let is_defined: t => bool;
/** Return [true] if the procedure signature has the Java synchronized keyword */
let is_java_synchronized: t => bool;
/** iterate over the calls from the procedure: (callee, location) pairs */
let iter_calls: ((Procname.t, Location.t) => unit) => t => unit;
/** iterate over all nodes and their instructions */
let iter_instrs: (Node.t => Sil.instr => unit) => t => unit;
/** iterate over all the nodes of a procedure */
let iter_nodes: (Node.t => unit) => t => unit;
/** iterate over all nodes until we reach a branching structure */
let iter_slope: (Node.t => unit) => t => unit;
/** iterate over all calls until we reach a branching structure */
let iter_slope_calls: (Procname.t => unit) => t => unit;
/** iterate between two nodes or until we reach a branching structure */
let iter_slope_range: (Node.t => unit) => Node.t => Node.t => unit;
/** Set the successor nodes and exception nodes, and build predecessor links */
let node_set_succs_exn: t => Node.t => list Node.t => list Node.t => unit;
/** Set the exit node of the procedure */
let set_exit_node: t => Node.t => unit;
/** Set a flag for the proc desc */
let set_flag: t => string => string => unit;
let set_start_node: t => Node.t => unit;
/** indicate that we have performed preanalysis on the CFG assoociated with [t] */
let signal_did_preanalysis: t => unit;

50
infer/src/backend/BuiltinDefn.ml
Unescape View File

@ -60,7 +60,7 @@ let return_result tenv e prop ret_id =
(* Return the new prop and the array length *)
(* Return None if it fails to add the array *)
let add_array_to_prop tenv pdesc prop_ lexp typ =
let pname = Cfg.Procdesc.get_proc_name pdesc in
let pname = Procdesc.get_proc_name pdesc in
let n_lexp, prop = check_arith_norm_exp tenv pname lexp prop_ in
begin
try
@ -112,7 +112,7 @@ let execute___set_array_length { Builtin.tenv; pdesc; prop_; path; ret_id; args;
(match add_array_to_prop tenv pdesc prop_ lexp typ with
| None -> []
| Some (_, prop_a) -> (* Invariant: prop_a has an array pointed to by lexp *)
let pname = Cfg.Procdesc.get_proc_name pdesc in
let pname = Procdesc.get_proc_name pdesc in
let n_lexp, prop__ = check_arith_norm_exp tenv pname lexp prop_a in
let n_len, prop = check_arith_norm_exp tenv pname len prop__ in
let hpred, sigma' = IList.partition (function
@ -129,7 +129,7 @@ let execute___set_array_length { Builtin.tenv; pdesc; prop_; path; ret_id; args;
let execute___print_value { Builtin.tenv; pdesc; prop_; path; args; }
: Builtin.ret_typ =
L.err "__print_value: ";
let pname = Cfg.Procdesc.get_proc_name pdesc in
let pname = Procdesc.get_proc_name pdesc in
let do_arg (lexp, _) =
let n_lexp, _ = check_arith_norm_exp tenv pname lexp prop_ in
L.err "%a " Exp.pp n_lexp in
@ -194,7 +194,7 @@ let execute___get_type_of { Builtin.pdesc; tenv; prop_; path; ret_id; args; }
: Builtin.ret_typ =
match args with
| [(lexp, typ)] ->
let pname = Cfg.Procdesc.get_proc_name pdesc in
let pname = Procdesc.get_proc_name pdesc in
let n_lexp, prop = check_arith_norm_exp tenv pname lexp prop_ in
let props = create_type tenv n_lexp typ prop in
let aux prop =
@ -233,7 +233,7 @@ let execute___instanceof_cast ~instof
: Builtin.ret_typ =
match args with
| [(val1_, typ1); (texp2_, _)] ->
let pname = Cfg.Procdesc.get_proc_name pdesc in
let pname = Procdesc.get_proc_name pdesc in
let val1, prop__ = check_arith_norm_exp tenv pname val1_ prop_ in
let texp2, prop = check_arith_norm_exp tenv pname texp2_ prop__ in
let is_cast_to_reference =
@ -332,7 +332,7 @@ let execute___set_file_attribute { Builtin.tenv; pdesc; prop_; path; ret_id; arg
: Builtin.ret_typ =
match args, ret_id with
| [(lexp, _)], _ ->
let pname = Cfg.Procdesc.get_proc_name pdesc in
let pname = Procdesc.get_proc_name pdesc in
let n_lexp, prop = check_arith_norm_exp tenv pname lexp prop_ in
set_resource_attribute tenv prop path n_lexp loc PredSymb.Rfile
| _ -> raise (Exceptions.Wrong_argument_number __POS__)
@ -342,7 +342,7 @@ let execute___set_lock_attribute { Builtin.tenv; pdesc; prop_; path; ret_id; arg
: Builtin.ret_typ =
match args, ret_id with
| [(lexp, _)], _ ->
let pname = Cfg.Procdesc.get_proc_name pdesc in
let pname = Procdesc.get_proc_name pdesc in
let n_lexp, prop = check_arith_norm_exp tenv pname lexp prop_ in
set_resource_attribute tenv prop path n_lexp loc PredSymb.Rlock
| _ -> raise (Exceptions.Wrong_argument_number __POS__)
@ -353,7 +353,7 @@ let execute___method_set_ignore_attribute { Builtin.tenv; pdesc; prop_; path; re
: Builtin.ret_typ =
match args, ret_id with
| [_ ; (lexp, _)], _ ->
let pname = Cfg.Procdesc.get_proc_name pdesc in
let pname = Procdesc.get_proc_name pdesc in
let n_lexp, prop = check_arith_norm_exp tenv pname lexp prop_ in
set_resource_attribute tenv prop path n_lexp loc PredSymb.Rignore
| _ -> raise (Exceptions.Wrong_argument_number __POS__)
@ -363,7 +363,7 @@ let execute___set_mem_attribute { Builtin.tenv; pdesc; prop_; path; ret_id; args
: Builtin.ret_typ =
match args, ret_id with
| [(lexp, _)], _ ->
let pname = Cfg.Procdesc.get_proc_name pdesc in
let pname = Procdesc.get_proc_name pdesc in
let n_lexp, prop = check_arith_norm_exp tenv pname lexp prop_ in
set_resource_attribute tenv prop path n_lexp loc (PredSymb.Rmemory PredSymb.Mnew)
| _ -> raise (Exceptions.Wrong_argument_number __POS__)
@ -374,7 +374,7 @@ let execute___check_untainted
: Builtin.ret_typ =
match args, ret_id with
| [(lexp, _)], _ ->
let caller_pname = Cfg.Procdesc.get_proc_name pdesc in
let caller_pname = Procdesc.get_proc_name pdesc in
let n_lexp, prop = check_arith_norm_exp tenv caller_pname lexp prop_ in
[(check_untainted tenv n_lexp PredSymb.Tk_unknown caller_pname callee_pname prop, path)]
| _ -> raise (Exceptions.Wrong_argument_number __POS__)
@ -384,7 +384,7 @@ let execute___get_hidden_field { Builtin.tenv; pdesc; prop_; path; ret_id; args;
: Builtin.ret_typ =
match args with
| [(lexp, _)] ->
let pname = Cfg.Procdesc.get_proc_name pdesc in
let pname = Procdesc.get_proc_name pdesc in
let n_lexp, prop = check_arith_norm_exp tenv pname lexp prop_ in
let ret_val = ref None in
let return_val p = match !ret_val with
@ -423,7 +423,7 @@ let execute___set_hidden_field { Builtin.tenv; pdesc; prop_; path; args; }
: Builtin.ret_typ =
match args with
| [(lexp1, _); (lexp2, _)] ->
let pname = Cfg.Procdesc.get_proc_name pdesc in
let pname = Procdesc.get_proc_name pdesc in
let n_lexp1, prop__ = check_arith_norm_exp tenv pname lexp1 prop_ in
let n_lexp2, prop = check_arith_norm_exp tenv pname lexp2 prop__ in
let foot_var = lazy (Exp.Var (Ident.create_fresh Ident.kfootprint)) in
@ -531,7 +531,7 @@ let execute___set_autorelease_attribute
: Builtin.ret_typ =
match args, ret_id with
| [(lexp, _)], _ ->
let pname = Cfg.Procdesc.get_proc_name pdesc in
let pname = Procdesc.get_proc_name pdesc in
let prop = return_result tenv lexp prop_ ret_id in
if Config.objc_memory_model_on then
let n_lexp, prop = check_arith_norm_exp tenv pname lexp prop in
@ -570,12 +570,12 @@ let execute___release_autorelease_pool
else execute___no_op prop_ path
let set_attr tenv pdesc prop path exp attr =
let pname = Cfg.Procdesc.get_proc_name pdesc in
let pname = Procdesc.get_proc_name pdesc in
let n_lexp, prop = check_arith_norm_exp tenv pname exp prop in
[(Attribute.add_or_replace tenv prop (Apred (attr, [n_lexp])), path)]
let delete_attr tenv pdesc prop path exp attr =
let pname = Cfg.Procdesc.get_proc_name pdesc in
let pname = Procdesc.get_proc_name pdesc in
let n_lexp, prop = check_arith_norm_exp tenv pname exp prop in
[(Attribute.remove tenv prop (Apred (attr, [n_lexp])), path)]
@ -604,7 +604,7 @@ let execute___set_locked_attribute builtin_args
let execute___set_unlocked_attribute
({ Builtin.pdesc; loc; } as builtin_args)
: Builtin.ret_typ =
let pname = Cfg.Procdesc.get_proc_name pdesc in
let pname = Procdesc.get_proc_name pdesc in
(* ra_kind = Rrelease in following indicates unlocked *)
let ra = {
PredSymb.ra_kind = PredSymb.Rrelease;
@ -620,7 +620,7 @@ let execute___set_taint_attribute
: Builtin.ret_typ =
match args with
| (exp, _) :: [(Exp.Const (Const.Cstr taint_kind_str), _)] ->
let taint_source = Cfg.Procdesc.get_proc_name pdesc in
let taint_source = Procdesc.get_proc_name pdesc in
let taint_kind = match taint_kind_str with
| "UnverifiedSSLSocket" -> PredSymb.Tk_unverified_SSL_socket
| "SharedPreferenceData" -> PredSymb.Tk_shared_preferences_data
@ -636,7 +636,7 @@ let execute___set_untaint_attribute
: Builtin.ret_typ =
match args with
| (exp, _) :: [] ->
let taint_source = Cfg.Procdesc.get_proc_name pdesc in
let taint_source = Procdesc.get_proc_name pdesc in
let taint_kind = PredSymb.Tk_unknown in (* TODO: change builtin to specify taint kind *)
set_attr tenv pdesc prop_ path exp (PredSymb.Auntaint { PredSymb.taint_source; taint_kind})
| _ ->
@ -646,7 +646,7 @@ let execute___objc_cast { Builtin.tenv; pdesc; prop_; path; ret_id; args; }
: Builtin.ret_typ =
match args with
| [(val1_, _); (texp2_, _)] ->
let pname = Cfg.Procdesc.get_proc_name pdesc in
let pname = Procdesc.get_proc_name pdesc in
let val1, prop__ = check_arith_norm_exp tenv pname val1_ prop_ in
let texp2, prop = check_arith_norm_exp tenv pname texp2_ prop__ in
(try
@ -717,7 +717,7 @@ let execute_free mk { Builtin.pdesc; instr; tenv; prop_; path; args; loc; }
match args with
| [(lexp, typ)] ->
begin
let pname = Cfg.Procdesc.get_proc_name pdesc in
let pname = Procdesc.get_proc_name pdesc in
let n_lexp, prop = check_arith_norm_exp tenv pname lexp prop_ in
let prop_nonzero = (* case n_lexp!=0 *)
Propset.to_proplist (prune tenv ~positive:true n_lexp prop) in
@ -735,7 +735,7 @@ let execute_free mk { Builtin.pdesc; instr; tenv; prop_; path; args; loc; }
let execute_alloc mk can_return_null
{ Builtin.pdesc; tenv; prop_; path; ret_id; args; loc; }
: Builtin.ret_typ =
let pname = Cfg.Procdesc.get_proc_name pdesc in
let pname = Procdesc.get_proc_name pdesc in
let rec evaluate_char_sizeof e = match e with
| Exp.Var _ -> e
| Exp.UnOp (uop, e', typ) ->
@ -798,7 +798,7 @@ let execute___cxx_typeid ({ Builtin.pdesc; tenv; prop_; args; loc} as r)
(let res = execute_alloc PredSymb.Mnew false { r with args = [type_info_exp] } in
match rest with
| [(field_exp, _); (lexp, typ)] ->
let pname = Cfg.Procdesc.get_proc_name pdesc in
let pname = Procdesc.get_proc_name pdesc in
let n_lexp, prop = check_arith_norm_exp tenv pname lexp prop_ in
let typ =
try
@ -861,7 +861,7 @@ let execute__unwrap_exception { Builtin.tenv; pdesc; prop_; path; ret_id; args;
match args with
| [(ret_exn, _)] ->
begin
let pname = Cfg.Procdesc.get_proc_name pdesc in
let pname = Procdesc.get_proc_name pdesc in
let n_ret_exn, prop = check_arith_norm_exp tenv pname ret_exn prop_ in
match n_ret_exn with
| Exp.Exn exp ->
@ -875,7 +875,7 @@ let execute_return_first_argument { Builtin.tenv; pdesc; prop_; path; ret_id; ar
: Builtin.ret_typ =
match args with
| (arg1_, _):: _ ->
let pname = Cfg.Procdesc.get_proc_name pdesc in
let pname = Procdesc.get_proc_name pdesc in
let arg1, prop = check_arith_norm_exp tenv pname arg1_ prop_ in
let prop' = return_result tenv arg1 prop ret_id in
[(prop', path)]
@ -885,7 +885,7 @@ let execute___split_get_nth { Builtin.tenv; pdesc; prop_; path; ret_id; args; }
: Builtin.ret_typ =
match args with
| [(lexp1, _); (lexp2, _); (lexp3, _)] ->
let pname = Cfg.Procdesc.get_proc_name pdesc in
let pname = Procdesc.get_proc_name pdesc in
let n_lexp1, prop__ = check_arith_norm_exp tenv pname lexp1 prop_ in
let n_lexp2, prop___ = check_arith_norm_exp tenv pname lexp2 prop__ in
let n_lexp3, prop = check_arith_norm_exp tenv pname lexp3 prop___ in

27
infer/src/backend/PropUtil.re
Unescape View File

@ -8,12 +8,11 @@
*/
open! Utils;
let get_name_of_local (curr_f: Cfg.Procdesc.t) (x, _) =>
Pvar.mk x (Cfg.Procdesc.get_proc_name curr_f);
let get_name_of_local (curr_f: Procdesc.t) (x, _) => Pvar.mk x (Procdesc.get_proc_name curr_f);
/* returns a list of local static variables (ie local variables defined static) in a proposition */
let get_name_of_objc_static_locals (curr_f: Cfg.Procdesc.t) p => {
let pname = Procname.to_string (Cfg.Procdesc.get_proc_name curr_f);
let get_name_of_objc_static_locals (curr_f: Procdesc.t) p => {
let pname = Procname.to_string (Procdesc.get_proc_name curr_f);
let local_static e =>
switch e {
/* is a local static if it's a global and it has a static local name */
@ -143,8 +142,8 @@ let remove_abduced_retvars tenv p => {
Prop.normalize tenv (Prop.set p' pi::pi_reach sigma::sigma_reach)
};
let remove_locals tenv (curr_f: Cfg.Procdesc.t) p => {
let names_of_locals = IList.map (get_name_of_local curr_f) (Cfg.Procdesc.get_locals curr_f);
let remove_locals tenv (curr_f: Procdesc.t) p => {
let names_of_locals = IList.map (get_name_of_local curr_f) (Procdesc.get_locals curr_f);
let names_of_locals' =
switch !Config.curr_language {
| Config.Clang =>
@ -165,31 +164,31 @@ let remove_locals tenv (curr_f: Cfg.Procdesc.t) p => {
)
};
let remove_formals tenv (curr_f: Cfg.Procdesc.t) p => {
let pname = Cfg.Procdesc.get_proc_name curr_f;
let formal_vars = IList.map (fun (n, _) => Pvar.mk n pname) (Cfg.Procdesc.get_formals curr_f);
let remove_formals tenv (curr_f: Procdesc.t) p => {
let pname = Procdesc.get_proc_name curr_f;
let formal_vars = IList.map (fun (n, _) => Pvar.mk n pname) (Procdesc.get_formals curr_f);
Attribute.deallocate_stack_vars tenv p formal_vars
};
/** remove the return variable from the prop */
let remove_ret tenv (curr_f: Cfg.Procdesc.t) (p: Prop.t Prop.normal) => {
let pname = Cfg.Procdesc.get_proc_name curr_f;
let name_of_ret = Cfg.Procdesc.get_ret_var curr_f;
let remove_ret tenv (curr_f: Procdesc.t) (p: Prop.t Prop.normal) => {
let pname = Procdesc.get_proc_name curr_f;
let name_of_ret = Procdesc.get_ret_var curr_f;
let (_, p') = Attribute.deallocate_stack_vars tenv p [Pvar.to_callee pname name_of_ret];
p'
};
/** remove locals and return variable from the prop */
let remove_locals_ret tenv (curr_f: Cfg.Procdesc.t) p => snd (
let remove_locals_ret tenv (curr_f: Procdesc.t) p => snd (
remove_locals tenv curr_f (remove_ret tenv curr_f p)
);
/** Remove locals and formal parameters from the prop.
Return the list of stack variables whose address was still present after deallocation. */
let remove_locals_formals tenv (curr_f: Cfg.Procdesc.t) p => {
let remove_locals_formals tenv (curr_f: Procdesc.t) p => {
let (pvars1, p1) = remove_formals tenv curr_f p;
let (pvars2, p2) = remove_locals tenv curr_f p1;
(pvars1 @ pvars2, p2)

6
infer/src/backend/PropUtil.rei
Unescape View File

@ -10,17 +10,17 @@ open! Utils;
/** remove the return variable from the prop */
let remove_ret: Tenv.t => Cfg.Procdesc.t => Prop.t Prop.normal => Prop.t Prop.normal;
let remove_ret: Tenv.t => Procdesc.t => Prop.t Prop.normal => Prop.t Prop.normal;
/** remove locals and return variable from the prop */
let remove_locals_ret: Tenv.t => Cfg.Procdesc.t => Prop.t Prop.normal => Prop.t Prop.normal;
let remove_locals_ret: Tenv.t => Procdesc.t => Prop.t Prop.normal => Prop.t Prop.normal;
/** Deallocate the stack variables in [pvars], and replace them by normal variables.
Return the list of stack variables whose address was still present after deallocation. */
let remove_locals_formals:
Tenv.t => Cfg.Procdesc.t => Prop.t Prop.normal => (list Pvar.t, Prop.t Prop.normal);
Tenv.t => Procdesc.t => Prop.t Prop.normal => (list Pvar.t, Prop.t Prop.normal);
/** remove seed vars from a prop */

16
infer/src/backend/buckets.ml
Unescape View File

@ -27,18 +27,18 @@ let check_nested_loop path pos_opt =
if verbose then L.d_strln "in nested loop";
true (* last two loop visits were entering loops *)
| _ -> false in
let do_node_caller node = match Cfg.Node.get_kind node with
| Cfg.Node.Prune_node (b, (Sil.Ik_dowhile | Sil.Ik_for | Sil.Ik_while), _) ->
let do_node_caller node = match Procdesc.Node.get_kind node with
| Procdesc.Node.Prune_node (b, (Sil.Ik_dowhile | Sil.Ik_for | Sil.Ik_while), _) ->
(* if verbose then *)
(* L.d_strln ((if b then "enter" else "exit") ^ " node " *)
(* ^ (string_of_int (Cfg.Node.get_id node))); *)
(* ^ (string_of_int (Procdesc.Node.get_id node))); *)
loop_visits_log := b :: !loop_visits_log
| _ -> () in
let do_any_node _level _node =
incr trace_length;
(* L.d_strln *)
(* ("level " ^ string_of_int _level ^ *)
(* " (Cfg.Node.get_id node) " ^ string_of_int (Cfg.Node.get_id _node)) *)
(* " (Procdesc.Node.get_id node) " ^ string_of_int (Procdesc.Node.get_id _node)) *)
in
let f level p _ _ = match Paths.Path.curr_node p with
| Some node ->
@ -54,11 +54,11 @@ let check_nested_loop path pos_opt =
let check_access access_opt de_opt =
let find_bucket line_number null_case_flag =
let find_formal_ids node = (* find ids obtained by a letref on a formal parameter *)
let node_instrs = Cfg.Node.get_instrs node in
let node_instrs = Procdesc.Node.get_instrs node in
let formals = match State.get_prop_tenv_pdesc () with
| None -> []
| Some (_, _, pdesc) ->
Cfg.Procdesc.get_formals pdesc in
Procdesc.get_formals pdesc in
let formal_names = IList.map fst formals in
let is_formal pvar =
let name = Pvar.get_name pvar in
@ -97,10 +97,10 @@ let check_access access_opt de_opt =
| Sil.Store (_, _, e, _) ->
exp_is_null e
| _ -> false in
IList.exists filter (Cfg.Node.get_instrs node) in
IList.exists filter (Procdesc.Node.get_instrs node) in
let local_access_found = ref false in
let do_node node =
if (Cfg.Node.get_loc node).Location.line = line_number && has_call_or_sets_null node then
if (Procdesc.Node.get_loc node).Location.line = line_number && has_call_or_sets_null node then
begin
local_access_found := true
end in

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

@ -12,7 +12,7 @@ open! Utils
(** Module for builtin functions with their symbolic execution handler *)
type args = {
pdesc : Cfg.Procdesc.t;
pdesc : Procdesc.t;
instr : Sil.instr;
tenv : Tenv.t;
prop_ : Prop.normal Prop.t;

2
infer/src/backend/builtin.mli
Unescape View File

@ -12,7 +12,7 @@ open! Utils
(** Module for builtin functions with their symbolic execution handler *)
type args = {
pdesc : Cfg.Procdesc.t;
pdesc : Procdesc.t;
instr : Sil.instr;
tenv : Tenv.t;
prop_ : Prop.normal Prop.t;

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

@ -14,12 +14,12 @@ module L = Logging
(** Module to register and invoke callbacks *)
type proc_callback_args = {
get_proc_desc : Procname.t -> Cfg.Procdesc.t option;
get_proc_desc : Procname.t -> Procdesc.t option;
get_procs_in_file : Procname.t -> Procname.t list;
idenv : Idenv.t;
tenv : Tenv.t;
proc_name : Procname.t;
proc_desc : Cfg.Procdesc.t;
proc_desc : Procdesc.t;
}
type proc_callback_t = proc_callback_args -> unit
@ -27,8 +27,8 @@ type proc_callback_t = proc_callback_args -> unit
type cluster_callback_t =
Exe_env.t ->
Procname.t list ->
(Procname.t -> Cfg.Procdesc.t option) ->
(Idenv.t * Tenv.t * Procname.t * Cfg.Procdesc.t) list ->
(Procname.t -> Procdesc.t option) ->
(Idenv.t * Tenv.t * Procname.t * Procdesc.t) list ->
unit
let procedure_callbacks = ref []
@ -51,7 +51,7 @@ let get_procedure_definition exe_env proc_name =
Option.map
(fun proc_desc ->
let idenv = Idenv.create proc_desc
and language = (Cfg.Procdesc.get_attributes proc_desc).ProcAttributes.language in
and language = (Procdesc.get_attributes proc_desc).ProcAttributes.language in
(idenv, tenv, proc_name, proc_desc, language))
(Exe_env.get_proc_desc exe_env proc_name)
@ -68,7 +68,7 @@ let iterate_procedure_callbacks exe_env caller_pname =
let get_procs_in_file proc_name =
match Exe_env.get_cfg exe_env proc_name with
| Some cfg->
IList.map Cfg.Procdesc.get_proc_name (Cfg.get_defined_procs cfg)
IList.map Procdesc.get_proc_name (Cfg.get_defined_procs cfg)
| None ->
[] in

8
infer/src/backend/callbacks.mli
Unescape View File

@ -12,12 +12,12 @@ open! Utils
(** Module to register and invoke callbacks *)
type proc_callback_args = {
get_proc_desc : Procname.t -> Cfg.Procdesc.t option;
get_proc_desc : Procname.t -> Procdesc.t option;
get_procs_in_file : Procname.t -> Procname.t list;
idenv : Idenv.t;
tenv : Tenv.t;
proc_name : Procname.t;
proc_desc : Cfg.Procdesc.t;
proc_desc : Procdesc.t;
}
(** Type of a procedure callback:
@ -31,8 +31,8 @@ type proc_callback_t = proc_callback_args -> unit
type cluster_callback_t =
Exe_env.t ->
Procname.t list ->
(Procname.t -> Cfg.Procdesc.t option) ->
(Idenv.t * Tenv.t * Procname.t * Cfg.Procdesc.t) list ->
(Procname.t -> Procdesc.t option) ->
(Idenv.t * Tenv.t * Procname.t * Procdesc.t) list ->
unit
(** register a procedure callback *)

62
infer/src/backend/dotty.ml
Unescape View File

@ -936,8 +936,8 @@ let pp_proplist_parsed2dotty_file filename plist =
(********** Print control flow graph (in dot form) for fundec to *)
(* channel. You have to compute an interprocedural cfg first *)
let pp_cfgnodename pname fmt (n : Cfg.Node.t) =
F.fprintf fmt "\"%s_%d\"" (Procname.to_filename pname) (Cfg.Node.get_id n :> int)
let pp_cfgnodename pname fmt (n : Procdesc.Node.t) =
F.fprintf fmt "\"%s_%d\"" (Procname.to_filename pname) (Procdesc.Node.get_id n :> int)
let pp_etlist fmt etl =
IList.iter (fun (id, ty) ->
@ -947,60 +947,62 @@ let pp_local_list fmt etl =
IList.iter (fun (id, ty) ->
Format.fprintf fmt " %a:%a" Mangled.pp id (Typ.pp_full pe_text) ty) etl
let pp_cfgnodelabel pdesc fmt (n : Cfg.Node.t) =
let pp_cfgnodelabel pdesc fmt (n : Procdesc.Node.t) =
let pp_label fmt n =
match Cfg.Node.get_kind n with
| Cfg.Node.Start_node pname ->
match Procdesc.Node.get_kind n with
| Procdesc.Node.Start_node pname ->
Format.fprintf fmt "Start %s\\nFormals: %a\\nLocals: %a"
(Procname.to_string pname)
pp_etlist (Cfg.Procdesc.get_formals pdesc)
pp_local_list (Cfg.Procdesc.get_locals pdesc);
if IList.length (Cfg.Procdesc.get_captured pdesc) <> 0 then
pp_etlist (Procdesc.get_formals pdesc)
pp_local_list (Procdesc.get_locals pdesc);
if IList.length (Procdesc.get_captured pdesc) <> 0 then
Format.fprintf fmt "\\nCaptured: %a"
pp_local_list (Cfg.Procdesc.get_captured pdesc)
| Cfg.Node.Exit_node pname ->
pp_local_list (Procdesc.get_captured pdesc)
| Procdesc.Node.Exit_node pname ->
Format.fprintf fmt "Exit %s" (Procname.to_string pname)
| Cfg.Node.Join_node ->
| Procdesc.Node.Join_node ->
Format.fprintf fmt "+"
| Cfg.Node.Prune_node (is_true_branch, _, _) ->
| Procdesc.Node.Prune_node (is_true_branch, _, _) ->
Format.fprintf fmt "Prune (%b branch)" is_true_branch
| Cfg.Node.Stmt_node s -> Format.fprintf fmt " %s" s
| Cfg.Node.Skip_node s -> Format.fprintf fmt "Skip %s" s in
| Procdesc.Node.Stmt_node s -> Format.fprintf fmt " %s" s
| Procdesc.Node.Skip_node s -> Format.fprintf fmt "Skip %s" s in
let instr_string i =
let pp f () = Sil.pp_instr pe_text f i in
let str = pp_to_string pp () in
Escape.escape_dotty str in
let pp_instrs fmt instrs =
IList.iter (fun i -> F.fprintf fmt " %s\\n " (instr_string i)) instrs in
let instrs = Cfg.Node.get_instrs n in
F.fprintf fmt "%d: %a \\n %a" (Cfg.Node.get_id n :> int) pp_label n pp_instrs instrs
let pp_cfgnodeshape fmt (n: Cfg.Node.t) =
match Cfg.Node.get_kind n with
| Cfg.Node.Start_node _ | Cfg.Node.Exit_node _ -> F.fprintf fmt "color=yellow style=filled"
| Cfg.Node.Prune_node _ -> F.fprintf fmt "shape=\"invhouse\""
| Cfg.Node.Skip_node _ -> F.fprintf fmt "color=\"gray\""
| Cfg.Node.Stmt_node _ -> F.fprintf fmt "shape=\"box\""
let instrs = Procdesc.Node.get_instrs n in
F.fprintf fmt "%d: %a \\n %a" (Procdesc.Node.get_id n :> int) pp_label n pp_instrs instrs
let pp_cfgnodeshape fmt (n: Procdesc.Node.t) =
match Procdesc.Node.get_kind n with
| Procdesc.Node.Start_node _
| Procdesc.Node.Exit_node _ -> F.fprintf fmt "color=yellow style=filled"
| Procdesc.Node.Prune_node _ -> F.fprintf fmt "shape=\"invhouse\""
| Procdesc.Node.Skip_node _ -> F.fprintf fmt "color=\"gray\""
| Procdesc.Node.Stmt_node _ -> F.fprintf fmt "shape=\"box\""
| _ -> F.fprintf fmt ""
let pp_cfgnode pdesc fmt (n: Cfg.Node.t) =
let pname = Cfg.Procdesc.get_proc_name pdesc in
let pp_cfgnode pdesc fmt (n: Procdesc.Node.t) =
let pname = Procdesc.get_proc_name pdesc in
F.fprintf fmt "%a [label=\"%a\" %a]\n\t\n"
(pp_cfgnodename pname) n
(pp_cfgnodelabel pdesc) n
pp_cfgnodeshape n;
let print_edge n1 n2 is_exn =
let color = if is_exn then "[color=\"red\" ]" else "" in
match Cfg.Node.get_kind n2 with
| Cfg.Node.Exit_node _ when is_exn = true -> (* don't print exception edges to the exit node *)
match Procdesc.Node.get_kind n2 with
| Procdesc.Node.Exit_node _
when is_exn = true -> (* don't print exception edges to the exit node *)
()
| _ ->
F.fprintf fmt "\n\t %a -> %a %s;"
(pp_cfgnodename pname) n1
(pp_cfgnodename pname) n2
color in
IList.iter (fun n' -> print_edge n n' false) (Cfg.Node.get_succs n);
IList.iter (fun n' -> print_edge n n' true) (Cfg.Node.get_exn n)
IList.iter (fun n' -> print_edge n n' false) (Procdesc.Node.get_succs n);
IList.iter (fun n' -> print_edge n n' true) (Procdesc.Node.get_exn n)
(* * print control flow graph (in dot form) for fundec to channel let *)
(* print_cfg_channel (chan : out_channel) (fd : fundec) = let pnode (s: *)
@ -1014,7 +1016,7 @@ let pp_cfgnode pdesc fmt (n: Cfg.Node.t) =
(* special node, and call / return edges *)
let print_icfg source fmt cfg =
let print_node pdesc node =
let loc = Cfg.Node.get_loc node in
let loc = Procdesc.Node.get_loc node in
if (Config.dotty_cfg_libs || DB.source_file_equal loc.Location.file source) then
F.fprintf fmt "%a\n" (pp_cfgnode pdesc) node in
Cfg.iter_all_nodes print_node cfg

42
infer/src/backend/errdesc.ml
Unescape View File

@ -71,16 +71,16 @@ let explain_deallocate_constant_string s ra =
let verbose = Config.trace_error
let find_in_node_or_preds start_node f_node_instr =
let visited = ref Cfg.NodeSet.empty in
let visited = ref Procdesc.NodeSet.empty in
let rec find node =
if Cfg.NodeSet.mem node !visited then None
if Procdesc.NodeSet.mem node !visited then None
else
begin
visited := Cfg.NodeSet.add node !visited;
let instrs = Cfg.Node.get_instrs node in
visited := Procdesc.NodeSet.add node !visited;
let instrs = Procdesc.Node.get_instrs node in
match IList.find_map_opt (f_node_instr node) (IList.rev instrs) with
| Some res -> Some res
| None -> IList.find_map_opt find (Cfg.Node.get_preds node)
| None -> IList.find_map_opt find (Procdesc.Node.get_preds node)
end in
find start_node
@ -93,7 +93,7 @@ let find_variable_assigment node id : Sil.instr option =
(** Check if a nullify instruction exists for the program variable after the given instruction *)
let find_nullify_after_instr node instr pvar : bool =
let node_instrs = Cfg.Node.get_instrs node in
let node_instrs = Procdesc.Node.get_instrs node in
let found_instr = ref false in
let find_nullify = function
| Sil.Nullify (pv, _) when !found_instr -> Pvar.equal pv pvar
@ -105,11 +105,11 @@ let find_nullify_after_instr node instr pvar : bool =
(** Find the other prune node of a conditional
(e.g. the false branch given the true branch of a conditional) *)
let find_other_prune_node node =
match Cfg.Node.get_preds node with
match Procdesc.Node.get_preds node with
| [n_pre] ->
(match Cfg.Node.get_succs n_pre with
(match Procdesc.Node.get_succs n_pre with
| [n1; n2] ->
if Cfg.Node.equal n1 node then Some n2 else Some n1
if Procdesc.Node.equal n1 node then Some n2 else Some n1
| _ -> None)
| _ -> None
@ -118,13 +118,13 @@ let id_is_assigned_then_dead node id =
match find_variable_assigment node id with
| Some (Sil.Store (Exp.Lvar pvar, _, _, _) as instr)
when Pvar.is_local pvar || Pvar.is_callee pvar ->
let is_prune = match Cfg.Node.get_kind node with
| Cfg.Node.Prune_node _ -> true
let is_prune = match Procdesc.Node.get_kind node with
| Procdesc.Node.Prune_node _ -> true
| _ -> false in
let prune_check = function
(* if prune node, check that it's also nullified in the other branch *)
| Some node' ->
(match Cfg.Node.get_instrs node' with
(match Procdesc.Node.get_instrs node' with
| instr':: _ -> find_nullify_after_instr node' instr' pvar
| _ -> false)
| _ -> false in
@ -135,7 +135,7 @@ let id_is_assigned_then_dead node id =
(** Find the function call instruction used to initialize normal variable [id],
and return the function name and arguments *)
let find_normal_variable_funcall
(node: Cfg.Node.t)
(node: Procdesc.Node.t)
(id: Ident.t): (Exp.t * (Exp.t list) * Location.t * CallFlags.t) option =
let find_declaration _ = function
| Sil.Call (Some (id0, _), fun_exp, args, loc, call_flags) when Ident.equal id id0 ->
@ -148,12 +148,12 @@ let find_normal_variable_funcall
("find_normal_variable_funcall could not find " ^
Ident.to_string id ^
" in node " ^
string_of_int (Cfg.Node.get_id node :> int));
string_of_int (Procdesc.Node.get_id node :> int));
L.d_ln ());
res
(** Find a program variable assignment in the current node or predecessors. *)
let find_program_variable_assignment node pvar : (Cfg.Node.t * Ident.t) option =
let find_program_variable_assignment node pvar : (Procdesc.Node.t * Ident.t) option =
let find_instr node = function
| Sil.Store (Exp.Lvar _pvar, _, Exp.Var id, _)
when Pvar.equal pvar _pvar && Ident.is_normal id ->
@ -184,7 +184,7 @@ let find_struct_by_value_assignment node pvar =
else None
(** Find a program variable assignment to id in the current node or predecessors. *)
let find_ident_assignment node id : (Cfg.Node.t * Exp.t) option =
let find_ident_assignment node id : (Procdesc.Node.t * Exp.t) option =
let find_instr node = function
| Sil.Load (_id, e, _, _) when Ident.equal _id id -> Some (node, e)
| _ -> None in
@ -192,14 +192,14 @@ let find_ident_assignment node id : (Cfg.Node.t * Exp.t) option =
(** Find a boolean assignment to a temporary variable holding a boolean condition.
The boolean parameter indicates whether the true or false branch is required. *)
let rec find_boolean_assignment node pvar true_branch : Cfg.Node.t option =
let rec find_boolean_assignment node pvar true_branch : Procdesc.Node.t option =
let find_instr n =
let filter = function
| Sil.Store (Exp.Lvar _pvar, _, Exp.Const (Const.Cint i), _) when Pvar.equal pvar _pvar ->
IntLit.iszero i <> true_branch
| _ -> false in
IList.exists filter (Cfg.Node.get_instrs n) in
match Cfg.Node.get_preds node with
IList.exists filter (Procdesc.Node.get_instrs n) in
match Procdesc.Node.get_preds node with
| [pred_node] -> find_boolean_assignment pred_node pvar true_branch
| [n1; n2] ->
if find_instr n1 then (Some n1)
@ -257,7 +257,7 @@ let rec _find_normal_variable_load tenv (seen : Exp.Set.t) node id : DExp.t opti
("find_normal_variable_load could not find " ^
Ident.to_string id ^
" in node " ^
string_of_int (Cfg.Node.get_id node :> int));
string_of_int (Procdesc.Node.get_id node :> int));
L.d_ln ());
res
@ -484,7 +484,7 @@ let explain_leak tenv hpred prop alloc_att_opt bucket =
let instro = State.get_instr () in
let loc = State.get_loc () in
let node = State.get_node () in
let node_instrs = Cfg.Node.get_instrs node in
let node_instrs = Procdesc.Node.get_instrs node in
let hpred_typ_opt = find_hpred_typ hpred in
let value_str_from_pvars_vpath pvars vpath =
if pvars <> [] then

25
infer/src/backend/errdesc.mli
Unescape View File

@ -17,7 +17,7 @@ open! Utils
val vpath_find : Tenv.t -> 'a Prop.t -> Exp.t -> DecompiledExp.vpath * Typ.t option
(** Return true if [id] is assigned to a program variable which is then nullified *)
val id_is_assigned_then_dead : Cfg.Node.t -> Ident.t -> bool
val id_is_assigned_then_dead : Procdesc.Node.t -> Ident.t -> bool
(** Check whether the hpred is a |-> representing a resource in the Racquire state *)
val hpred_is_open_resource : Tenv.t -> 'a Prop.t -> Sil.hpred -> PredSymb.resource option
@ -25,20 +25,21 @@ val hpred_is_open_resource : Tenv.t -> 'a Prop.t -> Sil.hpred -> PredSymb.resour
(** Find the function call instruction used to initialize normal variable [id],
and return the function name and arguments *)
val find_normal_variable_funcall :
Cfg.Node.t -> Ident.t -> (Exp.t * (Exp.t list) * Location.t * CallFlags.t) option
Procdesc.Node.t -> Ident.t -> (Exp.t * (Exp.t list) * Location.t * CallFlags.t) option
(** Find a program variable assignment in the current node or straightline predecessor. *)
val find_program_variable_assignment : Cfg.Node.t -> Pvar.t -> (Cfg.Node.t * Ident.t) option
val find_program_variable_assignment :
Procdesc.Node.t -> Pvar.t -> (Procdesc.Node.t * Ident.t) option
(** Find a program variable assignment to id in the current node or predecessors. *)
val find_ident_assignment : Cfg.Node.t -> Ident.t -> (Cfg.Node.t * Exp.t) option
val find_ident_assignment : Procdesc.Node.t -> Ident.t -> (Procdesc.Node.t * Exp.t) option
(** Find a boolean assignment to a temporary variable holding a boolean condition.
The boolean parameter indicates whether the true or false branch is required. *)
val find_boolean_assignment : Cfg.Node.t -> Pvar.t -> bool -> Cfg.Node.t option
val find_boolean_assignment : Procdesc.Node.t -> Pvar.t -> bool -> Procdesc.Node.t option
(** describe rvalue [e] as a dexp *)
val exp_rv_dexp : Tenv.t -> Cfg.Node.t -> Exp.t -> DecompiledExp.t option
val exp_rv_dexp : Tenv.t -> Procdesc.Node.t -> Exp.t -> DecompiledExp.t option
(** Produce a description of a persistent reference to an Android Context *)
val explain_context_leak : Procname.t -> Typ.t -> Ident.fieldname ->
@ -54,7 +55,7 @@ val explain_array_access : Tenv.t -> Localise.deref_str -> 'a Prop.t -> Location
(** explain a class cast exception *)
val explain_class_cast_exception :
Tenv.t -> Procname.t option -> Exp.t -> Exp.t -> Exp.t ->
Cfg.Node.t -> Location.t -> Localise.error_desc
Procdesc.Node.t -> Location.t -> Localise.error_desc
(** Explain a deallocate stack variable error *)
val explain_deallocate_stack_var : Pvar.t -> PredSymb.res_action -> Localise.error_desc
@ -72,10 +73,10 @@ val explain_dereference :
val explain_dereference_as_caller_expression :
Tenv.t -> ?use_buckets:bool ->
Localise.deref_str -> 'a Prop.t -> 'b Prop.t -> Exp.t ->
Cfg.Node.t -> Location.t -> Pvar.t list -> Localise.error_desc
Procdesc.Node.t -> Location.t -> Pvar.t list -> Localise.error_desc
(** explain a division by zero *)
val explain_divide_by_zero : Tenv.t -> Exp.t -> Cfg.Node.t -> Location.t -> Localise.error_desc
val explain_divide_by_zero : Tenv.t -> Exp.t -> Procdesc.Node.t -> Location.t -> Localise.error_desc
(** explain a return expression required *)
val explain_return_expression_required : Location.t -> Typ.t -> Localise.error_desc
@ -88,7 +89,7 @@ val explain_condition_is_assignment : Location.t -> Localise.error_desc
(** explain a condition which is always true or false *)
val explain_condition_always_true_false :
Tenv.t -> IntLit.t -> Exp.t -> Cfg.Node.t -> Location.t -> Localise.error_desc
Tenv.t -> IntLit.t -> Exp.t -> Procdesc.Node.t -> Location.t -> Localise.error_desc
(** explain the escape of a stack variable address from its scope *)
val explain_stack_variable_address_escape :
@ -107,7 +108,7 @@ val explain_retain_cycle :
(** explain unary minus applied to unsigned expression *)
val explain_unary_minus_applied_to_unsigned_expression :
Tenv.t -> Exp.t -> Typ.t -> Cfg.Node.t -> Location.t -> Localise.error_desc
Tenv.t -> Exp.t -> Typ.t -> Procdesc.Node.t -> Location.t -> Localise.error_desc
(** Explain a tainted value error *)
val explain_tainted_value_reaching_sensitive_function :
@ -127,7 +128,7 @@ val explain_memory_access : Tenv.t -> Localise.deref_str -> 'a Prop.t -> Locatio
(** explain a test for NULL of a dereferenced pointer *)
val explain_null_test_after_dereference :
Tenv.t -> Exp.t -> Cfg.Node.t -> int -> Location.t -> Localise.error_desc
Tenv.t -> Exp.t -> Procdesc.Node.t -> int -> Location.t -> Localise.error_desc
(** Print a warning to the err stream at the given location (note: only prints in developer mode) *)
val warning_err : Location.t -> ('a, Format.formatter, unit) format -> 'a

2
infer/src/backend/exe_env.mli
Unescape View File

@ -41,7 +41,7 @@ val get_tenv : ?create:bool -> t -> Procname.t -> Tenv.t
val get_cfg : t -> Procname.t -> Cfg.cfg option
(** return the proc desc associated to the procedure *)
val get_proc_desc : t -> Procname.t -> Cfg.Procdesc.t option
val get_proc_desc : t -> Procname.t -> Procdesc.t option
(** [iter_files f exe_env] applies [f] to the source file and tenv and cfg for each file in [exe_env] *)
val iter_files : (DB.source_file -> Cfg.cfg -> unit) -> t -> unit

208
infer/src/backend/interproc.ml
Unescape View File

@ -18,7 +18,7 @@ module F = Format
(** A node with a number of visits *)
type visitednode =
{
node: Cfg.Node.t;
node: Procdesc.Node.t;
visits: int;
}
@ -28,11 +28,11 @@ module NodeVisitSet =
type t = visitednode
let compare_ids n1 n2 =
(* higher id is better *)
Cfg.Node.compare n2 n1
Procdesc.Node.compare n2 n1
let compare_distance_to_exit { node = n1 } { node = n2 } =
(* smaller means higher priority *)
let n =
match Cfg.Node.get_distance_to_exit n1, Cfg.Node.get_distance_to_exit n2 with
match Procdesc.Node.get_distance_to_exit n1, Procdesc.Node.get_distance_to_exit n2 with
| None, None ->
0
| None, Some _ ->
@ -59,11 +59,11 @@ module NodeVisitSet =
module Join_table : sig
type t
val add : t -> Cfg.Node.id -> Paths.PathSet.t -> unit
val add : t -> Procdesc.Node.id -> Paths.PathSet.t -> unit
val create : unit -> t
val find : t -> Cfg.Node.id -> Paths.PathSet.t
val find : t -> Procdesc.Node.id -> Paths.PathSet.t
end = struct
type t = (Cfg.Node.id, Paths.PathSet.t) Hashtbl.t
type t = (Procdesc.Node.id, Paths.PathSet.t) Hashtbl.t
let create () : t =
Hashtbl.create 11
@ -78,14 +78,13 @@ end
(* =============== START of module Worklist =============== *)
module Worklist = struct
module NodeMap = Map.Make(Cfg.Node)
type t = {
join_table : Join_table.t; (** Table of join results *)
path_set_todo : (Cfg.Node.id, Paths.PathSet.t) Hashtbl.t; (** Pathset todo *)
path_set_visited : (Cfg.Node.id, Paths.PathSet.t) Hashtbl.t; (** Pathset visited *)
path_set_todo : (Procdesc.Node.id, Paths.PathSet.t) Hashtbl.t; (** Pathset todo *)
path_set_visited : (Procdesc.Node.id, Paths.PathSet.t) Hashtbl.t; (** Pathset visited *)
mutable todo_set : NodeVisitSet.t; (** Set of nodes still to do, with visit count *)
mutable visit_map : int NodeMap.t; (** Map from nodes done to visit count *)
mutable visit_map : int Procdesc.NodeMap.t; (** Map from nodes done to visit count *)
}
let create () = {
@ -93,26 +92,26 @@ module Worklist = struct
path_set_todo = Hashtbl.create 11;
path_set_visited = Hashtbl.create 11;
todo_set = NodeVisitSet.empty;
visit_map = NodeMap.empty;
visit_map = Procdesc.NodeMap.empty;
}
let is_empty (wl : t) : bool =
NodeVisitSet.is_empty wl.todo_set
let add (wl : t) (node : Cfg.Node.t) : unit =
let add (wl : t) (node : Procdesc.Node.t) : unit =
let visits = (* recover visit count if it was visited before *)
try NodeMap.find node wl.visit_map with
try Procdesc.NodeMap.find node wl.visit_map with
| Not_found -> 0 in
wl.todo_set <- NodeVisitSet.add { node; visits } wl.todo_set
(** remove the minimum element from the worklist, and increase its number of visits *)
let remove (wl : t) : Cfg.Node.t =
let remove (wl : t) : Procdesc.Node.t =
try
let min = NodeVisitSet.min_elt wl.todo_set in
wl.todo_set <-
NodeVisitSet.remove min wl.todo_set;
wl.visit_map <-
NodeMap.add min.node (min.visits + 1) wl.visit_map; (* increase the visits *)
Procdesc.NodeMap.add min.node (min.visits + 1) wl.visit_map; (* increase the visits *)
min.node
with Not_found -> begin
L.out "@\n...Work list is empty! Impossible to remove edge...@\n";
@ -124,10 +123,11 @@ end
let path_set_create_worklist pdesc =
State.reset ();
Cfg.Procdesc.compute_distance_to_exit_node pdesc;
Procdesc.compute_distance_to_exit_node pdesc;
Worklist.create ()
let htable_retrieve (htable : (Cfg.Node.id, Paths.PathSet.t) Hashtbl.t) (key : Cfg.Node.id)
let htable_retrieve
(htable : (Procdesc.Node.id, Paths.PathSet.t) Hashtbl.t) (key : Procdesc.Node.id)
: Paths.PathSet.t =
try
Hashtbl.find htable key
@ -136,11 +136,11 @@ let htable_retrieve (htable : (Cfg.Node.id, Paths.PathSet.t) Hashtbl.t) (key : C
Paths.PathSet.empty
(** Add [d] to the pathset todo at [node] returning true if changed *)
let path_set_put_todo (wl : Worklist.t) (node: Cfg.Node.t) (d: Paths.PathSet.t) : bool =
let path_set_put_todo (wl : Worklist.t) (node: Procdesc.Node.t) (d: Paths.PathSet.t) : bool =
let changed =
if Paths.PathSet.is_empty d then false
else
let node_id = Cfg.Node.get_id node in
let node_id = Procdesc.Node.get_id node in
let old_todo = htable_retrieve wl.Worklist.path_set_todo node_id in
let old_visited = htable_retrieve wl.Worklist.path_set_visited node_id in
let d' = Paths.PathSet.diff d old_visited in (* differential fixpoint *)
@ -149,9 +149,9 @@ let path_set_put_todo (wl : Worklist.t) (node: Cfg.Node.t) (d: Paths.PathSet.t)
not (Paths.PathSet.equal old_todo todo_new) in
changed
let path_set_checkout_todo (wl : Worklist.t) (node: Cfg.Node.t) : Paths.PathSet.t =
let path_set_checkout_todo (wl : Worklist.t) (node: Procdesc.Node.t) : Paths.PathSet.t =
try
let node_id = Cfg.Node.get_id node in
let node_id = Procdesc.Node.get_id node in
let todo = Hashtbl.find wl.Worklist.path_set_todo node_id in
Hashtbl.replace wl.Worklist.path_set_todo node_id Paths.PathSet.empty;
let visited = Hashtbl.find wl.Worklist.path_set_visited node_id in
@ -159,7 +159,7 @@ let path_set_checkout_todo (wl : Worklist.t) (node: Cfg.Node.t) : Paths.PathSet.
Hashtbl.replace wl.Worklist.path_set_visited node_id new_visited;
todo
with Not_found ->
L.out "@.@.ERROR: could not find todo for node %a@.@." Cfg.Node.pp node;
L.out "@.@.ERROR: could not find todo for node %a@.@." Procdesc.Node.pp node;
assert false
(* =============== END of the edge_set object =============== *)
@ -250,7 +250,7 @@ let collect_preconditions tenv proc_name : Prop.normal Specs.Jprop.t list =
(** propagate a set of results to the given node *)
let propagate
(wl : Worklist.t) pname ~is_exception (pset: Paths.PathSet.t) (curr_node: Cfg.Node.t) =
(wl : Worklist.t) pname ~is_exception (pset: Paths.PathSet.t) (curr_node: Procdesc.Node.t) =
let edgeset_todo =
(* prop must be a renamed prop by the invariant preserved by PropSet *)
let f prop path edgeset_curr =
@ -269,14 +269,14 @@ let propagate
(** propagate a set of results, including exceptions and divergence *)
let propagate_nodes_divergence
tenv (pdesc: Cfg.Procdesc.t) (pset: Paths.PathSet.t)
(succ_nodes: Cfg.Node.t list) (exn_nodes: Cfg.Node.t list) (wl : Worklist.t) =
let pname = Cfg.Procdesc.get_proc_name pdesc in
tenv (pdesc: Procdesc.t) (pset: Paths.PathSet.t)
(succ_nodes: Procdesc.Node.t list) (exn_nodes: Procdesc.Node.t list) (wl : Worklist.t) =
let pname = Procdesc.get_proc_name pdesc in
let pset_exn, pset_ok = Paths.PathSet.partition (Tabulation.prop_is_exn pname) pset in
if !Config.footprint && not (Paths.PathSet.is_empty (State.get_diverging_states_node ())) then
begin
Errdesc.warning_err (State.get_loc ()) "Propagating Divergence@.";
let exit_node = Cfg.Procdesc.get_exit_node pdesc in
let exit_node = Procdesc.get_exit_node pdesc in
let diverging_states = State.get_diverging_states_node () in
let prop_incons =
let mk_incons prop =
@ -297,8 +297,8 @@ let propagate_nodes_divergence
(** Symbolic execution for a Join node *)
let do_symexec_join pname tenv wl curr_node (edgeset_todo : Paths.PathSet.t) =
let curr_node_id = Cfg.Node.get_id curr_node in
let succ_nodes = Cfg.Node.get_succs curr_node in
let curr_node_id = Procdesc.Node.get_id curr_node in
let succ_nodes = Procdesc.Node.get_succs curr_node in
let new_dset = edgeset_todo in
let old_dset = Join_table.find wl.Worklist.join_table curr_node_id in
let old_dset', new_dset' = Dom.pathset_join pname tenv old_dset new_dset in
@ -333,7 +333,7 @@ let reset_prop_metrics () =
exception RE_EXE_ERROR
let do_before_node pname source session node =
let loc = Cfg.Node.get_loc node in
let loc = Procdesc.Node.get_loc node in
State.set_node node;
State.set_session session;
L.reset_delayed_prints ();
@ -360,10 +360,10 @@ let instrs_get_normal_vars instrs =
(* we exclude function calls: if (g(x,y)) ....*)
(* we check that prune nodes have simple guards: a var or its negation*)
let check_assignement_guard pdesc node =
let pname = Cfg.Procdesc.get_proc_name pdesc in
let pname = Procdesc.get_proc_name pdesc in
let verbose = false in
let node_contains_call n =
let instrs = Cfg.Node.get_instrs n in
let instrs = Procdesc.Node.get_instrs n in
let is_call = function
| Sil.Call _ -> true
| _ -> false in
@ -385,13 +385,13 @@ let check_assignement_guard pdesc node =
| Exp.Lvar pv ->
Pvar.is_frontend_tmp pv
| _ -> false in
let succs = Cfg.Node.get_succs node in
let l_node = Cfg.Node.get_last_loc node in
let succs = Procdesc.Node.get_succs node in
let l_node = Procdesc.Node.get_last_loc node in
(* e is prune if in all successors prune nodes we have for some temp n$1: *)
(* n$1=*&e;Prune(n$1) or n$1=*&e;Prune(!n$1) *)
let is_prune_exp e =
let prune_var n =
let ins = Cfg.Node.get_instrs n in
let ins = Procdesc.Node.get_instrs n in
let pi = IList.filter is_prune_instr ins in
let leti = IList.filter is_load_instr ins in
match pi, leti with
@ -406,10 +406,10 @@ let check_assignement_guard pdesc node =
| _ -> [] in
let prune_vars = IList.flatten(IList.map (fun n -> prune_var n) succs) in
IList.for_all (fun e' -> Exp.equal e' e) prune_vars in
let succs_loc = IList.map (fun n -> Cfg.Node.get_loc n) succs in
let succs_loc = IList.map (fun n -> Procdesc.Node.get_loc n) succs in
let succs_are_all_prune_nodes () =
IList.for_all (fun n -> match Cfg.Node.get_kind n with
| Cfg.Node.Prune_node(_) -> true
IList.for_all (fun n -> match Procdesc.Node.get_kind n with
| Procdesc.Node.Prune_node(_) -> true
| _ -> false) succs in
let succs_same_loc_as_node () =
if verbose then
@ -428,13 +428,13 @@ let check_assignement_guard pdesc node =
| Sil.Prune _ -> false
| _ -> true in
let check_guard n =
IList.for_all check_instr (Cfg.Node.get_instrs n) in
IList.for_all check_instr (Procdesc.Node.get_instrs n) in
IList.for_all check_guard succs in
if !Config.curr_language = Config.Clang &&
succs_are_all_prune_nodes () &&
succs_same_loc_as_node () &&
succs_have_simple_guards () then
(let instr = Cfg.Node.get_instrs node in
(let instr = Procdesc.Node.get_instrs node in
match succs_loc with
(* at this point all successors are at the same location, so we can take the first*)
| loc_succ:: _ ->
@ -461,12 +461,12 @@ let check_assignement_guard pdesc node =
(** Perform symbolic execution for a node starting from an initial prop *)
let do_symbolic_execution pdesc handle_exn tenv
(node : Cfg.Node.t) (prop: Prop.normal Prop.t) (path : Paths.Path.t) =
(node : Procdesc.Node.t) (prop: Prop.normal Prop.t) (path : Paths.Path.t) =
State.mark_execution_start node;
(* build the const map lazily *)
State.set_const_map (ConstantPropagation.build_const_map tenv pdesc);
check_assignement_guard pdesc node;
let instrs = Cfg.Node.get_instrs node in
let instrs = Procdesc.Node.get_instrs node in
(* fresh normal vars must be fresh w.r.t. instructions *)
Ident.update_name_generator (instrs_get_normal_vars instrs);
let pset =
@ -478,7 +478,7 @@ let do_symbolic_execution pdesc handle_exn tenv
pset
let mark_visited summary node =
let node_id = Cfg.Node.get_id node in
let node_id = Procdesc.Node.get_id node in
let stats = summary.Specs.stats in
if !Config.footprint
then
@ -490,7 +490,7 @@ let add_taint_attrs tenv proc_name proc_desc prop =
match Taint.tainted_params proc_name with
| [] -> prop
| tainted_param_nums ->
let formal_params = Cfg.Procdesc.get_formals proc_desc in
let formal_params = Procdesc.get_formals proc_desc in
let formal_params' =
IList.map (fun (p, _) -> Pvar.mk p proc_name) formal_params in
Taint.get_params_to_taint tainted_param_nums formal_params'
@ -502,7 +502,7 @@ let add_taint_attrs tenv proc_name proc_desc prop =
prop
let forward_tabulate tenv pdesc wl source =
let pname = Cfg.Procdesc.get_proc_name pdesc in
let pname = Procdesc.get_proc_name pdesc in
let handle_exn_node curr_node exn =
Exceptions.print_exception_html "Failure of symbolic execution: " exn;
let pre_opt = (* precondition leading to error, if any *)
@ -512,7 +512,7 @@ let forward_tabulate tenv pdesc wl source =
L.d_strln "Precondition:"; Prop.d_prop pre; L.d_ln ()
| None -> ());
L.d_strln "SIL INSTR:";
Cfg.Node.d_instrs ~sub_instrs: true (State.get_instr ()) curr_node; L.d_ln ();
Procdesc.Node.d_instrs ~sub_instrs: true (State.get_instr ()) curr_node; L.d_ln ();
Reporting.log_error pname exn;
State.mark_instr_fail exn in
@ -533,14 +533,14 @@ let forward_tabulate tenv pdesc wl source =
let timestamp = Specs.get_timestamp summary in
F.sprintf "[%s:%d] %s" phase_string timestamp (Procname.to_string proc_name) in
L.d_strln ("**** " ^ (log_string pname) ^ " " ^
"Node: " ^ string_of_int (Cfg.Node.get_id curr_node :> int) ^ ", " ^
"Node: " ^ string_of_int (Procdesc.Node.get_id curr_node :> int) ^ ", " ^
"Procedure: " ^ Procname.to_string pname ^ ", " ^
"Session: " ^ string_of_int session ^ ", " ^
"Todo: " ^ string_of_int (Paths.PathSet.size pathset_todo) ^ " ****");
L.d_increase_indent 1;
Propset.d Prop.prop_emp (Paths.PathSet.to_propset tenv pathset_todo);
L.d_strln ".... Instructions: .... ";
Cfg.Node.d_instrs ~sub_instrs: true (State.get_instr ()) curr_node;
Procdesc.Node.d_instrs ~sub_instrs: true (State.get_instr ()) curr_node;
L.d_ln (); L.d_ln () in
let do_prop curr_node handle_exn prop_ path cnt num_paths =
@ -555,8 +555,8 @@ let forward_tabulate tenv pdesc wl source =
State.reset_diverging_states_node ();
let pset =
do_symbolic_execution pdesc handle_exn tenv curr_node prop path in
let succ_nodes = Cfg.Node.get_succs curr_node in
let exn_nodes = Cfg.Node.get_exn curr_node in
let succ_nodes = Procdesc.Node.get_succs curr_node in
let exn_nodes = Procdesc.Node.get_exn curr_node in
propagate_nodes_divergence tenv pdesc pset succ_nodes exn_nodes wl;
L.d_decrease_indent 1; L.d_ln();
with
@ -568,14 +568,14 @@ let forward_tabulate tenv pdesc wl source =
check_prop_size pathset_todo;
print_node_preamble curr_node session pathset_todo;
match Cfg.Node.get_kind curr_node with
| Cfg.Node.Join_node ->
match Procdesc.Node.get_kind curr_node with
| Procdesc.Node.Join_node ->
do_symexec_join pname tenv wl curr_node pathset_todo
| Cfg.Node.Stmt_node _
| Cfg.Node.Prune_node _
| Cfg.Node.Exit_node _
| Cfg.Node.Skip_node _
| Cfg.Node.Start_node _ ->
| Procdesc.Node.Stmt_node _
| Procdesc.Node.Prune_node _
| Procdesc.Node.Exit_node _
| Procdesc.Node.Skip_node _
| Procdesc.Node.Start_node _ ->
exe_iter (do_prop curr_node handle_exn) pathset_todo in
let do_node_and_handle curr_node session =
@ -690,10 +690,10 @@ let report_context_leaks pname sigma tenv =
(** Remove locals and formals,
and check if the address of a stack variable is left in the result *)
let remove_locals_formals_and_check tenv pdesc p =
let pname = Cfg.Procdesc.get_proc_name pdesc in
let pname = Procdesc.get_proc_name pdesc in
let pvars, p' = PropUtil.remove_locals_formals tenv pdesc p in
let check_pvar pvar =
let loc = Cfg.Node.get_loc (Cfg.Procdesc.get_exit_node pdesc) in
let loc = Procdesc.Node.get_loc (Procdesc.get_exit_node pdesc) in
let dexp_opt, _ = Errdesc.vpath_find tenv p (Exp.Lvar pvar) in
let desc = Errdesc.explain_stack_variable_address_escape loc pvar dexp_opt in
let exn = Exceptions.Stack_variable_address_escape (desc, __POS__) in
@ -703,8 +703,8 @@ let remove_locals_formals_and_check tenv pdesc p =
(** Collect the analysis results for the exit node. *)
let collect_analysis_result tenv wl pdesc : Paths.PathSet.t =
let exit_node = Cfg.Procdesc.get_exit_node pdesc in
let exit_node_id = Cfg.Node.get_id exit_node in
let exit_node = Procdesc.get_exit_node pdesc in
let exit_node_id = Procdesc.Node.get_id exit_node in
let pathset = htable_retrieve wl.Worklist.path_set_visited exit_node_id in
Paths.PathSet.map (remove_locals_formals_and_check tenv pdesc) pathset
@ -716,7 +716,7 @@ module Pmap = Map.Make
let vset_ref_add_path vset_ref path =
Paths.Path.iter_all_nodes_nocalls
(fun n -> vset_ref := Cfg.NodeSet.add n !vset_ref)
(fun n -> vset_ref := Procdesc.NodeSet.add n !vset_ref)
path
let vset_ref_add_pathset vset_ref pathset =
@ -725,19 +725,19 @@ let vset_ref_add_pathset vset_ref pathset =
let compute_visited vset =
let res = ref Specs.Visitedset.empty in
let node_get_all_lines n =
let node_loc = Cfg.Node.get_loc n in
let instrs_loc = IList.map Sil.instr_get_loc (Cfg.Node.get_instrs n) in
let node_loc = Procdesc.Node.get_loc n in
let instrs_loc = IList.map Sil.instr_get_loc (Procdesc.Node.get_instrs n) in
let lines = IList.map (fun loc -> loc.Location.line) (node_loc :: instrs_loc) in
IList.remove_duplicates int_compare (IList.sort int_compare lines) in
let do_node n =
res :=
Specs.Visitedset.add (Cfg.Node.get_id n, node_get_all_lines n) !res in
Cfg.NodeSet.iter do_node vset;
Specs.Visitedset.add (Procdesc.Node.get_id n, node_get_all_lines n) !res in
Procdesc.NodeSet.iter do_node vset;
!res
(** Extract specs from a pathset *)
let extract_specs tenv pdesc pathset : Prop.normal Specs.spec list =
let pname = Cfg.Procdesc.get_proc_name pdesc in
let pname = Procdesc.get_proc_name pdesc in
let sub =
let fav = Sil.fav_new () in
Paths.PathSet.iter
@ -756,13 +756,13 @@ let extract_specs tenv pdesc pathset : Prop.normal Specs.spec list =
let pre, post = Prop.extract_spec prop'' in
let pre' = Prop.normalize tenv (Prop.prop_sub sub pre) in
if !Config.curr_language =
Config.Java && Cfg.Procdesc.get_access pdesc <> PredSymb.Private then
Config.Java && Procdesc.get_access pdesc <> PredSymb.Private then
report_context_leaks pname post.Prop.sigma tenv;
let post' =
if Prover.check_inconsistency_base tenv prop then None
else Some (Prop.normalize tenv (Prop.prop_sub sub post), path) in
let visited =
let vset_ref = ref Cfg.NodeSet.empty in
let vset_ref = ref Procdesc.NodeSet.empty in
vset_ref_add_path vset_ref path;
compute_visited !vset_ref in
(pre', post', visited) in
@ -794,7 +794,7 @@ let extract_specs tenv pdesc pathset : Prop.normal Specs.spec list =
!specs
let collect_postconditions wl tenv pdesc : Paths.PathSet.t * Specs.Visitedset.t =
let pname = Cfg.Procdesc.get_proc_name pdesc in
let pname = Procdesc.get_proc_name pdesc in
let pathset = collect_analysis_result tenv wl pdesc in
(* Assuming C++ developers use RAII, remove resources from the constructor posts *)
@ -818,7 +818,7 @@ let collect_postconditions wl tenv pdesc : Paths.PathSet.t * Specs.Visitedset.t
let pathset = collect_do_abstract_post pname tenv pathset in
let pathset_diverging = State.get_diverging_states_proc () in
let visited =
let vset_ref = ref Cfg.NodeSet.empty in
let vset_ref = ref Procdesc.NodeSet.empty in
vset_ref_add_pathset vset_ref pathset;
(* nodes from diverging states were also visited *)
vset_ref_add_pathset vset_ref pathset_diverging;
@ -867,13 +867,13 @@ let prop_init_formals_seed tenv new_formals (prop : 'a Prop.t) : Prop.exposed Pr
(** Construct an initial prop by extending [prop] with locals, and formals if [add_formals] is true
as well as seed variables *)
let initial_prop
tenv (curr_f: Cfg.Procdesc.t) (prop : 'a Prop.t) add_formals
tenv (curr_f: Procdesc.t) (prop : 'a Prop.t) add_formals
: Prop.normal Prop.t =
let construct_decl (x, typ) =
(Pvar.mk x (Cfg.Procdesc.get_proc_name curr_f), typ) in
(Pvar.mk x (Procdesc.get_proc_name curr_f), typ) in
let new_formals =
if add_formals
then IList.map construct_decl (Cfg.Procdesc.get_formals curr_f)
then IList.map construct_decl (Procdesc.get_formals curr_f)
else [] (* no new formals added *) in
let prop1 =
Prop.prop_reset_inst
@ -906,7 +906,7 @@ let initial_prop_from_pre tenv curr_f pre =
(** Re-execute one precondition and return some spec if there was no re-execution error. *)
let execute_filter_prop wl tenv pdesc init_node (precondition : Prop.normal Specs.Jprop.t) source
: Prop.normal Specs.spec option =
let pname = Cfg.Procdesc.get_proc_name pdesc in
let pname = Procdesc.get_proc_name pdesc in
do_before_node pname source 0 init_node;
L.d_strln ("#### Start: RE-execution for " ^ Procname.to_string pname ^ " ####");
L.d_indent 1;
@ -967,13 +967,13 @@ let get_procs_and_defined_children call_graph =
let pp_intra_stats wl proc_desc fmt _ =
let nstates = ref 0 in
let nodes = Cfg.Procdesc.get_nodes proc_desc in
let nodes = Procdesc.get_nodes proc_desc in
IList.iter
(fun node ->
nstates :=
!nstates +
Paths.PathSet.size
(htable_retrieve wl.Worklist.path_set_visited (Cfg.Node.get_id node)))
(htable_retrieve wl.Worklist.path_set_visited (Procdesc.Node.get_id node)))
nodes;
F.fprintf fmt "(%d nodes containing %d states)" (IList.length nodes) !nstates
@ -984,10 +984,10 @@ type exe_phase = (unit -> unit) * (unit -> Prop.normal Specs.spec list * Specs.p
and [get_results ()] returns the results computed.
This function is architected so that [get_results ()] can be called even after
[go ()] was interrupted by and exception. *)
let perform_analysis_phase tenv (pname : Procname.t) (pdesc : Cfg.Procdesc.t) source
let perform_analysis_phase tenv (pname : Procname.t) (pdesc : Procdesc.t) source
: exe_phase =
let summary = Specs.get_summary_unsafe "check_recursion_level" pname in
let start_node = Cfg.Procdesc.get_start_node pdesc in
let start_node = Procdesc.get_start_node pdesc in
let check_recursion_level () =
let recursion_level = Specs.get_timestamp summary in
@ -1021,7 +1021,7 @@ let perform_analysis_phase tenv (pname : Procname.t) (pdesc : Cfg.Procdesc.t) so
Worklist.add wl start_node;
Config.arc_mode :=
Hashtbl.mem
(Cfg.Procdesc.get_flags pdesc)
(Procdesc.get_flags pdesc)
Mleak_buckets.objc_arc_flag;
ignore (path_set_put_todo wl start_node init_edgeset);
forward_tabulate tenv pdesc wl source in
@ -1103,7 +1103,7 @@ let perform_analysis_phase tenv (pname : Procname.t) (pdesc : Cfg.Procdesc.t) so
re_execution ()
let set_current_language proc_desc =
let language = (Cfg.Procdesc.get_attributes proc_desc).ProcAttributes.language in
let language = (Procdesc.get_attributes proc_desc).ProcAttributes.language in
Config.curr_language := language
(** reset global values before analysing a procedure *)
@ -1313,7 +1313,7 @@ let update_summary tenv prev_summary specs phase proc_name elapsed res =
(** Analyze the procedure and return the resulting summary. *)
let analyze_proc source exe_env proc_desc : Specs.summary =
let proc_name = Cfg.Procdesc.get_proc_name proc_desc in
let proc_name = Procdesc.get_proc_name proc_desc in
let init_time = Unix.gettimeofday () in
let tenv = Exe_env.get_tenv exe_env proc_name in
reset_global_values proc_desc;
@ -1373,7 +1373,7 @@ let perform_transition exe_env tenv proc_name source =
try
match Exe_env.get_proc_desc exe_env proc_name with
| Some pdesc ->
let start_node = Cfg.Procdesc.get_start_node pdesc in
let start_node = Procdesc.get_start_node pdesc in
f start_node
| None -> ()
with exn when SymOp.exn_not_failure exn -> () in
@ -1411,7 +1411,7 @@ let interprocedural_algorithm exe_env : unit =
| Some proc_desc ->
let reactive_changed =
if Config.reactive_mode
then (Cfg.Procdesc.get_attributes proc_desc).ProcAttributes.changed
then (Procdesc.get_attributes proc_desc).ProcAttributes.changed
else true in
if
reactive_changed && (* in reactive mode, only analyze changed procedures *)
@ -1438,7 +1438,7 @@ let do_analysis exe_env =
let get_calls caller_pdesc =
let calls = ref [] in
let f (callee_pname, loc) = calls := (callee_pname, loc) :: !calls in
Cfg.Procdesc.iter_calls f caller_pdesc;
Procdesc.iter_calls f caller_pdesc;
IList.rev !calls in
let init_proc (pname, dep) =
let pdesc = match Exe_env.get_proc_desc exe_env pname with
@ -1446,12 +1446,12 @@ let do_analysis exe_env =
pdesc
| None ->
assert false in
let nodes = IList.map (fun n -> Cfg.Node.get_id n) (Cfg.Procdesc.get_nodes pdesc) in
let proc_flags = Cfg.Procdesc.get_flags pdesc in
let static_err_log = Cfg.Procdesc.get_err_log pdesc in (* err log from translation *)
let nodes = IList.map (fun n -> Procdesc.Node.get_id n) (Procdesc.get_nodes pdesc) in
let proc_flags = Procdesc.get_flags pdesc in
let static_err_log = Procdesc.get_err_log pdesc in (* err log from translation *)
let calls = get_calls pdesc in
let attributes =
{ (Cfg.Procdesc.get_attributes pdesc) with
{ (Procdesc.get_attributes pdesc) with
ProcAttributes.err_log = static_err_log; } in
let proc_desc_option =
if Config.dynamic_dispatch = `Lazy
@ -1479,7 +1479,7 @@ let do_analysis exe_env =
(Specs.get_summary proc_name)
| None -> None in
let analyze_ondemand source proc_desc =
let proc_name = Cfg.Procdesc.get_proc_name proc_desc in
let proc_name = Procdesc.get_proc_name proc_desc in
let tenv = Exe_env.get_tenv exe_env proc_name in
if not (Config.eradicate || Config.checkers)
then
@ -1507,25 +1507,25 @@ let do_analysis exe_env =
let visited_and_total_nodes ~filter cfg =
let filter_node pdesc n =
Cfg.Procdesc.is_defined pdesc &&
Procdesc.is_defined pdesc &&
filter pdesc &&
match Cfg.Node.get_kind n with
| Cfg.Node.Stmt_node _ | Cfg.Node.Prune_node _
| Cfg.Node.Start_node _ | Cfg.Node.Exit_node _ -> true
| Cfg.Node.Skip_node _ | Cfg.Node.Join_node -> false in
match Procdesc.Node.get_kind n with
| Procdesc.Node.Stmt_node _ | Procdesc.Node.Prune_node _
| Procdesc.Node.Start_node _ | Procdesc.Node.Exit_node _ -> true
| Procdesc.Node.Skip_node _ | Procdesc.Node.Join_node -> false in
let counted_nodes, visited_nodes_re =
let set = ref Cfg.NodeSet.empty in
let set_visited_re = ref Cfg.NodeSet.empty in
let set = ref Procdesc.NodeSet.empty in
let set_visited_re = ref Procdesc.NodeSet.empty in
let add pdesc n =
if filter_node pdesc n then
begin
set := Cfg.NodeSet.add n !set;
if snd (Printer.node_is_visited (Cfg.Procdesc.get_proc_name pdesc) n)
then set_visited_re := Cfg.NodeSet.add n !set_visited_re
set := Procdesc.NodeSet.add n !set;
if snd (Printer.node_is_visited (Procdesc.get_proc_name pdesc) n)
then set_visited_re := Procdesc.NodeSet.add n !set_visited_re
end in
Cfg.iter_all_nodes add cfg;
!set, !set_visited_re in
Cfg.NodeSet.elements visited_nodes_re, Cfg.NodeSet.elements counted_nodes
Procdesc.NodeSet.elements visited_nodes_re, Procdesc.NodeSet.elements counted_nodes
(** Print the stats for the given cfg.
Consider every defined proc unless a proc with the same name
@ -1533,7 +1533,7 @@ let visited_and_total_nodes ~filter cfg =
let print_stats_cfg proc_shadowed source cfg =
let err_table = Errlog.create_err_table () in
let filter pdesc =
let pname = Cfg.Procdesc.get_proc_name pdesc in
let pname = Procdesc.get_proc_name pdesc in
Specs.summary_exists pname && Specs.get_specs pname != [] in
let nodes_visited, nodes_total = visited_and_total_nodes ~filter cfg in
let num_proc = ref 0 in
@ -1545,7 +1545,7 @@ let print_stats_cfg proc_shadowed source cfg =
let tot_symops = ref 0 in
let num_timeout = ref 0 in
let compute_stats_proc proc_desc =
let proc_name = Cfg.Procdesc.get_proc_name proc_desc in
let proc_name = Procdesc.get_proc_name proc_desc in
if proc_shadowed proc_desc ||
Specs.get_summary proc_name = None then
L.out "print_stats: ignoring function %a which is also defined in another file@."
@ -1615,7 +1615,7 @@ let print_stats exe_env =
(fun source cfg ->
let proc_shadowed proc_desc =
(* return true if a proc with the same name in another module was analyzed instead *)
let proc_name = Cfg.Procdesc.get_proc_name proc_desc in
let proc_name = Procdesc.get_proc_name proc_desc in
Exe_env.get_source exe_env proc_name <> Some source in
print_stats_cfg proc_shadowed source cfg)
exe_env

12
infer/src/backend/ondemand.ml
Unescape View File

@ -32,9 +32,9 @@ let read_dirs_to_analyze () =
let dirs_to_analyze =
lazy (read_dirs_to_analyze ())
type analyze_ondemand = DB.source_file -> Cfg.Procdesc.t -> unit
type analyze_ondemand = DB.source_file -> Procdesc.t -> unit
type get_proc_desc = Procname.t -> Cfg.Procdesc.t option
type get_proc_desc = Procname.t -> Procdesc.t option
type callbacks =
{
@ -110,8 +110,8 @@ let restore_global_state st =
let run_proc_analysis tenv ~propagate_exceptions analyze_proc curr_pdesc callee_pdesc =
let curr_pname = Cfg.Procdesc.get_proc_name curr_pdesc in
let callee_pname = Cfg.Procdesc.get_proc_name callee_pdesc in
let curr_pname = Procdesc.get_proc_name curr_pdesc in
let callee_pname = Procdesc.get_proc_name callee_pdesc in
(* Dot means start of a procedure *)
L.log_progress_procedure ();
@ -195,8 +195,8 @@ let run_proc_analysis tenv ~propagate_exceptions analyze_proc curr_pdesc callee_
let analyze_proc_desc tenv ~propagate_exceptions curr_pdesc callee_pdesc =
let callee_pname = Cfg.Procdesc.get_proc_name callee_pdesc in
let proc_attributes = Cfg.Procdesc.get_attributes callee_pdesc in
let callee_pname = Procdesc.get_proc_name callee_pdesc in
let proc_attributes = Procdesc.get_attributes callee_pdesc in
match !callbacks_ref with
| Some callbacks
when should_be_analyzed proc_attributes callee_pname ->

8
infer/src/backend/ondemand.mli
Unescape View File

@ -14,9 +14,9 @@ open! Utils
(** Optional set of source dirs to analyze in on-demand mode. *)
val dirs_to_analyze : StringSet.t option Lazy.t
type analyze_ondemand = DB.source_file -> Cfg.Procdesc.t -> unit
type analyze_ondemand = DB.source_file -> Procdesc.t -> unit
type get_proc_desc = Procname.t -> Cfg.Procdesc.t option
type get_proc_desc = Procname.t -> Procdesc.t option
type callbacks =
{
@ -30,12 +30,12 @@ val get_proc_desc : get_proc_desc
(** analyze_proc_desc curr_pdesc callee_pdesc
performs an on-demand analysis of callee_pdesc
triggered during the analysis of curr_pdesc. *)
val analyze_proc_desc : Tenv.t -> propagate_exceptions:bool -> Cfg.Procdesc.t -> Cfg.Procdesc.t -> unit
val analyze_proc_desc : Tenv.t -> propagate_exceptions:bool -> Procdesc.t -> Procdesc.t -> unit
(** analyze_proc_name curr_pdesc proc_name
performs an on-demand analysis of proc_name
triggered during the analysis of curr_pdesc. *)
val analyze_proc_name : Tenv.t -> propagate_exceptions:bool -> Cfg.Procdesc.t -> Procname.t -> unit
val analyze_proc_name : Tenv.t -> propagate_exceptions:bool -> Procdesc.t -> Procname.t -> unit
(** Check if the procedure called needs to be analyzed. *)
val procedure_should_be_analyzed : Procname.t -> bool

66
infer/src/backend/paths.ml
Unescape View File

@ -36,7 +36,7 @@ module Path : sig
val create_loc_trace : t -> PredSymb.path_pos option -> Errlog.loc_trace
(** return the current node of the path *)
val curr_node : t -> Cfg.Node.t option
val curr_node : t -> Procdesc.Node.t option
(** dump a path *)
val d : t -> unit
@ -45,13 +45,13 @@ module Path : sig
val d_stats : t -> unit
(** extend a path with a new node reached from the given session, with an optional string for exceptions *)
val extend : Cfg.Node.t -> Typename.t option -> session -> t -> t
val extend : Procdesc.Node.t -> Typename.t option -> session -> t -> t
(** extend a path with a new node reached from the given session, with an optional string for exceptions *)
val add_description : t -> string -> t
(** iterate over each node in the path, excluding calls, once *)
val iter_all_nodes_nocalls : (Cfg.Node.t -> unit) -> t -> unit
val iter_all_nodes_nocalls : (Procdesc.Node.t -> unit) -> t -> unit
val iter_shortest_sequence :
(int -> t -> int -> Typename.t option -> unit) -> PredSymb.path_pos option -> t -> unit
@ -66,7 +66,7 @@ module Path : sig
val pp_stats : Format.formatter -> t -> unit
(** create a new path with given start node *)
val start : Cfg.Node.t -> t
val start : Procdesc.Node.t -> t
(*
(** equality for paths *)
@ -83,8 +83,8 @@ end = struct
type path =
(* INVARIANT: stats are always set to dummy_stats unless we are in the middle of a traversal *)
(* in particular: a new traversal cannot be initiated during an existing traversal *)
| Pstart of Cfg.Node.t * stats (** start node *)
| Pnode of Cfg.Node.t * Typename.t option * session * path * stats * string option
| Pstart of Procdesc.Node.t * stats (** start node *)
| Pnode of Procdesc.Node.t * Typename.t option * session * path * stats * string option
(** we got to [node] from last [session] perhaps propagating exception [exn_opt],
and continue with [path]. *)
| Pjoin of path * path * stats (** join of two paths *)
@ -133,11 +133,11 @@ end = struct
let rec compare p1 p2 : int =
if p1 == p2 then 0 else match p1, p2 with
| Pstart (n1, _), Pstart (n2, _) ->
Cfg.Node.compare n1 n2
Procdesc.Node.compare n1 n2
| Pstart _, _ -> - 1
| _, Pstart _ -> 1
| Pnode (n1, eo1, s1, p1, _, _), Pnode (n2, eo2, s2, p2, _, _) ->
let n = Cfg.Node.compare n1 n2 in
let n = Procdesc.Node.compare n1 n2 in
if n <> 0 then n else let n = exname_opt_compare eo1 eo2 in
if n <> 0 then n else let n = int_compare s1 s2 in
if n <> 0 then n else compare p1 p2
@ -154,7 +154,7 @@ end = struct
let start node = Pstart (node, get_dummy_stats ())
let extend (node: Cfg.Node.t) exn_opt session path =
let extend (node: Procdesc.Node.t) exn_opt session path =
Pnode (node, exn_opt, session, path, get_dummy_stats (), None)
let join p1 p2 =
@ -212,7 +212,7 @@ end = struct
satisfying [f] was found. Assumes that the invariant holds beforehand, and ensures that all
the stats are computed afterwards. Since this breaks the invariant, it must be followed by
reset_stats. *)
let rec compute_stats do_calls (f : Cfg.Node.t -> bool) =
let rec compute_stats do_calls (f : Procdesc.Node.t -> bool) =
let nodes_found stats = stats.max_length > 0 in
function
| Pstart (node, stats) ->
@ -268,8 +268,8 @@ end = struct
Invariant.reset_stats path
let get_path_pos node =
let pn = Cfg.Node.get_proc_name node in
let n_id = Cfg.Node.get_id node in
let pn = Procdesc.Node.get_proc_name node in
let n_id = Procdesc.Node.get_id node in
(pn, (n_id :> int))
let contains_position path pos =
@ -287,7 +287,7 @@ end = struct
pass the exception information to [f] on the previous node *)
let iter_shortest_sequence_filter
(f : int -> t -> int -> Typename.t option -> unit)
(filter: Cfg.Node.t -> bool) (path: t) : unit =
(filter: Procdesc.Node.t -> bool) (path: t) : unit =
let rec doit level session path prev_exn_opt = match path with
| Pstart _ -> f level path session prev_exn_opt
| Pnode (_, exn_opt, session', p, _, _) ->
@ -347,26 +347,26 @@ end = struct
(fun (level, p, session, exn_opt) -> f level p session exn_opt)
sequence_up_to_last_seen
module NodeMap = Map.Make (Cfg.Node)
(** return the node visited most, and number of visits, in the shortest linear sequence *)
let repetitions path =
let map = ref NodeMap.empty in
let map = ref Procdesc.NodeMap.empty in
let add_node = function
| Some node ->
begin
try
let n = NodeMap.find node !map in
map := NodeMap.add node (n + 1) !map
let n = Procdesc.NodeMap.find node !map in
map := Procdesc.NodeMap.add node (n + 1) !map
with Not_found ->
map := NodeMap.add node 1 !map
map := Procdesc.NodeMap.add node 1 !map
end
| None ->
() in
iter_shortest_sequence (fun _ p _ _ -> add_node (curr_node p)) None path;
let max_rep_node = ref (Cfg.Node.dummy ()) in
let max_rep_node = ref (Procdesc.Node.dummy ()) in
let max_rep_num = ref 0 in
NodeMap.iter (fun node num -> if num > !max_rep_num then (max_rep_node := node; max_rep_num := num)) !map;
Procdesc.NodeMap.iter
(fun node num -> if num > !max_rep_num then (max_rep_node := node; max_rep_num := num))
!map;
(!max_rep_node, !max_rep_num)
let stats_string path =
@ -376,7 +376,7 @@ end = struct
"linear paths: " ^ string_of_float (Invariant.get_stats path).linear_num ^
" max length: " ^ string_of_int (Invariant.get_stats path).max_length ^
" has repetitions: " ^ string_of_int repetitions ^
" of node " ^ (string_of_int (Cfg.Node.get_id node :> int)) in
" of node " ^ (string_of_int (Procdesc.Node.get_id node :> int)) in
Invariant.reset_stats path;
str
@ -418,9 +418,9 @@ end = struct
with Not_found ->
match path with
| Pstart (node, _) ->
F.fprintf fmt "n%a" Cfg.Node.pp node
F.fprintf fmt "n%a" Procdesc.Node.pp node
| Pnode (node, _, session, path, _, _) ->
F.fprintf fmt "%a(s%d).n%a" (doit (n - 1)) path (session :> int) Cfg.Node.pp node
F.fprintf fmt "%a(s%d).n%a" (doit (n - 1)) path (session :> int) Procdesc.Node.pp node
| Pjoin (path1, path2, _) ->
F.fprintf fmt "(%a + %a)" (doit (n - 1)) path1 (doit (n - 1)) path2
| Pcall (path1, _, path2, _) ->
@ -454,10 +454,10 @@ end = struct
match curr_node path with
| Some curr_node ->
begin
let curr_loc = Cfg.Node.get_loc curr_node in
match Cfg.Node.get_kind curr_node with
| Cfg.Node.Join_node -> () (* omit join nodes from error traces *)
| Cfg.Node.Start_node pname ->
let curr_loc = Procdesc.Node.get_loc curr_node in
match Procdesc.Node.get_kind curr_node with
| Procdesc.Node.Join_node -> () (* omit join nodes from error traces *)
| Procdesc.Node.Start_node pname ->
let name = Procname.to_string pname in
let name_id = Procname.to_filename pname in
let descr = "start of procedure " ^ (Procname.to_simplified_string pname) in
@ -466,7 +466,7 @@ end = struct
(Io_infer.Xml.tag_name, name);
(Io_infer.Xml.tag_name_id, name_id)] in
trace := mk_trace_elem level curr_loc descr node_tags :: !trace
| Cfg.Node.Prune_node (is_true_branch, if_kind, _) ->
| Procdesc.Node.Prune_node (is_true_branch, if_kind, _) ->
let descr = match is_true_branch, if_kind with
| true, Sil.Ik_if -> "Taking true branch"
| false, Sil.Ik_if -> "Taking false branch"
@ -482,7 +482,7 @@ end = struct
[(Io_infer.Xml.tag_kind,"condition");
(Io_infer.Xml.tag_branch, if is_true_branch then "true" else "false")] in
trace := mk_trace_elem level curr_loc descr node_tags :: !trace
| Cfg.Node.Exit_node pname ->
| Procdesc.Node.Exit_node pname ->
let descr = "return from a call to " ^ (Procname.to_string pname) in
let name = Procname.to_string pname in
let name_id = Procname.to_filename pname in
@ -644,10 +644,10 @@ end = struct
(** check if the nodes in path p1 are a subset of those in p2 (not trace subset) *)
let path_nodes_subset p1 p2 =
let get_nodes p =
let s = ref Cfg.NodeSet.empty in
Path.iter_all_nodes_nocalls (fun n -> s := Cfg.NodeSet.add n !s) p;
let s = ref Procdesc.NodeSet.empty in
Path.iter_all_nodes_nocalls (fun n -> s := Procdesc.NodeSet.add n !s) p;
!s in
Cfg.NodeSet.subset (get_nodes p1) (get_nodes p2)
Procdesc.NodeSet.subset (get_nodes p1) (get_nodes p2)
(** difference between pathsets for the differential fixpoint *)
let diff (ps1: t) (ps2: t) : t =

8
infer/src/backend/paths.mli
Unescape View File

@ -31,7 +31,7 @@ module Path : sig
val create_loc_trace : t -> PredSymb.path_pos option -> Errlog.loc_trace
(** return the current node of the path *)
val curr_node : t -> Cfg.Node.t option
val curr_node : t -> Procdesc.Node.t option
(** dump a path *)
val d : t -> unit
@ -40,12 +40,12 @@ module Path : sig
val d_stats : t -> unit
(** extend a path with a new node reached from the given session, with an optional string for exceptions *)
val extend : Cfg.Node.t -> Typename.t option -> session -> t -> t
val extend : Procdesc.Node.t -> Typename.t option -> session -> t -> t
val add_description : t -> string -> t
(** iterate over each node in the path, excluding calls, once *)
val iter_all_nodes_nocalls : (Cfg.Node.t -> unit) -> t -> unit
val iter_all_nodes_nocalls : (Procdesc.Node.t -> unit) -> t -> unit
(** iterate over the shortest sequence belonging to the path,
restricting to those containing the given position if given.
@ -65,7 +65,7 @@ module Path : sig
val pp_stats : Format.formatter -> t -> unit
(** create a new path with given start node *)
val start : Cfg.Node.t -> t
val start : Procdesc.Node.t -> t
end
(** Set of (prop,path) pairs, where the identity is given by prop *)

34
infer/src/backend/preanal.ml
Unescape View File

@ -53,17 +53,17 @@ let add_dispatch_calls pdesc cg tenv ~handle_dynamic_dispatch =
| [] -> instr)
| instr -> instr in
let instrs = Cfg.Node.get_instrs node in
let instrs = Procdesc.Node.get_instrs node in
if has_dispatch_call instrs then
IList.map replace_dispatch_calls instrs
|> Cfg.Node.replace_instrs node in
let pname = Cfg.Procdesc.get_proc_name pdesc in
|> Procdesc.Node.replace_instrs node in
let pname = Procdesc.get_proc_name pdesc in
if Procname.is_java pname then
Cfg.Procdesc.iter_nodes (node_add_dispatch_calls pname) pdesc
Procdesc.iter_nodes (node_add_dispatch_calls pname) pdesc
(** add instructions to perform abstraction *)
let add_abstraction_instructions pdesc =
let open Cfg in
let open Procdesc in
(* true if there is a succ node s.t.: it is an exit node, or the succ of >1 nodes *)
let converging_node node =
let is_exit node = match Node.get_kind node with
@ -88,7 +88,7 @@ let add_abstraction_instructions pdesc =
let do_node node =
let loc = Node.get_last_loc node in
if node_requires_abstraction node then Node.append_instrs node [Sil.Abstract loc] in
Cfg.Procdesc.iter_nodes do_node pdesc
Procdesc.iter_nodes do_node pdesc
module BackwardCfg = ProcCfg.OneInstrPerNode(ProcCfg.Backward(ProcCfg.Exceptional))
@ -175,12 +175,12 @@ let remove_dead_frontend_stores pdesc liveness_inv_map =
let instr_nodes' = IList.filter_changed is_used_store instr_nodes in
if instr_nodes' != instr_nodes
then
Cfg.Node.replace_instrs node (IList.rev_map fst instr_nodes') in
Cfg.Procdesc.iter_nodes node_remove_dead_stores pdesc
Procdesc.Node.replace_instrs node (IList.rev_map fst instr_nodes') in
Procdesc.iter_nodes node_remove_dead_stores pdesc
let add_nullify_instrs pdesc tenv liveness_inv_map =
let address_taken_vars =
if Procname.is_java (Cfg.Procdesc.get_proc_name pdesc)
if Procname.is_java (Procdesc.get_proc_name pdesc)
then AddressTaken.Domain.empty (* can't take the address of a variable in Java *)
else
match AddressTaken.Analyzer.compute_post (ProcData.make_default pdesc tenv) with
@ -196,17 +196,17 @@ let add_nullify_instrs pdesc tenv liveness_inv_map =
not (Pvar.is_return pvar || Pvar.is_global pvar) in
let node_add_nullify_instructions node pvars =
let loc = Cfg.Node.get_last_loc node in
let loc = Procdesc.Node.get_last_loc node in
let nullify_instrs =
IList.filter is_local pvars
|> IList.map (fun pvar -> Sil.Nullify (pvar, loc)) in
if nullify_instrs <> []
then Cfg.Node.append_instrs node (IList.rev nullify_instrs) in
then Procdesc.Node.append_instrs node (IList.rev nullify_instrs) in
let node_add_removetmps_instructions node ids =
if ids <> [] then
let loc = Cfg.Node.get_last_loc node in
Cfg.Node.append_instrs node [Sil.Remove_temps (IList.rev ids, loc)] in
let loc = Procdesc.Node.get_last_loc node in
Procdesc.Node.append_instrs node [Sil.Remove_temps (IList.rev ids, loc)] in
IList.iter
(fun node ->
@ -282,18 +282,18 @@ let do_copy_propagation pdesc tenv =
(fun node ->
let instrs, changed = rev_transform_node_instrs node in
if changed
then Cfg.Node.replace_instrs node (IList.rev instrs))
(Cfg.Procdesc.get_nodes pdesc)
then Procdesc.Node.replace_instrs node (IList.rev instrs))
(Procdesc.get_nodes pdesc)
let do_liveness pdesc tenv =
let liveness_proc_cfg = BackwardCfg.from_pdesc pdesc in
LivenessAnalysis.exec_cfg liveness_proc_cfg (ProcData.make_default pdesc tenv)
let doit ?(handle_dynamic_dispatch= (Config.dynamic_dispatch = `Sound)) pdesc cg tenv =
if not (Cfg.Procdesc.did_preanalysis pdesc)
if not (Procdesc.did_preanalysis pdesc)
then
begin
Cfg.Procdesc.signal_did_preanalysis pdesc;
Procdesc.signal_did_preanalysis pdesc;
if Config.copy_propagation then do_copy_propagation pdesc tenv;
let liveness_inv_map = do_liveness pdesc tenv in
if Config.dynamic_dispatch <> `Lazy && Config.copy_propagation

2
infer/src/backend/preanal.mli
Unescape View File

@ -13,4 +13,4 @@ open! Utils
(** Preanalysis for eliminating dead local variables *)
(** Perform liveness analysis *)
val doit : ?handle_dynamic_dispatch:bool -> Cfg.Procdesc.t -> Cg.t -> Tenv.t -> unit
val doit : ?handle_dynamic_dispatch:bool -> Procdesc.t -> Cg.t -> Tenv.t -> unit

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

@ -84,9 +84,9 @@ let node_is_visited proc_name node =
| Some summary ->
let stats = summary.Specs.stats in
let is_visited_fp =
IntSet.mem (Cfg.Node.get_id node :> int) stats.Specs.nodes_visited_fp in
IntSet.mem (Procdesc.Node.get_id node :> int) stats.Specs.nodes_visited_fp in
let is_visited_re =
IntSet.mem (Cfg.Node.get_id node :> int) stats.Specs.nodes_visited_re in
IntSet.mem (Procdesc.Node.get_id node :> int) stats.Specs.nodes_visited_re in
is_visited_fp, is_visited_re
(** Return true if the node was visited during analysis *)
@ -100,7 +100,8 @@ let is_visited proc_name node =
when starting and finishing the processing of a node *)
module NodesHtml : sig
val start_node :
int -> Location.t -> Procname.t -> Cfg.Node.t list -> Cfg.Node.t list -> Cfg.Node.t list ->
int -> Location.t -> Procname.t -> Procdesc.Node.t list ->
Procdesc.Node.t list -> Procdesc.Node.t list ->
DB.source_file -> bool
val finish_node : Procname.t -> int -> DB.source_file -> unit
end = struct
@ -131,38 +132,38 @@ end = struct
IList.iter (fun node ->
Io_infer.Html.pp_node_link
[".."]
(Cfg.Node.get_proc_name node)
(Procdesc.Node.get_proc_name node)
~description:""
~preds:(IList.map Cfg.Node.get_id (Cfg.Node.get_preds node) :> int list)
~succs:(IList.map Cfg.Node.get_id (Cfg.Node.get_succs node) :> int list)
~exn:(IList.map Cfg.Node.get_id (Cfg.Node.get_exn node) :> int list)
~preds:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_preds node) :> int list)
~succs:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_succs node) :> int list)
~exn:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_exn node) :> int list)
~isvisited:(is_visited proc_name node)
~isproof:false
fmt (Cfg.Node.get_id node :> int)) preds;
fmt (Procdesc.Node.get_id node :> int)) preds;
F.fprintf fmt "<br>SUCCS: @\n";
IList.iter (fun node ->
Io_infer.Html.pp_node_link
[".."]
(Cfg.Node.get_proc_name node)
(Procdesc.Node.get_proc_name node)
~description:""
~preds:(IList.map Cfg.Node.get_id (Cfg.Node.get_preds node) :> int list)
~succs:(IList.map Cfg.Node.get_id (Cfg.Node.get_succs node) :> int list)
~exn:(IList.map Cfg.Node.get_id (Cfg.Node.get_exn node) :> int list)
~preds:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_preds node) :> int list)
~succs:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_succs node) :> int list)
~exn:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_exn node) :> int list)
~isvisited:(is_visited proc_name node)
~isproof:false
fmt (Cfg.Node.get_id node :> int)) succs;
fmt (Procdesc.Node.get_id node :> int)) succs;
F.fprintf fmt "<br>EXN: @\n";
IList.iter (fun node ->
Io_infer.Html.pp_node_link
[".."]
(Cfg.Node.get_proc_name node)
(Procdesc.Node.get_proc_name node)
~description:""
~preds:(IList.map Cfg.Node.get_id (Cfg.Node.get_preds node) :> int list)
~succs:(IList.map Cfg.Node.get_id (Cfg.Node.get_succs node) :> int list)
~exn:(IList.map Cfg.Node.get_id (Cfg.Node.get_exn node) :> int list)
~preds:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_preds node) :> int list)
~succs:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_succs node) :> int list)
~exn:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_exn node) :> int list)
~isvisited:(is_visited proc_name node)
~isproof:false
fmt (Cfg.Node.get_id node :> int)) exns;
fmt (Procdesc.Node.get_id node :> int)) exns;
F.fprintf fmt "<br>@\n";
F.pp_print_flush fmt ();
true
@ -237,16 +238,16 @@ let force_delayed_print fmt =
let (loc: Location.t) = Obj.obj loc in
Location.pp fmt loc
| (L.PTnode_instrs, b_n) ->
let (b: bool), (io: Sil.instr option), (n: Cfg.Node.t) = Obj.obj b_n in
let (b: bool), (io: Sil.instr option), (n: Procdesc.Node.t) = Obj.obj b_n in
if Config.write_html
then
F.fprintf fmt "%a%a%a"
Io_infer.Html.pp_start_color Green
(Cfg.Node.pp_instrs (pe_html Green) io ~sub_instrs: b) n
(Procdesc.Node.pp_instrs (pe_html Green) io ~sub_instrs: b) n
Io_infer.Html.pp_end_color ()
else
F.fprintf fmt "%a"
(Cfg.Node.pp_instrs pe_text io ~sub_instrs: b) n
(Procdesc.Node.pp_instrs pe_text io ~sub_instrs: b) n
| (L.PToff, off) ->
let (off: Sil.offset) = Obj.obj off in
Sil.pp_offset pe_default fmt off
@ -376,17 +377,17 @@ let force_delayed_prints () =
(** Start a session, and create a new html fine for the node if it does not exist yet *)
let start_session node (loc: Location.t) proc_name session source =
let node_id = Cfg.Node.get_id node in
let node_id = Procdesc.Node.get_id node in
(if NodesHtml.start_node
(node_id :> int) loc proc_name
(Cfg.Node.get_preds node)
(Cfg.Node.get_succs node)
(Cfg.Node.get_exn node)
(Procdesc.Node.get_preds node)
(Procdesc.Node.get_succs node)
(Procdesc.Node.get_exn node)
source
then
F.fprintf !curr_html_formatter "%a<LISTING>%a</LISTING>%a"
Io_infer.Html.pp_start_color Green
(Cfg.Node.pp_instrs (pe_html Green) None ~sub_instrs: true) node
(Procdesc.Node.pp_instrs (pe_html Green) None ~sub_instrs: true) node
Io_infer.Html.pp_end_color ());
F.fprintf !curr_html_formatter "%a%a"
Io_infer.Html.pp_hline ()
@ -406,7 +407,10 @@ let node_finish_session node source =
if Config.write_html then begin
F.fprintf !curr_html_formatter "</LISTING>%a"
Io_infer.Html.pp_end_color ();
NodesHtml.finish_node (Cfg.Node.get_proc_name node) (Cfg.Node.get_id node :> int) source
NodesHtml.finish_node
(Procdesc.Node.get_proc_name node)
(Procdesc.Node.get_id node :> int)
source
end
(** Write html file for the procedure.
@ -414,9 +418,9 @@ let node_finish_session node source =
let write_proc_html source whole_seconds pdesc =
if Config.write_html then
begin
let pname = Cfg.Procdesc.get_proc_name pdesc in
let nodes = IList.sort Cfg.Node.compare (Cfg.Procdesc.get_nodes pdesc) in
let linenum = (Cfg.Node.get_loc (IList.hd nodes)).Location.line in
let pname = Procdesc.get_proc_name pdesc in
let nodes = IList.sort Procdesc.Node.compare (Procdesc.get_nodes pdesc) in
let linenum = (Procdesc.Node.get_loc (IList.hd nodes)).Location.line in
let fd, fmt =
Io_infer.Html.create
(DB.Results_dir.Abs_source_dir source)
@ -430,14 +434,14 @@ let write_proc_html source whole_seconds pdesc =
(fun n ->
Io_infer.Html.pp_node_link
[]
(Cfg.Node.get_proc_name n)
~description:(Cfg.Node.get_description (pe_html Black) n)
~preds:(IList.map Cfg.Node.get_id (Cfg.Node.get_preds n) :> int list)
~succs:(IList.map Cfg.Node.get_id (Cfg.Node.get_succs n) :> int list)
~exn:(IList.map Cfg.Node.get_id (Cfg.Node.get_exn n) :> int list)
(Procdesc.Node.get_proc_name n)
~description:(Procdesc.Node.get_description (pe_html Black) n)
~preds:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_preds n) :> int list)
~succs:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_succs n) :> int list)
~exn:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_exn n) :> int list)
~isvisited:(is_visited pname n)
~isproof:false
fmt (Cfg.Node.get_id n :> int))
fmt (Procdesc.Node.get_id n :> int))
nodes;
(match Specs.get_summary pname with
| None ->
@ -468,24 +472,24 @@ let create_err_message err_string =
"\n<div class=\"msg\" style=\"margin-left:9ex\">" ^ err_string ^ "</div>"
let write_html_proc source proof_cover table_nodes_at_linenum global_err_log proc_desc =
let proc_name = Cfg.Procdesc.get_proc_name proc_desc in
let proc_name = Procdesc.get_proc_name proc_desc in
let process_node n =
let lnum = (Cfg.Node.get_loc n).Location.line in
let lnum = (Procdesc.Node.get_loc n).Location.line in
let curr_nodes =
try Hashtbl.find table_nodes_at_linenum lnum
with Not_found -> [] in
Hashtbl.replace table_nodes_at_linenum lnum ((n, proc_desc) :: curr_nodes) in
let proc_loc = Cfg.Procdesc.get_loc proc_desc in
let proc_loc = Procdesc.get_loc proc_desc in
let process_proc =
Cfg.Procdesc.is_defined proc_desc &&
Procdesc.is_defined proc_desc &&
DB.source_file_equal proc_loc.Location.file source &&
match AttributesTable.find_file_capturing_procedure proc_name with
| None -> true
| Some (source_captured, _) ->
DB.source_file_equal source_captured (Cfg.Procdesc.get_loc proc_desc).file in
DB.source_file_equal source_captured (Procdesc.get_loc proc_desc).file in
if process_proc then
begin
IList.iter process_node (Cfg.Procdesc.get_nodes proc_desc);
IList.iter process_node (Procdesc.get_nodes proc_desc);
match Specs.get_summary proc_name with
| None ->
()
@ -539,22 +543,22 @@ let write_html_file linereader filename procs =
IList.iter
(fun (n, pdesc) ->
let isproof =
Specs.Visitedset.mem (Cfg.Node.get_id n, []) !proof_cover in
Specs.Visitedset.mem (Procdesc.Node.get_id n, []) !proof_cover in
Io_infer.Html.pp_node_link
[fname_encoding]
(Cfg.Node.get_proc_name n)
~description:(Cfg.Node.get_description (pe_html Black) n)
~preds:(IList.map Cfg.Node.get_id (Cfg.Node.get_preds n) :> int list)
~succs:(IList.map Cfg.Node.get_id (Cfg.Node.get_succs n) :> int list)
~exn:(IList.map Cfg.Node.get_id (Cfg.Node.get_exn n) :> int list)
~isvisited:(is_visited (Cfg.Procdesc.get_proc_name pdesc) n)
(Procdesc.Node.get_proc_name n)
~description:(Procdesc.Node.get_description (pe_html Black) n)
~preds:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_preds n) :> int list)
~succs:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_succs n) :> int list)
~exn:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_exn n) :> int list)
~isvisited:(is_visited (Procdesc.get_proc_name pdesc) n)
~isproof
fmt (Cfg.Node.get_id n :> int))
fmt (Procdesc.Node.get_id n :> int))
nodes_at_linenum;
IList.iter
(fun (n, _) ->
match Cfg.Node.get_kind n with
| Cfg.Node.Start_node proc_name ->
match Procdesc.Node.get_kind n with
| Procdesc.Node.Start_node proc_name ->
let num_specs = IList.length (Specs.get_specs proc_name) in
let label =
(Escape.escape_xml (Procname.to_string proc_name)) ^
@ -599,9 +603,9 @@ let write_all_html_files exe_env =
let files = ref DB.SourceFileSet.empty in
Cfg.iter_proc_desc cfg
(fun _ proc_desc ->
if Cfg.Procdesc.is_defined proc_desc
if Procdesc.is_defined proc_desc
then
let file = (Cfg.Procdesc.get_loc proc_desc).Location.file in
let file = (Procdesc.get_loc proc_desc).Location.file in
files := DB.SourceFileSet.add file !files);
!files in
DB.SourceFileSet.iter

11
infer/src/backend/printer.mli
Unescape View File

@ -37,19 +37,20 @@ val curr_html_formatter : Format.formatter ref
val force_delayed_prints : unit -> unit
(** Finish a session, and perform delayed print actions if required *)
val node_finish_session : Cfg.Node.t -> DB.source_file -> unit
val node_finish_session : Procdesc.Node.t -> DB.source_file -> unit
(** Return true if the node was visited during footprint and during re-execution *)
val node_is_visited : Procname.t -> Cfg.Node.t -> bool * bool
val node_is_visited : Procname.t -> Procdesc.Node.t -> bool * bool
(** Start a session, and create a new html fine for the node if it does not exist yet *)
val node_start_session : Cfg.Node.t -> Location.t -> Procname.t -> int -> DB.source_file -> unit
val node_start_session :
Procdesc.Node.t -> Location.t -> Procname.t -> int -> DB.source_file -> unit
(** Write html file for the procedure.
The boolean indicates whether to print whole seconds only. *)
val write_proc_html : DB.source_file -> bool -> Cfg.Procdesc.t -> unit
val write_proc_html : DB.source_file -> bool -> Procdesc.t -> unit
val write_html_file : LineReader.t -> DB.source_file -> Cfg.Procdesc.t list -> unit
val write_html_file : LineReader.t -> DB.source_file -> Procdesc.t list -> unit
(** Create filename.ext.html for each file in the exe_env. *)
val write_all_html_files : Exe_env.t -> unit

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

@ -861,7 +861,7 @@ let check_inconsistency_base tenv prop =
| None -> false
| Some (_, _, pdesc) ->
let procedure_attr =
Cfg.Procdesc.get_attributes pdesc in
Procdesc.get_attributes pdesc in
let is_java_this pvar =
procedure_attr.ProcAttributes.language = Config.Java && Pvar.is_this pvar in
let is_objc_instance_self pvar =

24
infer/src/backend/rearrange.ml
Unescape View File

@ -613,7 +613,7 @@ let prop_iter_add_hpred_footprint_to_prop pname tenv prop (lexp, typ) inst =
expressing the safety conditions for the access. Complain if these conditions cannot be met. *)
let add_guarded_by_constraints tenv prop lexp pdesc =
let lookup = Tenv.lookup tenv in
let pname = Cfg.Procdesc.get_proc_name pdesc in
let pname = Procdesc.get_proc_name pdesc in
let excluded_guardedby_string str =
(* nothing with a space in it can be a valid Java expression, shouldn't warn *)
let is_invalid_exp_str str =
@ -729,7 +729,7 @@ let add_guarded_by_constraints tenv prop lexp pdesc =
(* return true if [pdesc] has an annotation that matches [guarded_by_str] *)
let proc_has_matching_annot pdesc guarded_by_str =
let proc_signature =
Annotations.get_annotated_signature (Cfg.Procdesc.get_attributes pdesc) in
Annotations.get_annotated_signature (Procdesc.get_attributes pdesc) in
let proc_annot, _ = proc_signature.Annotations.ret in
match extract_guarded_by_str proc_annot with
| Some proc_guarded_by_str ->
@ -738,7 +738,7 @@ let add_guarded_by_constraints tenv prop lexp pdesc =
| None -> false in
let is_synchronized_on_class guarded_by_str =
guarded_by_str_is_current_class guarded_by_str pname &&
Cfg.Procdesc.is_java_synchronized pdesc && Procname.java_is_static pname in
Procdesc.is_java_synchronized pdesc && Procname.java_is_static pname in
let warn accessed_fld guarded_by_str =
let loc = State.get_loc () in
let err_desc =
@ -755,9 +755,9 @@ let add_guarded_by_constraints tenv prop lexp pdesc =
let has_lock guarded_by_exp =
(* procedure is synchronized and guarded by this *)
(guarded_by_str_is_current_class_this guarded_by_str pname &&
Cfg.Procdesc.is_java_synchronized pdesc) ||
Procdesc.is_java_synchronized pdesc) ||
(guarded_by_str_is_current_class guarded_by_str pname &&
Cfg.Procdesc.is_java_synchronized pdesc && Procname.java_is_static pname) ||
Procdesc.is_java_synchronized pdesc && Procname.java_is_static pname) ||
(* or the prop says we already have the lock *)
IList.exists
(function
@ -769,7 +769,7 @@ let add_guarded_by_constraints tenv prop lexp pdesc =
string_is_suffix guarded_by_str (Ident.fieldname_to_string accessed_fld) in
let proc_has_suppress_guarded_by_annot pdesc =
let proc_signature =
Annotations.get_annotated_signature (Cfg.Procdesc.get_attributes pdesc) in
Annotations.get_annotated_signature (Procdesc.get_attributes pdesc) in
let proc_annot, _ = proc_signature.Annotations.ret in
match extract_suppress_warnings_str proc_annot with
| Some suppression_str->
@ -795,9 +795,9 @@ let add_guarded_by_constraints tenv prop lexp pdesc =
flds
| _ -> false)
prop.Prop.sigma in
Cfg.Procdesc.get_access pdesc <> PredSymb.Private &&
Procdesc.get_access pdesc <> PredSymb.Private &&
not (Annotations.pdesc_has_annot pdesc Annotations.visibleForTesting) &&
not (Procname.java_is_access_method (Cfg.Procdesc.get_proc_name pdesc)) &&
not (Procname.java_is_access_method (Procdesc.get_proc_name pdesc)) &&
not (is_accessible_through_local_ref lexp) &&
not guardedby_is_self_referential &&
not (proc_has_suppress_guarded_by_annot pdesc)
@ -1214,7 +1214,7 @@ let rec iter_rearrange
res
let is_weak_captured_var pdesc pvar =
let pname = Cfg.Procdesc.get_proc_name pdesc in
let pname = Procdesc.get_proc_name pdesc in
match pname with
| Block _ ->
let is_weak_captured (var, typ) =
@ -1222,7 +1222,7 @@ let is_weak_captured_var pdesc pvar =
| Typ.Tptr (_, Pk_objc_weak) ->
Mangled.equal (Pvar.get_name pvar) var
| _ -> false in
IList.exists is_weak_captured (Cfg.Procdesc.get_captured pdesc)
IList.exists is_weak_captured (Procdesc.get_captured pdesc)
| _ -> false
@ -1363,7 +1363,7 @@ let check_call_to_objc_block_error tenv pdesc prop fun_exp loc =
match get_exp_called () with
| Some (_, Exp.Lvar pvar) -> (* pvar is the block *)
let name = Pvar.get_name pvar in
IList.exists (fun (cn, _) -> (Mangled.equal name cn)) (Cfg.Procdesc.get_captured pdesc)
IList.exists (fun (cn, _) -> (Mangled.equal name cn)) (Procdesc.get_captured pdesc)
| _ -> false in
let is_field_deref () = (*Called expression is a field *)
match get_exp_called () with
@ -1422,7 +1422,7 @@ let rearrange ?(report_deref_errors=true) pdesc tenv lexp typ prop loc
L.d_str "Exp: "; Sil.d_exp nlexp; L.d_ln ();
L.d_str "Prop: "; L.d_ln(); Prop.d_prop prop; L.d_ln (); L.d_ln ();
if report_deref_errors then check_dereference_error tenv pdesc prop nlexp (State.get_loc ());
let pname = Cfg.Procdesc.get_proc_name pdesc in
let pname = Procdesc.get_proc_name pdesc in
let prop' =
if Config.csl_analysis && !Config.footprint && Procname.is_java pname &&
not (Procname.is_constructor pname || Procname.is_class_initializer pname)

6
infer/src/backend/rearrange.mli
Unescape View File

@ -16,17 +16,17 @@ exception ARRAY_ACCESS
(** Check for dereference errors: dereferencing 0, a freed value, or an undefined value *)
val check_dereference_error :
Tenv.t -> Cfg.Procdesc.t -> Prop.normal Prop.t -> Exp.t -> Location.t -> unit
Tenv.t -> Procdesc.t -> Prop.normal Prop.t -> Exp.t -> Location.t -> unit
(** Check that an expression representing an objc block can be null and raise a [B1] null exception.
It's used to check that we don't call possibly null blocks *)
val check_call_to_objc_block_error :
Tenv.t -> Cfg.Procdesc.t -> Prop.normal Prop.t -> Exp.t -> Location.t -> unit
Tenv.t -> Procdesc.t -> Prop.normal Prop.t -> Exp.t -> Location.t -> unit
(** [rearrange lexp prop] rearranges [prop] into the form [prop' * lexp|->strexp:typ].
It returns an iterator with [lexp |-> strexp: typ] as current predicate
and the path (an [offsetlist]) which leads to [lexp] as the iterator state. *)
val rearrange :
?report_deref_errors:bool -> Cfg.Procdesc.t -> Tenv.t -> Exp.t ->
?report_deref_errors:bool -> Procdesc.t -> Tenv.t -> Exp.t ->
Typ.t -> Prop.normal Prop.t ->
Location.t -> (Sil.offset list) Prop.prop_iter list

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

@ -143,8 +143,8 @@ end
module Visitedset =
Set.Make (struct
type t = Cfg.Node.id * int list
let compare (node_id1, _) (node_id2, _) = Cfg.Node.id_compare node_id1 node_id2
type t = Procdesc.Node.id * int list
let compare (node_id1, _) (node_id2, _) = Procdesc.Node.id_compare node_id1 node_id2
end)
let visited_str vis =
@ -331,7 +331,7 @@ type payload =
type summary =
{ dependency_map: dependency_map_t; (** maps children procs to timestamp as last seen at the start of an analysys phase for this proc *)
nodes: Cfg.Node.id list; (** ids of cfg nodes of the procedure *)
nodes: Procdesc.Node.id list; (** ids of cfg nodes of the procedure *)
phase: phase; (** in FOOTPRINT phase or in RE_EXECUTION PHASE *)
payload: payload; (** payload containing the result of some analysis *)
sessions: int ref; (** Session number: how many nodes went trough symbolic execution *)
@ -339,7 +339,7 @@ type summary =
status: status; (** ACTIVE when the proc is being analyzed *)
timestamp: int; (** Timestamp of the specs, >= 0, increased every time the specs change *)
attributes : ProcAttributes.t; (** Attributes of the procedure *)
proc_desc_option : Cfg.Procdesc.t option;
proc_desc_option : Procdesc.t option;
}
type spec_tbl = (summary * DB.origin) Procname.Hash.t
@ -668,7 +668,7 @@ let proc_resolve_attributes proc_name =
(** Like proc_resolve_attributes but start from a proc_desc. *)
let pdesc_resolve_attributes proc_desc =
let proc_name = Cfg.Procdesc.get_proc_name proc_desc in
let proc_name = Procdesc.get_proc_name proc_desc in
match proc_resolve_attributes proc_name with
| Some proc_attributes ->
proc_attributes

14
infer/src/backend/specs.mli
Unescape View File

@ -61,7 +61,7 @@ module Jprop : sig
end
(** set of visited nodes: node id and list of lines of all the instructions *)
module Visitedset : Set.S with type elt = Cfg.Node.id * int list
module Visitedset : Set.S with type elt = Procdesc.Node.id * int list
(** convert a Visitedset to a string *)
val visited_str : Visitedset.t -> string
@ -136,7 +136,7 @@ type payload =
(** Procedure summary *)
type summary =
{ dependency_map: dependency_map_t; (** maps children procs to timestamp as last seen at the start of an analysys phase for this proc *)
nodes: Cfg.Node.id list; (** ids of cfg nodes of the procedure *)
nodes: Procdesc.Node.id list; (** ids of cfg nodes of the procedure *)
phase: phase; (** in FOOTPRINT phase or in RE_EXECUTION PHASE *)
payload: payload; (** payload containing the result of some analysis *)
sessions: int ref; (** Session number: how many nodes went trough symbolic execution *)
@ -144,7 +144,7 @@ type summary =
status: status; (** ACTIVE when the proc is being analyzed *)
timestamp: int; (** Timestamp of the specs, >= 0, increased every time the specs change *)
attributes : ProcAttributes.t; (** Attributes of the procedure *)
proc_desc_option : Cfg.Procdesc.t option;
proc_desc_option : Procdesc.t option;
}
(** Add the summary to the table for the given function *)
@ -211,16 +211,16 @@ val is_active : summary -> bool
Do nothing if a summary exists already. *)
val init_summary :
(Procname.t list * (* depend list *)
Cfg.Node.id list * (* nodes *)
Procdesc.Node.id list * (* nodes *)
proc_flags * (* procedure flags *)
(Procname.t * Location.t) list * (* calls *)
(Cg.in_out_calls option) * (* in and out calls *)
ProcAttributes.t * (* attributes of the procedure *)
Cfg.Procdesc.t option) (* procdesc option *)
Procdesc.t option) (* procdesc option *)
-> unit
(** Reset a summary rebuilding the dependents and preserving the proc attributes if present. *)
val reset_summary : Cg.t -> Procname.t -> ProcAttributes.t option -> Cfg.Procdesc.t option -> unit
val reset_summary : Cg.t -> Procname.t -> ProcAttributes.t option -> Procdesc.t option -> unit
(** Load procedure summary from the given file *)
val load_summary : DB.filename -> summary option
@ -248,7 +248,7 @@ val pp_summary_latex : whole_seconds:bool -> color -> Format.formatter -> summar
val pp_summary_text : whole_seconds:bool -> Format.formatter -> summary -> unit
(** Like proc_resolve_attributes but start from a proc_desc. *)
val pdesc_resolve_attributes : Cfg.Procdesc.t -> ProcAttributes.t
val pdesc_resolve_attributes : Procdesc.t -> ProcAttributes.t
(** Try to find the attributes for a defined proc.
First look at specs (to get attributes computed by analysis)

54
infer/src/backend/state.ml
Unescape View File

@ -15,7 +15,7 @@ open! Utils
module L = Logging
module F = Format
type const_map = Cfg.Node.t -> Exp.t -> Const.t option
type const_map = Procdesc.Node.t -> Exp.t -> Const.t option
(** failure statistics for symbolic execution on a given node *)
type failure_stats = {
@ -28,7 +28,7 @@ type failure_stats = {
(* exception at the first failure *)
}
module NodeHash = Cfg.NodeHash
module NodeHash = Procdesc.NodeHash
type t = {
mutable const_map : const_map;
@ -43,13 +43,13 @@ type t = {
mutable last_instr : Sil.instr option;
(** Last instruction seen *)
mutable last_node : Cfg.Node.t;
mutable last_node : Procdesc.Node.t;
(** Last node seen *)
mutable last_path : (Paths.Path.t * (PredSymb.path_pos option)) option;
(** Last path seen *)
mutable last_prop_tenv_pdesc : (Prop.normal Prop.t * Tenv.t * Cfg.Procdesc.t) option;
mutable last_prop_tenv_pdesc : (Prop.normal Prop.t * Tenv.t * Procdesc.t) option;
(** Last prop,tenv,pdesc seen *)
mutable last_session : int;
@ -64,7 +64,7 @@ let initial () = {
diverging_states_node = Paths.PathSet.empty;
diverging_states_proc = Paths.PathSet.empty;
last_instr = None;
last_node = Cfg.Node.dummy ();
last_node = Procdesc.Node.dummy ();
last_path = None;
last_prop_tenv_pdesc = None;
last_session = 0;
@ -112,7 +112,7 @@ let get_instr () =
let get_loc () = match !gs.last_instr with
| Some instr -> Sil.instr_get_loc instr
| None -> Cfg.Node.get_loc !gs.last_node
| None -> Procdesc.Node.get_loc !gs.last_node
let get_node () =
!gs.last_node
@ -133,13 +133,13 @@ let node_simple_key node =
| Sil.Abstract _ -> add_key 6
| Sil.Remove_temps _ -> add_key 7
| Sil.Declare_locals _ -> add_key 8 in
IList.iter do_instr (Cfg.Node.get_instrs node);
IList.iter do_instr (Procdesc.Node.get_instrs node);
Hashtbl.hash !key
(** key for a node: look at the current node, successors and predecessors *)
let node_key node =
let succs = Cfg.Node.get_succs node in
let preds = Cfg.Node.get_preds node in
let succs = Procdesc.Node.get_succs node in
let preds = Procdesc.Node.get_preds node in
let v = (node_simple_key node, IList.map node_simple_key succs, IList.map node_simple_key preds) in
Hashtbl.hash v
@ -161,25 +161,25 @@ let instrs_normalize instrs =
(** Create a function to find duplicate nodes.
A node is a duplicate of another one if they have the same kind and location
and normalized (w.r.t. renaming of let - bound ids) list of instructions. *)
let mk_find_duplicate_nodes proc_desc : (Cfg.Node.t -> Cfg.NodeSet.t) =
let mk_find_duplicate_nodes proc_desc : (Procdesc.Node.t -> Procdesc.NodeSet.t) =
let module M = (* map from (loc,kind) *)
Map.Make(struct
type t = Location.t * Cfg.Node.nodekind
type t = Location.t * Procdesc.Node.nodekind
let compare (loc1, k1) (loc2, k2) =
let n = Location.compare loc1 loc2 in
if n <> 0 then n else Cfg.Node.kind_compare k1 k2
if n <> 0 then n else Procdesc.Node.kind_compare k1 k2
end) in
let module S = (* set of nodes with normalized insructions *)
Set.Make(struct
type t = Cfg.Node.t * Sil.instr list
type t = Procdesc.Node.t * Sil.instr list
let compare (n1, _) (n2, _) =
Cfg.Node.compare n1 n2
Procdesc.Node.compare n1 n2
end) in
let get_key node = (* map key *)
let loc = Cfg.Node.get_loc node in
let kind = Cfg.Node.get_kind node in
let loc = Procdesc.Node.get_loc node in
let kind = Procdesc.Node.get_kind node in
(loc, kind) in
let map =
@ -192,14 +192,14 @@ let mk_find_duplicate_nodes proc_desc : (Cfg.Node.t -> Cfg.NodeSet.t) =
end in
let do_node node =
let normalized_instrs = instrs_normalize (Cfg.Node.get_instrs node) in
let normalized_instrs = instrs_normalize (Procdesc.Node.get_instrs node) in
let key = get_key node in
let s = try M.find key !m with Not_found -> S.empty in
if S.cardinal s > E.threshold then raise E.Threshold;
let s' = S.add (node, normalized_instrs) s in
m := M.add key s' !m in
let nodes = Cfg.Procdesc.get_nodes proc_desc in
let nodes = Procdesc.get_nodes proc_desc in
try
IList.iter do_node nodes;
!m
@ -211,7 +211,7 @@ let mk_find_duplicate_nodes proc_desc : (Cfg.Node.t -> Cfg.NodeSet.t) =
let s = M.find (get_key node) map in
let elements = S.elements s in
let (_, node_normalized_instrs), _ =
let filter (node', _) = Cfg.Node.equal node node' in
let filter (node', _) = Procdesc.Node.equal node node' in
match IList.partition filter elements with
| [this], others -> this, others
| _ -> raise Not_found in
@ -220,17 +220,17 @@ let mk_find_duplicate_nodes proc_desc : (Cfg.Node.t -> Cfg.NodeSet.t) =
IList.compare Sil.instr_compare node_normalized_instrs normalized_instrs' = 0 in
IList.filter equal_normalized_instrs elements in
IList.fold_left
(fun nset (node', _) -> Cfg.NodeSet.add node' nset)
Cfg.NodeSet.empty duplicates
with Not_found -> Cfg.NodeSet.singleton node in
(fun nset (node', _) -> Procdesc.NodeSet.add node' nset)
Procdesc.NodeSet.empty duplicates
with Not_found -> Procdesc.NodeSet.singleton node in
find_duplicate_nodes
let get_node_id () =
Cfg.Node.get_id !gs.last_node
Procdesc.Node.get_id !gs.last_node
let get_node_id_key () =
(Cfg.Node.get_id !gs.last_node, node_key !gs.last_node)
(Procdesc.Node.get_id !gs.last_node, node_key !gs.last_node)
let get_inst_update pos =
let loc = get_loc () in
@ -274,7 +274,7 @@ let get_session () =
let get_path_pos () =
let pname = match get_prop_tenv_pdesc () with
| Some (_, _, pdesc) -> Cfg.Procdesc.get_proc_name pdesc
| Some (_, _, pdesc) -> Procdesc.get_proc_name pdesc
| None -> Procname.from_string_c_fun "unknown_procedure" in
let nid = get_node_id () in
(pname, (nid :> int))
@ -317,7 +317,7 @@ type log_issue =
let process_execution_failures (log_issue : log_issue) pname =
let do_failure _ fs =
(* L.err "Node:%a node_ok:%d node_fail:%d@." Cfg.Node.pp node fs.node_ok fs.node_fail; *)
(* L.err "Node:%a node_ok:%d node_fail:%d@." Procdesc.Node.pp node fs.node_ok fs.node_fail; *)
match fs.node_ok, fs.first_failure with
| 0, Some (loc, key, _, loc_trace, exn) ->
let ex_name, _, ml_loc_opt, _, _, _, _ = Exceptions.recognize_exception exn in
@ -336,7 +336,7 @@ let set_path path pos_opt =
let set_prop_tenv_pdesc prop tenv pdesc =
!gs.last_prop_tenv_pdesc <- Some (prop, tenv, pdesc)
let set_node (node: Cfg.Node.t) =
let set_node (node: Procdesc.Node.t) =
!gs.last_instr <- None;
!gs.last_node <- node

20
infer/src/backend/state.mli
Unescape View File

@ -18,7 +18,7 @@ type t
(** Add diverging states *)
val add_diverging_states : Paths.PathSet.t -> unit
type const_map = Cfg.Node.t -> Exp.t -> Const.t option
type const_map = Procdesc.Node.t -> Exp.t -> Const.t option
(** Get the constant map for the current procedure. *)
val get_const_map : unit -> const_map
@ -42,13 +42,13 @@ val get_loc : unit -> Location.t
val get_loc_trace : unit -> Errlog.loc_trace
(** Get last node seen in symbolic execution *)
val get_node : unit -> Cfg.Node.t
val get_node : unit -> Procdesc.Node.t
(** Get id of last node seen in symbolic execution *)
val get_node_id : unit -> Cfg.Node.id
val get_node_id : unit -> Procdesc.Node.id
(** Get id and key of last node seen in symbolic execution *)
val get_node_id_key : unit -> Cfg.Node.id * int
val get_node_id_key : unit -> Procdesc.Node.id * int
(** return the normalized precondition extracted form the last prop seen, if any
the abstraction function is a parameter to get around module dependencies *)
@ -62,16 +62,16 @@ val get_path : unit -> Paths.Path.t * (PredSymb.path_pos option)
val get_path_pos : unit -> PredSymb.path_pos
(** Get last last prop,tenv,pdesc seen in symbolic execution *)
val get_prop_tenv_pdesc : unit -> (Prop.normal Prop.t * Tenv.t * Cfg.Procdesc.t) option
val get_prop_tenv_pdesc : unit -> (Prop.normal Prop.t * Tenv.t * Procdesc.t) option
(** Get last session seen in symbolic execution *)
val get_session : unit -> int
(** Mark the end of symbolic execution of a node *)
val mark_execution_end : Cfg.Node.t -> unit
val mark_execution_end : Procdesc.Node.t -> unit
(** Mark the start of symbolic execution of a node *)
val mark_execution_start : Cfg.Node.t -> unit
val mark_execution_start : Procdesc.Node.t -> unit
(** Mark that the execution of the current instruction failed *)
val mark_instr_fail : exn -> unit
@ -82,7 +82,7 @@ val mark_instr_ok : unit -> unit
(** Create a function to find duplicate nodes.
A node is a duplicate of another one if they have the same kind and location
and normalized (w.r.t. renaming of let - bound ids) list of instructions. *)
val mk_find_duplicate_nodes: Cfg.Procdesc.t -> (Cfg.Node.t -> Cfg.NodeSet.t)
val mk_find_duplicate_nodes: Procdesc.t -> (Procdesc.Node.t -> Procdesc.NodeSet.t)
type log_issue =
Procname.t ->
@ -115,13 +115,13 @@ val set_const_map : const_map -> unit
val set_instr : Sil.instr -> unit
(** Set last node seen in symbolic execution *)
val set_node : Cfg.Node.t -> unit
val set_node : Procdesc.Node.t -> unit
(** Get last path seen in symbolic execution *)
val set_path : Paths.Path.t -> PredSymb.path_pos option -> unit
(** Set last prop,tenv,pdesc seen in symbolic execution *)
val set_prop_tenv_pdesc : Prop.normal Prop.t -> Tenv.t -> Cfg.Procdesc.t -> unit
val set_prop_tenv_pdesc : Prop.normal Prop.t -> Tenv.t -> Procdesc.t -> unit
(** Set last session seen in symbolic execution *)
val set_session : int -> unit

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

@ -47,7 +47,7 @@ let unroll_type tenv (typ: Typ.t) (off: Sil.offset) =
let get_blocks_nullified node =
let null_blocks = IList.flatten(IList.map (fun i -> match i with
| Sil.Nullify(pvar, _) when Sil.is_block_pvar pvar -> [pvar]
| _ -> []) (Cfg.Node.get_instrs node)) in
| _ -> []) (Procdesc.Node.get_instrs node)) in
null_blocks
(** Given a proposition and an objc block checks whether by existentially quantifying
@ -83,7 +83,7 @@ let check_block_retain_cycle tenv caller_pname prop block_nullified =
let rec apply_offlist
pdesc tenv p fp_root nullify_struct (root_lexp, strexp, typ) offlist
(f: Exp.t option -> Exp.t) inst lookup_inst =
let pname = Cfg.Procdesc.get_proc_name pdesc in
let pname = Procdesc.get_proc_name pdesc in
let pp_error () =
L.d_strln ".... Invalid Field ....";
L.d_str "strexp : "; Sil.d_sexp strexp; L.d_ln ();
@ -803,7 +803,7 @@ let add_constraints_on_retval tenv pdesc prop ret_exp ~has_nullable_annot typ ca
if Procname.is_infer_undefined callee_pname then prop
else
let is_rec_call pname = (* TODO: (t7147096) extend this to detect mutual recursion *)
Procname.equal pname (Cfg.Procdesc.get_proc_name pdesc) in
Procname.equal pname (Procdesc.get_proc_name pdesc) in
let already_has_abduced_retval p abduced_ret_pv =
IList.exists
(fun hpred -> match hpred with
@ -977,7 +977,7 @@ let execute_store ?(report_deref_errors=true) pname pdesc tenv lhs_exp typ rhs_e
(** Execute [instr] with a symbolic heap [prop].*)
let rec sym_exec tenv current_pdesc _instr (prop_: Prop.normal Prop.t) path
: (Prop.normal Prop.t * Paths.Path.t) list =
let current_pname = Cfg.Procdesc.get_proc_name current_pdesc in
let current_pname = Procdesc.get_proc_name current_pdesc in
State.set_instr _instr; (* mark instruction last seen *)
State.set_prop_tenv_pdesc prop_ tenv current_pdesc; (* mark prop,tenv,pdesc last seen *)
SymOp.pay(); (* pay one symop *)
@ -1118,7 +1118,7 @@ let rec sym_exec tenv current_pdesc _instr (prop_: Prop.normal Prop.t) path
Ondemand.analyze_proc_name
tenv ~propagate_exceptions:true current_pdesc resolved_pname;
let callee_pdesc_opt = Ondemand.get_proc_desc resolved_pname in
let ret_typ_opt = Option.map Cfg.Procdesc.get_ret_type callee_pdesc_opt in
let ret_typ_opt = Option.map Procdesc.get_ret_type callee_pdesc_opt in
let sentinel_result =
if !Config.curr_language = Config.Clang then
check_variadic_sentinel_if_present
@ -1129,7 +1129,7 @@ let rec sym_exec tenv current_pdesc _instr (prop_: Prop.normal Prop.t) path
if Option.map_default call_should_be_skipped true resolved_summary_opt then
(* If it's an ObjC getter or setter, call the builtin rather than skipping *)
let attrs_opt =
let attr_opt = Option.map Cfg.Procdesc.get_attributes callee_pdesc_opt in
let attr_opt = Option.map Procdesc.get_attributes callee_pdesc_opt in
match attr_opt, resolved_pname with
| Some attrs, Procname.ObjC_Cpp _ -> Some attrs
| None, Procname.ObjC_Cpp _ -> AttributesTable.load_attributes resolved_pname
@ -1426,7 +1426,7 @@ and unknown_or_scan_call ~is_scan ret_type_option ret_annots
| _ ->
pre_1 in
let pre_3 = add_constraints_on_actuals_by_ref tenv pre_2 actuals_by_ref callee_pname loc in
let caller_pname = Cfg.Procdesc.get_proc_name pdesc in
let caller_pname = Procdesc.get_proc_name pdesc in
add_tainted_pre pre_3 args caller_pname callee_pname in
if is_scan (* if scan function, don't mark anything with undef attributes *)
then [(Tabulation.remove_constant_string_class tenv pre_final, path)]
@ -1523,13 +1523,13 @@ and sym_exec_objc_accessor property_accesor ret_typ tenv ret_id pdesc _ loc args
| ProcAttributes.Objc_setter field_name -> sym_exec_objc_setter field_name in
(* we want to execute in the context of the current procedure, not in the context of callee_pname,
since this is the procname of the setter/getter method *)
let cur_pname = Cfg.Procdesc.get_proc_name pdesc in
let cur_pname = Procdesc.get_proc_name pdesc in
f_accessor ret_typ tenv ret_id pdesc cur_pname loc args prop
|> IList.map (fun p -> (p, path))
(** Perform symbolic execution for a function call *)
and proc_call summary {Builtin.pdesc; tenv; prop_= pre; path; ret_id; args= actual_pars; loc; } =
let caller_pname = Cfg.Procdesc.get_proc_name pdesc in
let caller_pname = Procdesc.get_proc_name pdesc in
let callee_pname = Specs.get_proc_name summary in
let ret_typ = Specs.get_ret_type summary in
let check_return_value_ignored () =
@ -1588,7 +1588,7 @@ and proc_call summary {Builtin.pdesc; tenv; prop_= pre; path; ret_id; args= actu
(** perform symbolic execution for a single prop, and check for junk *)
and sym_exec_wrapper handle_exn tenv pdesc instr ((prop: Prop.normal Prop.t), path)
: Paths.PathSet.t =
let pname = Cfg.Procdesc.get_proc_name pdesc in
let pname = Procdesc.get_proc_name pdesc in
let prop_primed_to_normal p = (* Rename primed vars with fresh normal vars, and return them *)
let fav = Prop.prop_fav p in
Sil.fav_filter_ident fav Ident.is_primed;
@ -1623,10 +1623,10 @@ and sym_exec_wrapper handle_exn tenv pdesc instr ((prop: Prop.normal Prop.t), pa
let instr_is_abstraction = function
| Sil.Abstract _ -> true
| _ -> false in
IList.exists instr_is_abstraction (Cfg.Node.get_instrs node) in
IList.exists instr_is_abstraction (Procdesc.Node.get_instrs node) in
let curr_node = State.get_node () in
match Cfg.Node.get_kind curr_node with
| Cfg.Node.Prune_node _ when not (node_has_abstraction curr_node) ->
match Procdesc.Node.get_kind curr_node with
| Procdesc.Node.Prune_node _ when not (node_has_abstraction curr_node) ->
(* don't check for leaks in prune nodes, unless there is abstraction anyway,*)
(* but force them into either branch *)
p'
@ -1657,11 +1657,11 @@ and sym_exec_wrapper handle_exn tenv pdesc instr ((prop: Prop.normal Prop.t), pa
(** {2 Lifted Abstract Transfer Functions} *)
let node handle_exn tenv pdesc node (pset : Paths.PathSet.t) : Paths.PathSet.t =
let pname = Cfg.Procdesc.get_proc_name pdesc in
let pname = Procdesc.get_proc_name pdesc in
let exe_instr_prop instr p tr (pset1: Paths.PathSet.t) =
let pset2 =
if Tabulation.prop_is_exn pname p && not (Sil.instr_is_auxiliary instr)
&& Cfg.Node.get_kind node <> Cfg.Node.exn_handler_kind
&& Procdesc.Node.get_kind node <> Procdesc.Node.exn_handler_kind
(* skip normal instructions if an exception was thrown,
unless this is an exception handler node *)
then
@ -1673,4 +1673,4 @@ let node handle_exn tenv pdesc node (pset : Paths.PathSet.t) : Paths.PathSet.t =
Paths.PathSet.union pset2 pset1 in
let exe_instr_pset pset instr =
Paths.PathSet.fold (exe_instr_prop instr) pset Paths.PathSet.empty in
IList.fold_left exe_instr_pset pset (Cfg.Node.get_instrs node)
IList.fold_left exe_instr_pset pset (Procdesc.Node.get_instrs node)

4
infer/src/backend/symExec.mli
Unescape View File

@ -14,12 +14,12 @@ open! Utils
(** Symbolic execution of the instructions of a node, lifted to sets of propositions. *)
val node :
(exn -> unit) -> Tenv.t -> Cfg.Procdesc.t -> Cfg.Node.t -> Paths.PathSet.t -> Paths.PathSet.t
(exn -> unit) -> Tenv.t -> Procdesc.t -> Procdesc.Node.t -> Paths.PathSet.t -> Paths.PathSet.t
(** Symbolic execution of a sequence of instructions.
If errors occur and [mask_errors] is true, just treat as skip. *)
val instrs :
?mask_errors:bool -> Tenv.t -> Cfg.Procdesc.t -> Sil.instr list ->
?mask_errors:bool -> Tenv.t -> Procdesc.t -> Sil.instr list ->
(Prop.normal Prop.t * Paths.Path.t) list -> (Prop.normal Prop.t * Paths.Path.t) list
(** Symbolic execution of the divergent pure computation. *)

6
infer/src/backend/tabulation.ml
Unescape View File

@ -673,7 +673,7 @@ let combine tenv
ret_id (posts: ('a Prop.t * Paths.Path.t) list)
actual_pre path_pre split
caller_pdesc callee_pname loc =
let caller_pname = Cfg.Procdesc.get_proc_name caller_pdesc in
let caller_pname = Procdesc.get_proc_name caller_pdesc in
let instantiated_post =
let posts' =
if !Config.footprint && posts = []
@ -1008,7 +1008,7 @@ let check_uninitialize_dangling_deref tenv callee_pname actual_pre sub formal_pa
let exe_spec
tenv ret_id (n, nspecs) caller_pdesc callee_pname callee_attrs loc prop path_pre
(spec : Prop.exposed Specs.spec) actual_params formal_params : abduction_res =
let caller_pname = Cfg.Procdesc.get_proc_name caller_pdesc in
let caller_pname = Procdesc.get_proc_name caller_pdesc in
let posts = mk_posts tenv ret_id prop callee_pname callee_attrs spec.Specs.posts in
let actual_pre = mk_actual_precondition tenv prop actual_params formal_params in
let spec_pre =
@ -1272,7 +1272,7 @@ let exe_call_postprocess tenv ret_id trace_call callee_pname callee_attrs loc re
(** Execute the function call and return the list of results with return value *)
let exe_function_call
callee_attrs tenv ret_id caller_pdesc callee_pname loc actual_params prop path =
let caller_pname = Cfg.Procdesc.get_proc_name caller_pdesc in
let caller_pname = Procdesc.get_proc_name caller_pdesc in
let trace_call res =
match Specs.get_summary caller_pname with
| None -> ()

2
infer/src/backend/tabulation.mli
Unescape View File

@ -44,6 +44,6 @@ val d_splitting : splitting -> unit
(** Execute the function call and return the list of results with return value *)
val exe_function_call:
ProcAttributes.t -> Tenv.t -> (Ident.t * Typ.t) option -> Cfg.Procdesc.t -> Procname.t ->
ProcAttributes.t -> Tenv.t -> (Ident.t * Typ.t) option -> Procdesc.t -> Procname.t ->
Location.t -> (Exp.t * Typ.t) list -> Prop.normal Prop.t -> Paths.Path.t ->
(Prop.normal Prop.t * Paths.Path.t) list

16
infer/src/checkers/BoundedCallTree.ml
Unescape View File

@ -37,14 +37,14 @@ module SpecSummary = Summary.Make (struct
end)
type extras_t = {
get_proc_desc : Procname.t -> Cfg.Procdesc.t option;
get_proc_desc : Procname.t -> Procdesc.t option;
stacktraces : Stacktrace.t list;
}
let line_range_of_pdesc pdesc =
let ploc = Cfg.Procdesc.get_loc pdesc in
let ploc = Procdesc.get_loc pdesc in
let start_line = ploc.Location.line in
let end_line = Cfg.Procdesc.fold_instrs
let end_line = Procdesc.fold_instrs
(fun acc _ instr ->
let new_loc = Sil.instr_get_loc instr in
max acc new_loc.Location.line)
@ -54,10 +54,10 @@ let line_range_of_pdesc pdesc =
let stacktree_of_pdesc
pdesc
?(loc=Cfg.Procdesc.get_loc pdesc)
?(loc=Procdesc.get_loc pdesc)
?(callees=[])
location_type =
let procname = Cfg.Procdesc.get_proc_name pdesc in
let procname = Procdesc.get_proc_name pdesc in
let frame_loc =
Some { Stacktree_j.location_type = location_type;
file = DB.source_file_to_string loc.Location.file;
@ -95,7 +95,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
stacktree_of_pdesc pdesc ~loc ~callees location_type
let output_json_summary tenv pdesc astate loc location_type get_proc_desc =
let caller = Cfg.Procdesc.get_proc_name pdesc in
let caller = Procdesc.get_proc_name pdesc in
let stacktree =
stacktree_of_astate tenv pdesc astate loc location_type get_proc_desc in
let dir = Filename.concat Config.results_dir "crashcontext" in
@ -112,7 +112,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
let get_proc_desc = proc_data.ProcData.extras.get_proc_desc in
let traces = proc_data.ProcData.extras.stacktraces in
let tenv = proc_data.ProcData.tenv in
let caller = Cfg.Procdesc.get_proc_name proc_data.ProcData.pdesc in
let caller = Procdesc.get_proc_name proc_data.ProcData.pdesc in
let matches_proc frame =
let matches_class pname = match pname with
| Procname.Java java_proc ->
@ -186,7 +186,7 @@ let checker { Callbacks.proc_desc; tenv; get_proc_desc; } =
| Some stacktraces -> begin
let extras = { get_proc_desc; stacktraces; } in
SpecSummary.write_summary
(Cfg.Procdesc.get_proc_name proc_desc)
(Procdesc.get_proc_name proc_desc)
(Some (stacktree_of_pdesc proc_desc "proc_start"));
ignore(Analyzer.exec_pdesc (ProcData.make proc_desc tenv extras))
end

8
infer/src/checkers/SimpleChecker.ml
Unescape View File

@ -25,7 +25,7 @@ module type Spec = sig
input is the previous state, current instruction, current node kind, current procedure and
type environment.
*)
val exec_instr : astate -> Sil.instr -> Cfg.Node.nodekind -> Procname.t -> Tenv.t -> astate
val exec_instr : astate -> Sil.instr -> Procdesc.Node.nodekind -> Procname.t -> Tenv.t -> astate
(** log errors here.
input is a state, location where the state occurs in the source, and the current procedure.
@ -74,7 +74,7 @@ module Make (Spec : Spec) : S = struct
let exec_instr astate_set proc_data node instr =
let node_kind = CFG.kind node in
let pname = Cfg.Procdesc.get_proc_name proc_data.ProcData.pdesc in
let pname = Procdesc.get_proc_name proc_data.ProcData.pdesc in
Domain.fold
(fun astate acc ->
Domain.add (Spec.exec_instr astate instr node_kind pname proc_data.ProcData.tenv) acc)
@ -89,7 +89,7 @@ module Make (Spec : Spec) : S = struct
(TransferFunctions)
let checker { Callbacks.proc_desc; proc_name; tenv; } =
let nodes = Cfg.Procdesc.get_nodes proc_desc in
let nodes = Procdesc.get_nodes proc_desc in
let do_reporting node_id state =
let astate_set = state.AbstractInterpreter.post in
if not (Domain.is_empty astate_set)
@ -97,7 +97,7 @@ module Make (Spec : Spec) : S = struct
(* should never fail since keys in the invariant map should always be real node id's *)
let node =
IList.find
(fun node -> Cfg.Node.id_compare node_id (Cfg.Node.get_id node) = 0)
(fun node -> Procdesc.Node.id_compare node_id (Procdesc.Node.get_id node) = 0)
nodes in
Domain.iter
(fun astate ->

2
infer/src/checkers/SimpleChecker.mli
Unescape View File

@ -13,7 +13,7 @@ sig
val initial : astate
val exec_instr :
astate ->
Sil.instr -> Cfg.Node.nodekind -> Procname.t -> Tenv.t -> astate
Sil.instr -> Procdesc.Node.nodekind -> Procname.t -> Tenv.t -> astate
val report : astate -> Location.t -> Procname.t -> unit
val compare : astate -> astate -> int
end

8
infer/src/checkers/Siof.ml
Unescape View File

@ -48,7 +48,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
let sink_of_global global pname loc =
let site = CallSite.make pname loc in
SiofTrace.Sink.make global site in
let pname = Cfg.Procdesc.get_proc_name pdesc in
let pname = Procdesc.get_proc_name pdesc in
let trace = match astate with
| Domain.Bottom -> SiofTrace.initial
| Domain.NonBottom t -> t in
@ -134,7 +134,7 @@ let report_siof trace pdesc tenv loc =
unit: %a. %a"
pp_sink final_sink
pp_path_part (IList.rev path) in
let caller_pname = Cfg.Procdesc.get_proc_name pdesc in
let caller_pname = Procdesc.get_proc_name pdesc in
let exn = Exceptions.Checkers
("STATIC_INITIALIZATION_ORDER_FIASCO", Localise.verbatim_desc description) in
Reporting.log_error caller_pname ~loc exn in
@ -143,7 +143,7 @@ let report_siof trace pdesc tenv loc =
let siof_check pdesc tenv = function
| Some (SiofDomain.NonBottom post) ->
let attrs = Cfg.Procdesc.get_attributes pdesc in
let attrs = Procdesc.get_attributes pdesc in
let is_orig_file f = match attrs.ProcAttributes.translation_unit with
| Some orig_file ->
let orig_path = DB.source_file_to_abs_path orig_file in
@ -162,7 +162,7 @@ let siof_check pdesc tenv = function
let checker ({ Callbacks.tenv; proc_desc } as callback) =
let post = Interprocedural.checker callback ProcData.empty_extras in
let pname = Cfg.Procdesc.get_proc_name proc_desc in
let pname = Procdesc.get_proc_name proc_desc in
match pname with
| Procname.C c when Procname.is_globals_initializer c ->
siof_check proc_desc tenv post

16
infer/src/checkers/ThreadSafety.ml
Unescape View File

@ -45,7 +45,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
let exec_instr ((lockstate,(readstate,writestate)) as astate) { ProcData.pdesc; } _ =
let is_unprotected lockstate =
(not (Cfg.Procdesc.is_java_synchronized pdesc)) && (LocksDomain.is_empty lockstate)
(not (Procdesc.is_java_synchronized pdesc)) && (LocksDomain.is_empty lockstate)
in
function
| Sil.Call (_, Const (Cfun pn), _, _, _) ->
@ -87,20 +87,20 @@ let method_analysis { Callbacks.proc_desc; tenv; } =
match Analyzer.compute_post (ProcData.make_default proc_desc tenv) with
| Some post -> (* I am printing to commandline and out to cater to javac and buck*)
(L.stdout "\n Procedure: %s@ "
(Procname.to_string (Cfg.Procdesc.get_proc_name proc_desc) )
(Procname.to_string (Procdesc.get_proc_name proc_desc) )
);
L.stdout "\n POST: %a\n" CombinedDomain.pp post;
(L.out "\n Procedure: %s@ "
(Procname.to_string (Cfg.Procdesc.get_proc_name proc_desc) )
(Procname.to_string (Procdesc.get_proc_name proc_desc) )
);
L.out "\n POST: %a\n" CombinedDomain.pp post
| None -> ()
(* a results table is a Map where a key is an a procedure environment,
i.e., something of type Idenv.t * Tenv.t * Procname.t * Cfg.Procdesc.t
i.e., something of type Idenv.t * Tenv.t * Procname.t * Procdesc.t
*)
module ResultsTableType = Map.Make (struct
type t = Idenv.t * Tenv.t * Procname.t * Cfg.Procdesc.t
type t = Idenv.t * Tenv.t * Procname.t * Procdesc.t
let compare (_, _, pn1, _) (_,_,pn2,_) = Procname.compare pn1 pn2
end)
@ -109,7 +109,7 @@ let should_analyze_proc (_,tenv,proc_name,proc_desc) =
not (Procname.java_is_autogen_method proc_name) &&
not (Procname.is_constructor proc_name) &&
not (Procname.is_class_initializer proc_name) &&
Cfg.Procdesc.get_access proc_desc <> PredSymb.Private
Procdesc.get_access proc_desc <> PredSymb.Private
(* creates a map from proc_envs to postconditions *)
let make_results_table file_env =
@ -162,7 +162,7 @@ let report_thread_safety_errors ( _, tenv, pname, pdesc) writestate =
pname
pdesc
"CHECKERS_THREAD_SAFETY_WARNING"
(Cfg.Procdesc.get_loc pdesc)
(Procdesc.get_loc pdesc)
description
in
IList.iter report_one_error (IList.map snd (PathDomain.elements writestate))
@ -190,7 +190,7 @@ let should_analyze_file file_env =
(*Gathers results by analyzing all the methods in a file, then post-processes
the results to check (approximation of) thread safety *)
(* file_env: (Idenv.t * Tenv.t * Procname.t * Cfg.Procdesc.t) list *)
(* file_env: (Idenv.t * Tenv.t * Procname.t * Procdesc.t) list *)
let file_analysis _ _ _ file_env =
if should_analyze_file file_env then
process_results_table

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

@ -135,7 +135,7 @@ module MakeNoCFG
let analyze_ondemand_ _ pdesc =
match compute_post (ProcData.make pdesc tenv extras) with
| Some post ->
Summ.write_summary (Cfg.Procdesc.get_proc_name pdesc) post;
Summ.write_summary (Procdesc.get_proc_name pdesc) post;
Some post
| None ->
None in

4
infer/src/checkers/annotationReachability.ml
Unescape View File

@ -323,7 +323,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
when is_unlikely callee_pname ->
Domain.add_tracking_var (Var.of_id id) astate
| Sil.Call (_, Const (Cfun callee_pname), _, call_loc, _) ->
let caller_pname = Cfg.Procdesc.get_proc_name pdesc in
let caller_pname = Procdesc.get_proc_name pdesc in
let call_site = CallSite.make callee_pname call_loc in
begin
(* Runs the analysis of callee_pname if not already analyzed *)
@ -368,7 +368,7 @@ module Interprocedural = struct
is_modeled_expensive tenv pname || is_expensive tenv pname
let check_and_report ({ Callbacks.proc_desc; proc_name; tenv; } as proc_data) =
let loc = Cfg.Procdesc.get_loc proc_desc in
let loc = Procdesc.get_loc proc_desc in
let expensive = is_expensive tenv proc_name in
(* TODO: generalize so we can check subtyping on arbitrary annotations *)
let check_expensive_subtyping_rules overridden_pname =

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

@ -92,7 +92,7 @@ let ma_contains ma ann_names =
!found
let pdesc_has_annot pdesc annot =
ma_contains (Cfg.Procdesc.get_attributes pdesc).ProcAttributes.method_annotation [annot]
ma_contains (Procdesc.get_attributes pdesc).ProcAttributes.method_annotation [annot]
let initializer_ = "Initializer"
let inject = "Inject"

2
infer/src/checkers/annotations.mli
Unescape View File

@ -101,7 +101,7 @@ val ia_iter : (Annot.t -> unit) -> Annot.Item.t -> unit
val ma_has_annotation_with : Annot.Method.t -> (Annot.t -> bool) -> bool
val pdesc_has_annot : Cfg.Procdesc.t -> string -> bool
val pdesc_has_annot : Procdesc.t -> string -> bool
(** Mark the return of the method_annotation with the given annotation. *)
val method_annotation_mark_return :

34
infer/src/checkers/checkDeadCode.ml
Unescape View File

@ -20,25 +20,25 @@ let verbose = false
module State = struct
type t =
{
visited : Cfg.NodeSet.t;
visited : Procdesc.NodeSet.t;
}
let initial =
{
visited = Cfg.NodeSet.empty;
visited = Procdesc.NodeSet.empty;
}
let equal t1 t2 =
Cfg.NodeSet.equal t1.visited t2.visited
Procdesc.NodeSet.equal t1.visited t2.visited
let join t1 t2 =
{
visited = Cfg.NodeSet.union t1.visited t2.visited
visited = Procdesc.NodeSet.union t1.visited t2.visited
}
let add_visited node t =
{
visited = Cfg.NodeSet.add node t.visited;
visited = Procdesc.NodeSet.add node t.visited;
}
let get_visited t =
@ -46,16 +46,16 @@ module State = struct
let pp fmt t =
F.fprintf fmt "visited: %a"
(pp_seq Cfg.Node.pp) (Cfg.NodeSet.elements t.visited)
(pp_seq Procdesc.Node.pp) (Procdesc.NodeSet.elements t.visited)
let num_visited t =
Cfg.NodeSet.cardinal t.visited
Procdesc.NodeSet.cardinal t.visited
end
let do_node _ node (s : State.t) : (State.t list) * (State.t list) =
let s' = State.add_visited node s in
if verbose then L.stderr " N:%a (#visited: %a)@."
Cfg.Node.pp node
Procdesc.Node.pp node
State.pp s';
[s'], [s']
@ -68,20 +68,22 @@ let report_error tenv description pn pd loc =
(** Check the final state at the end of the analysis. *)
let check_final_state tenv proc_name proc_desc final_s =
let proc_nodes = Cfg.Procdesc.get_nodes proc_desc in
let proc_nodes = Procdesc.get_nodes proc_desc in
let tot_nodes = IList.length proc_nodes in
let tot_visited = State.num_visited final_s in
if verbose then L.stderr "TOT nodes: %d (visited: %n)@." tot_nodes tot_visited;
if tot_nodes <> tot_visited then
begin
let not_visited =
IList.filter (fun n -> not (Cfg.NodeSet.mem n (State.get_visited final_s))) proc_nodes in
IList.filter
(fun n -> not (Procdesc.NodeSet.mem n (State.get_visited final_s)))
proc_nodes in
let do_node n =
let loc = Cfg.Node.get_loc n in
let description = Format.sprintf "Node not visited: %d" (Cfg.Node.get_id n :> int) in
let report = match Cfg.Node.get_kind n with
| Cfg.Node.Join_node -> false
| k when k = Cfg.Node.exn_sink_kind -> false
let loc = Procdesc.Node.get_loc n in
let description = Format.sprintf "Node not visited: %d" (Procdesc.Node.get_id n :> int) in
let report = match Procdesc.Node.get_kind n with
| Procdesc.Node.Join_node -> false
| k when k = Procdesc.Node.exn_sink_kind -> false
| _ -> true in
if report
then report_error tenv description proc_name proc_desc loc in
@ -103,7 +105,7 @@ let callback_check_dead_code { Callbacks.proc_desc; proc_name; tenv } =
begin
if verbose then L.stderr "@.--@.PROC: %a@." Procname.pp proc_name;
let transitions = DFDead.run tenv proc_desc State.initial in
let exit_node = Cfg.Procdesc.get_exit_node proc_desc in
let exit_node = Procdesc.get_exit_node proc_desc in
match transitions exit_node with
| DFDead.Transition (pre_final_s, _, _) ->
let final_s = State.add_visited exit_node pre_final_s in

8
infer/src/checkers/checkTraceCallSequence.ml
Unescape View File

@ -220,7 +220,7 @@ module Automaton = struct
if not (State.is_balanced s) then
begin
let description = Printf.sprintf "%d missing end/stop" (Elem.get_int (State.max s)) in
let loc = Cfg.Node.get_loc exit_node in
let loc = Procdesc.Node.get_loc exit_node in
report_warning tenv description pn pd loc
end
@ -303,7 +303,7 @@ end
(** State transformation for a cfg node. *)
let do_node tenv pn pd idenv _ node (s : State.t) : (State.t list) * (State.t list) =
if verbose then L.stderr "N:%d S:%s@." (Cfg.Node.get_id node :> int) (State.to_string s);
if verbose then L.stderr "N:%d S:%s@." (Procdesc.Node.get_id node :> int) (State.to_string s);
let curr_state = ref s in
@ -312,7 +312,7 @@ let do_node tenv pn pd idenv _ node (s : State.t) : (State.t list) * (State.t li
let state2 = BooleanVars.do_instr pn pd idenv instr state1 in
curr_state := state2 in
IList.iter do_instr (Cfg.Node.get_instrs node);
IList.iter do_instr (Procdesc.Node.get_instrs node);
[!curr_state], [!curr_state]
(** Check the final state at the end of the analysis. *)
@ -340,7 +340,7 @@ let callback_check_trace_call_sequence { Callbacks.proc_desc; proc_name; idenv;
begin
if verbose then L.stderr "@.--@.PROC: %a@." Procname.pp proc_name;
let transitions = DFTrace.run tenv proc_desc State.balanced in
let exit_node = Cfg.Procdesc.get_exit_node proc_desc in
let exit_node = Procdesc.get_exit_node proc_desc in
match transitions exit_node with
| DFTrace.Transition (final_s, _, _) ->
check_final_state tenv proc_name proc_desc exit_node final_s

51
infer/src/checkers/checkers.ml
Unescape View File

@ -160,7 +160,7 @@ module ST = struct
end
let report_calls_and_accesses tenv callback proc_desc instr =
let proc_name = Cfg.Procdesc.get_proc_name proc_desc in
let proc_name = Procdesc.get_proc_name proc_desc in
let callee = Procname.to_string proc_name in
match PatternMatch.get_java_field_access_signature instr with
| Some (bt, fn, ft) ->
@ -168,7 +168,7 @@ let report_calls_and_accesses tenv callback proc_desc instr =
proc_name
proc_desc
(callback ^ "_CALLBACK")
(Cfg.Procdesc.get_loc proc_desc)
(Procdesc.get_loc proc_desc)
(Format.sprintf "field access %s.%s:%s in %s@." bt fn ft callee)
| None ->
match PatternMatch.get_java_method_call_formal_signature instr with
@ -177,13 +177,13 @@ let report_calls_and_accesses tenv callback proc_desc instr =
proc_name
proc_desc
(callback ^ "_CALLBACK")
(Cfg.Procdesc.get_loc proc_desc)
(Procdesc.get_loc proc_desc)
(Format.sprintf "method call %s.%s(%s):%s in %s@." bt fn "..." rt callee)
| None -> ()
(** Report all field accesses and method calls of a procedure. *)
let callback_check_access { Callbacks.tenv; proc_desc } =
Cfg.Procdesc.iter_instrs
Procdesc.iter_instrs
(fun _ instr -> report_calls_and_accesses tenv "PROC" proc_desc instr)
proc_desc
@ -193,7 +193,7 @@ let callback_check_cluster_access exe_env all_procs get_proc_desc _ =
match get_proc_desc proc_name with
| Some proc_desc ->
let tenv = Exe_env.get_tenv exe_env proc_name in
Cfg.Procdesc.iter_instrs
Procdesc.iter_instrs
(fun _ instr -> report_calls_and_accesses tenv "CLUSTER" proc_desc instr)
proc_desc
| _ ->
@ -235,7 +235,7 @@ let callback_check_write_to_parcel_java
let check r_desc w_desc =
let is_serialization_node node =
match Cfg.Node.get_callees node with
match Procdesc.Node.get_callees node with
| [] -> false
| [Procname.Java pname_java] ->
let class_name = Procname.java_get_class_name pname_java in
@ -261,18 +261,18 @@ let callback_check_write_to_parcel_java
false in
let node_to_call_desc node =
match Cfg.Node.get_callees node with
match Procdesc.Node.get_callees node with
| [desc] -> desc
| _ -> assert false in
let r_call_descs =
IList.map node_to_call_desc
(IList.filter is_serialization_node
(Cfg.Procdesc.get_sliced_slope r_desc is_serialization_node)) in
(Procdesc.get_sliced_slope r_desc is_serialization_node)) in
let w_call_descs =
IList.map node_to_call_desc
(IList.filter is_serialization_node
(Cfg.Procdesc.get_sliced_slope w_desc is_serialization_node)) in
(Procdesc.get_sliced_slope w_desc is_serialization_node)) in
let rec check_match = function
| rc:: rcs, wc:: wcs ->
@ -314,7 +314,7 @@ let callback_check_write_to_parcel_java
if !verbose then L.stdout "Methods not available@."
end
| _ -> () in
Cfg.Procdesc.iter_instrs do_instr proc_desc
Procdesc.iter_instrs do_instr proc_desc
(** Looks for writeToParcel methods and checks whether read is in reverse *)
let callback_check_write_to_parcel ({ Callbacks.proc_name } as args) =
@ -329,7 +329,7 @@ let callback_monitor_nullcheck { Callbacks.proc_desc; idenv; proc_name } =
let verbose = ref false in
let class_formal_names = lazy (
let formals = Cfg.Procdesc.get_formals proc_desc in
let formals = Procdesc.get_formals proc_desc in
let class_formals =
let is_class_type (p, typ) =
match typ with
@ -375,7 +375,7 @@ let callback_monitor_nullcheck { Callbacks.proc_desc; idenv; proc_name } =
let was_not_found formal_name =
not (Exp.Set.exists (fun exp -> equal_formal_param exp formal_name) !checks_to_formals) in
let missing = IList.filter was_not_found formal_names in
let loc = Cfg.Procdesc.get_loc proc_desc in
let loc = Procdesc.get_loc proc_desc in
let pp_file_loc fmt () =
F.fprintf fmt "%s:%d" (DB.source_file_to_string loc.Location.file) loc.Location.line in
L.stdout "Null Checks of Formal Parameters: ";
@ -401,7 +401,7 @@ let callback_monitor_nullcheck { Callbacks.proc_desc; idenv; proc_name } =
| _ ->
())
| _ -> () in
Cfg.Procdesc.iter_instrs do_instr proc_desc;
Procdesc.iter_instrs do_instr proc_desc;
summary_checks_of_formals ()
(** Test persistent state. *)
@ -412,7 +412,7 @@ let callback_test_state { Callbacks.proc_name } =
let callback_checkVisibleForTesting { Callbacks.proc_desc } =
if Annotations.pdesc_has_annot proc_desc Annotations.visibleForTesting then
begin
let loc = Cfg.Procdesc.get_loc proc_desc in
let loc = Procdesc.get_loc proc_desc in
let linereader = Printer.LineReader.create () in
L.stdout "%a@." (PP.pp_loc_range linereader 10 10) loc
end
@ -426,10 +426,15 @@ let callback_find_deserialization { Callbacks.proc_desc; get_proc_desc; idenv; p
let reverse_find_instr f node =
(* this is not really sound but for the moment a sufficient approximation *)
let has_instr node =
try ignore(IList.find f (Cfg.Node.get_instrs node)); true
try ignore(IList.find f (Procdesc.Node.get_instrs node)); true
with Not_found -> false in
let preds = Cfg.Node.get_generated_slope node (fun n -> Cfg.Node.get_sliced_preds n has_instr) in
let instrs = IList.flatten (IList.map (fun n -> IList.rev (Cfg.Node.get_instrs n)) preds) in
let preds =
Procdesc.Node.get_generated_slope
node
(fun n -> Procdesc.Node.get_sliced_preds n has_instr) in
let instrs =
IList.flatten
(IList.map (fun n -> IList.rev (Procdesc.Node.get_instrs n)) preds) in
try
Some (IList.find f instrs)
with Not_found -> None in
@ -442,9 +447,9 @@ let callback_find_deserialization { Callbacks.proc_desc; get_proc_desc; idenv; p
Some proc_desc' ->
let is_return_instr = function
| Sil.Store (Exp.Lvar p, _, _, _)
when Pvar.equal p (Cfg.Procdesc.get_ret_var proc_desc') -> true
when Pvar.equal p (Procdesc.get_ret_var proc_desc') -> true
| _ -> false in
(match reverse_find_instr is_return_instr (Cfg.Procdesc.get_exit_node proc_desc') with
(match reverse_find_instr is_return_instr (Procdesc.get_exit_node proc_desc') with
| Some (Sil.Store (_, _, Exp.Const (Const.Cclass n), _)) -> Ident.name_to_string n
| _ -> "<" ^ (Procname.to_string proc_name') ^ ">")
| None -> "?" in
@ -509,7 +514,7 @@ let callback_find_deserialization { Callbacks.proc_desc; get_proc_desc; idenv; p
ST.pname_add proc_name ret_const_key ret_const in
store_return ();
Cfg.Procdesc.iter_instrs do_instr proc_desc
Procdesc.iter_instrs do_instr proc_desc
(** Check field accesses. *)
let callback_check_field_access { Callbacks.proc_desc } =
@ -552,7 +557,7 @@ let callback_check_field_access { Callbacks.proc_desc } =
| Sil.Remove_temps _
| Sil.Declare_locals _ ->
() in
Cfg.Procdesc.iter_instrs do_instr proc_desc
Procdesc.iter_instrs do_instr proc_desc
(** Print c method calls. *)
let callback_print_c_method_calls { Callbacks.tenv; proc_desc; proc_name } =
@ -580,7 +585,7 @@ let callback_print_c_method_calls { Callbacks.tenv; proc_desc; proc_name } =
loc
description
| _ -> () in
Cfg.Procdesc.iter_instrs do_instr proc_desc
Procdesc.iter_instrs do_instr proc_desc
(** Print access to globals. *)
let callback_print_access_to_globals { Callbacks.tenv; proc_desc; proc_name } =
@ -608,4 +613,4 @@ let callback_print_access_to_globals { Callbacks.tenv; proc_desc; proc_name } =
| Sil.Store (e, _, _, loc) when get_global_var e <> None ->
Option.may (fun pvar -> do_pvar false pvar loc) (get_global_var e)
| _ -> () in
Cfg.Procdesc.iter_instrs do_instr proc_desc
Procdesc.iter_instrs do_instr proc_desc

2
infer/src/checkers/checkers.mli
Unescape View File

@ -24,7 +24,7 @@ module ST : sig
val report_error:
Tenv.t ->
Procname.t ->
Cfg.Procdesc.t ->
Procdesc.t ->
string ->
Location.t ->
?advice: string option ->

8
infer/src/checkers/constantPropagation.ml
Unescape View File

@ -113,17 +113,17 @@ module ConstantFlow = Dataflow.MakeDF(struct
if verbose then
begin
L.stdout "Node %i:" (Cfg.Node.get_id node :> int);
L.stdout "Node %i:" (Procdesc.Node.get_id node :> int);
L.stdout "%a" pp constants;
IList.iter
(fun instr -> L.stdout "%a@." (Sil.pp_instr pe_text) instr)
(Cfg.Node.get_instrs node)
(Procdesc.Node.get_instrs node)
end;
let constants =
IList.fold_left
do_instr
constants
(Cfg.Node.get_instrs node) in
(Procdesc.Node.get_instrs node) in
if verbose then L.stdout "%a\n@." pp constants;
[constants], [constants]
end)
@ -136,7 +136,7 @@ let run tenv proc_desc =
| ConstantFlow.Dead_state -> ConstantMap.empty in
get_constants
type const_map = Cfg.Node.t -> Exp.t -> Const.t option
type const_map = Procdesc.Node.t -> Exp.t -> Const.t option
(** Build a const map lazily. *)
let build_const_map tenv pdesc =

4
infer/src/checkers/constantPropagation.mli
Unescape View File

@ -9,7 +9,7 @@
open! Utils
type const_map = Cfg.Node.t -> Exp.t -> Const.t option
type const_map = Procdesc.Node.t -> Exp.t -> Const.t option
(** Build a const map lazily. *)
val build_const_map : Tenv.t -> Cfg.Procdesc.t -> const_map
val build_const_map : Tenv.t -> Procdesc.t -> const_map

26
infer/src/checkers/dataflow.ml
Unescape View File

@ -28,7 +28,7 @@ module type DFStateType = sig
val join : t -> t -> t
(** Perform a state transition on a node. *)
val do_node : Tenv.t -> Cfg.Node.t -> t -> (t list) * (t list)
val do_node : Tenv.t -> Procdesc.Node.t -> t -> (t list) * (t list)
(** Can proc throw an exception? *)
val proc_throws : Procname.t -> throws
@ -43,14 +43,14 @@ module type DF = sig
| Transition of state * state list * state list
val join : state list -> state -> state
val run : Tenv.t -> Cfg.Procdesc.t -> state -> (Cfg.Node.t -> transition)
val run : Tenv.t -> Procdesc.t -> state -> (Procdesc.Node.t -> transition)
end
(** Determine if the node can throw an exception. *)
let node_throws pdesc node (proc_throws : Procname.t -> throws) : throws =
let instr_throws instr =
let is_return pvar =
let ret_pvar = Cfg.Procdesc.get_ret_var pdesc in
let ret_pvar = Procdesc.get_ret_var pdesc in
Pvar.equal pvar ret_pvar in
match instr with
| Sil.Store (Exp.Lvar pvar, _, Exp.Exn _, _) when is_return pvar ->
@ -75,14 +75,14 @@ let node_throws pdesc node (proc_throws : Procname.t -> throws) : throws =
| t, DoesNotThrow -> res := t in
let do_instr instr = update_res (instr_throws instr) in
IList.iter do_instr (Cfg.Node.get_instrs node);
IList.iter do_instr (Procdesc.Node.get_instrs node);
!res
(** Create an instance of the dataflow algorithm given a state parameter. *)
module MakeDF(St: DFStateType) : DF with type state = St.t = struct
module S = Cfg.NodeSet
module H = Cfg.NodeHash
module N = Cfg.Node
module S = Procdesc.NodeSet
module H = Procdesc.NodeHash
module N = Procdesc.Node
type worklist = S.t
type statemap = St.t H.t
@ -92,7 +92,7 @@ module MakeDF(St: DFStateType) : DF with type state = St.t = struct
pre_states : statemap;
post_states : statelistmap;
exn_states : statelistmap;
proc_desc : Cfg.Procdesc.t
proc_desc : Procdesc.t
}
type state = St.t
type transition =
@ -118,8 +118,8 @@ module MakeDF(St: DFStateType) : DF with type state = St.t = struct
push_state dest_joined
with Not_found -> push_state new_state in
let succ_nodes = Cfg.Node.get_succs node in
let exn_nodes = Cfg.Node.get_exn node in
let succ_nodes = Procdesc.Node.get_succs node in
let exn_nodes = Procdesc.Node.get_exn node in
if throws <> Throws then
IList.iter
(fun s -> IList.iter (propagate_to_dest s) succ_nodes)
@ -136,7 +136,7 @@ module MakeDF(St: DFStateType) : DF with type state = St.t = struct
let run tenv proc_desc state =
let t =
let start_node = Cfg.Procdesc.get_start_node proc_desc in
let start_node = Procdesc.get_start_node proc_desc in
let init_set = S.singleton start_node in
let init_statemap =
let m = H.create 1 in
@ -178,7 +178,7 @@ let callback_test_dataflow { Callbacks.proc_desc; tenv } =
let equal = int_equal
let join n m = if n = 0 then m else n
let do_node _ n s =
if verbose then L.stdout "visiting node %a with state %d@." Cfg.Node.pp n s;
if verbose then L.stdout "visiting node %a with state %d@." Procdesc.Node.pp n s;
[s + 1], [s + 1]
let proc_throws _ = DoesNotThrow
end) in
@ -187,4 +187,4 @@ let callback_test_dataflow { Callbacks.proc_desc; tenv } =
match transitions node with
| DFCount.Transition _ -> ()
| DFCount.Dead_state -> () in
IList.iter do_node (Cfg.Procdesc.get_nodes proc_desc)
IList.iter do_node (Procdesc.get_nodes proc_desc)

4
infer/src/checkers/dataflow.mli
Unescape View File

@ -26,7 +26,7 @@ module type DFStateType = sig
val join : t -> t -> t
(** Perform a state transition on a node. *)
val do_node : Tenv.t -> Cfg.Node.t -> t -> (t list) * (t list)
val do_node : Tenv.t -> Procdesc.Node.t -> t -> (t list) * (t list)
(** Can proc throw an exception? *)
val proc_throws : Procname.t -> throws
@ -43,7 +43,7 @@ module type DF = sig
(** Run the dataflow analysis on a procedure starting from the given state.
Returns a function to lookup the results of the analysis on every node *)
val run : Tenv.t -> Cfg.Procdesc.t -> state -> (Cfg.Node.t -> transition)
val run : Tenv.t -> Procdesc.t -> state -> (Procdesc.Node.t -> transition)
end
(** Functor to create an instance of a dataflow analysis. *)

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

@ -17,7 +17,7 @@ let report_error fragment_typ fld fld_typ pname pdesc =
let retained_view = "CHECKERS_FRAGMENT_RETAINS_VIEW" in
let description = Localise.desc_fragment_retains_view fragment_typ fld fld_typ pname in
let exn = Exceptions.Checkers (retained_view, description) in
let loc = Cfg.Procdesc.get_loc pdesc in
let loc = Procdesc.get_loc pdesc in
Reporting.log_error pname ~loc exn
let callback_fragment_retains_view_java

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

@ -21,7 +21,7 @@ let create_ proc_desc =
| Sil.Load (id, e, _, _) ->
Ident.IdentHash.add map id e
| _ -> () in
Cfg.Procdesc.iter_instrs do_instr proc_desc;
Procdesc.iter_instrs do_instr proc_desc;
map
(* lazy implementation, only create when used *)

6
infer/src/checkers/idenv.mli
Unescape View File

@ -15,12 +15,12 @@ open! Utils
type t
val create : Cfg.Procdesc.t -> t
val create_from_idenv : t -> Cfg.Procdesc.t -> t
val create : Procdesc.t -> t
val create_from_idenv : t -> Procdesc.t -> t
val lookup : t -> Ident.t -> Exp.t option
val expand_expr : t -> Exp.t -> Exp.t
val exp_is_temp : t -> Exp.t -> bool
(** Stronger version of expand_expr which also expands a temporary variable. *)
val expand_expr_temps : t -> Cfg.Node.t -> Exp.t -> Exp.t
val expand_expr_temps : t -> Procdesc.Node.t -> Exp.t -> Exp.t

22
infer/src/checkers/patternMatch.ml
Unescape View File

@ -140,7 +140,7 @@ let java_get_const_type_name
| _ -> "_"
let get_vararg_type_names tenv
(call_node: Cfg.Node.t)
(call_node: Procdesc.Node.t)
(ivar: Pvar.t): string list =
(* Is this the node creating ivar? *)
let rec initializes_array instrs =
@ -167,7 +167,7 @@ let get_vararg_type_names tenv
let rec added_nvar array_nvar instrs =
match instrs with
| Sil.Store (Exp.Lindex (Exp.Var iv, _), _, Exp.Var nvar, _):: _
when Ident.equal iv array_nvar -> nvar_type_name nvar (Cfg.Node.get_instrs node)
when Ident.equal iv array_nvar -> nvar_type_name nvar (Procdesc.Node.get_instrs node)
| Sil.Store (Exp.Lindex (Exp.Var iv, _), _, Exp.Const c, _):: _
when Ident.equal iv array_nvar -> Some (java_get_const_type_name c)
| _:: is -> added_nvar array_nvar is
@ -179,14 +179,14 @@ let get_vararg_type_names tenv
added_nvar nv instrs
| _:: is -> array_nvar is
| _ -> None in
array_nvar (Cfg.Node.get_instrs node) in
array_nvar (Procdesc.Node.get_instrs node) in
(* Walk nodes backward until definition of ivar, adding type names *)
let rec type_names node =
if initializes_array (Cfg.Node.get_instrs node) then
if initializes_array (Procdesc.Node.get_instrs node) then
[]
else
match (Cfg.Node.get_preds node) with
match (Procdesc.Node.get_preds node) with
| [n] -> (match (added_type_name node) with
| Some name -> name:: type_names n
| None -> type_names n)
@ -195,7 +195,7 @@ let get_vararg_type_names tenv
IList.rev (type_names call_node)
let has_formal_proc_argument_type_names proc_desc argument_type_names =
let formals = Cfg.Procdesc.get_formals proc_desc in
let formals = Procdesc.get_formals proc_desc in
let equal_formal_arg (_, typ) arg_type_name = get_type_name typ = arg_type_name in
IList.length formals = IList.length argument_type_names
&& IList.for_all2 equal_formal_arg formals argument_type_names
@ -290,10 +290,10 @@ let java_get_vararg_values node pvar idenv =
values := content_exp :: !values
| _ -> () in
let do_node n =
IList.iter do_instr (Cfg.Node.get_instrs n) in
IList.iter do_instr (Procdesc.Node.get_instrs n) in
let () = match Errdesc.find_program_variable_assignment node pvar with
| Some (node', _) ->
Cfg.Procdesc.iter_slope_range do_node node' node
Procdesc.iter_slope_range do_node node' node
| None -> () in
!values
@ -310,9 +310,9 @@ let proc_calls resolve_attributes pdesc filter : (Procname.t * ProcAttributes.t)
end
| _ -> () in
let do_node node =
let instrs = Cfg.Node.get_instrs node in
let instrs = Procdesc.Node.get_instrs node in
IList.iter (do_instruction node) instrs in
let nodes = Cfg.Procdesc.get_nodes pdesc in
let nodes = Procdesc.get_nodes pdesc in
IList.iter do_node nodes;
IList.rev !res
@ -355,7 +355,7 @@ let get_fields_nullified procdesc =
(nullified_flds, Ident.IdentSet.add id this_ids)
| _ -> (nullified_flds, this_ids) in
let (nullified_flds, _) =
Cfg.Procdesc.fold_instrs
Procdesc.fold_instrs
collect_nullified_flds (Ident.FieldSet.empty, Ident.IdentSet.empty) procdesc in
nullified_flds

10
infer/src/checkers/patternMatch.mli
Unescape View File

@ -36,10 +36,10 @@ val get_this_type : ProcAttributes.t -> Typ.t option
val get_type_name : Typ.t -> string
(** Get the type names of a variable argument *)
val get_vararg_type_names : Tenv.t -> Cfg.Node.t -> Pvar.t -> string list
val get_vararg_type_names : Tenv.t -> Procdesc.Node.t -> Pvar.t -> string list
val has_formal_method_argument_type_names :
Cfg.Procdesc.t -> Procname.java -> string list -> bool
Procdesc.t -> Procname.java -> string list -> bool
(** Check if the method is one of the known initializer methods. *)
val method_is_initializer : Tenv.t -> ProcAttributes.t -> bool
@ -66,14 +66,14 @@ val supertype_exists : Tenv.t -> (Typename.t -> StructTyp.t -> bool) -> Typename
val java_get_const_type_name : Const.t -> string
(** Get the values of a vararg parameter given the pvar used to assign the elements. *)
val java_get_vararg_values : Cfg.Node.t -> Pvar.t -> Idenv.t -> Exp.t list
val java_get_vararg_values : Procdesc.Node.t -> Pvar.t -> Idenv.t -> Exp.t list
val java_proc_name_with_class_method : Procname.java -> string -> string -> bool
(** Return the callees that satisfy [filter]. *)
val proc_calls :
(Procname.t -> ProcAttributes.t option) ->
Cfg.Procdesc.t ->
Procdesc.t ->
(Procname.t -> ProcAttributes.t -> bool) ->
(Procname.t * ProcAttributes.t) list
@ -99,7 +99,7 @@ val type_is_nested_in_direct_supertype : Tenv.t -> Typ.t -> Typename.t -> bool
val type_is_object : Typ.t -> bool
(** return the set of instance fields that are assigned to a null literal in [procdesc] *)
val get_fields_nullified : Cfg.Procdesc.t -> Ident.FieldSet.t
val get_fields_nullified : Procdesc.t -> Ident.FieldSet.t
(** [is_exception tenv class_name] checks if class_name is of type java.lang.Exception *)
val is_exception : Tenv.t -> Typename.t -> bool

8
infer/src/checkers/printfArgs.ml
Unescape View File

@ -115,10 +115,10 @@ let rec format_string_type_names
let printf_args_name = "CHECKERS_PRINTF_ARGS"
let check_printf_args_ok tenv
(node: Cfg.Node.t)
(node: Procdesc.Node.t)
(instr: Sil.instr)
(proc_name: Procname.t)
(proc_desc: Cfg.Procdesc.t): unit =
(proc_desc: Procdesc.t): unit =
(* Check if format string lines up with arguments *)
let rec check_type_names instr_loc n_arg instr_proc_name fmt_type_names arg_type_names =
@ -180,7 +180,7 @@ let check_printf_args_ok tenv
| Some printf -> (
try
let fmt, fixed_nvars, array_nvar = format_arguments printf args in
let instrs = Cfg.Node.get_instrs node in
let instrs = Procdesc.Node.get_instrs node in
let fixed_nvar_type_names = IList.map (fixed_nvar_type_name instrs) fixed_nvars in
let vararg_ivar_type_names = match array_nvar with
| Some nvar -> (
@ -212,7 +212,7 @@ let check_printf_args_ok tenv
| _ -> ()
let callback_printf_args { Callbacks.tenv; proc_desc; proc_name } : unit =
Cfg.Procdesc.iter_instrs (fun n i -> check_printf_args_ok tenv n i proc_name proc_desc) proc_desc
Procdesc.iter_instrs (fun n i -> check_printf_args_ok tenv n i proc_name proc_desc) proc_desc
(*
let printf_signature_to_string

3
infer/src/checkers/printfArgs.mli
Unescape View File

@ -19,6 +19,7 @@ type printf_signature = {
val add_printf_like_function : printf_signature -> unit
val check_printf_args_ok : Tenv.t -> Cfg.Node.t -> Sil.instr -> Procname.t -> Cfg.Procdesc.t -> unit
val check_printf_args_ok :
Tenv.t -> Procdesc.Node.t -> Sil.instr -> Procname.t -> Procdesc.t -> unit
val callback_printf_args: Callbacks.proc_callback_t

100
infer/src/checkers/procCfg.ml
Unescape View File

@ -21,37 +21,37 @@ module type Node = sig
type t
type id
val kind : t -> Cfg.Node.nodekind
val kind : t -> Procdesc.Node.nodekind
val id : t -> id
val loc : t -> Location.t
val underlying_id : t -> Cfg.Node.id
val underlying_id : t -> Procdesc.Node.id
val id_compare : id -> id -> int
val pp_id : F.formatter -> id -> unit
end
module DefaultNode = struct
type t = Cfg.Node.t
type id = Cfg.Node.id
type t = Procdesc.Node.t
type id = Procdesc.Node.id
let kind = Cfg.Node.get_kind
let id = Cfg.Node.get_id
let loc = Cfg.Node.get_loc
let kind = Procdesc.Node.get_kind
let id = Procdesc.Node.get_id
let loc = Procdesc.Node.get_loc
let underlying_id = id
let id_compare = Cfg.Node.id_compare
let pp_id = Cfg.Node.pp_id
let id_compare = Procdesc.Node.id_compare
let pp_id = Procdesc.Node.pp_id
end
module InstrNode = struct
type t = Cfg.Node.t
type id = Cfg.Node.id * index
type t = Procdesc.Node.t
type id = Procdesc.Node.id * index
let kind = Cfg.Node.get_kind
let kind = Procdesc.Node.get_kind
let underlying_id t = Cfg.Node.get_id t
let underlying_id t = Procdesc.Node.get_id t
let id t = underlying_id t, Node_index
let loc t = Cfg.Node.get_loc t
let loc t = Procdesc.Node.get_loc t
let index_compare index1 index2 = match index1, index2 with
| Node_index, Node_index -> 0
@ -60,13 +60,13 @@ module InstrNode = struct
| Instr_index _, Node_index -> -1
let id_compare (id1, index1) (id2, index2) =
let n = Cfg.Node.id_compare id1 id2 in
let n = Procdesc.Node.id_compare id1 id2 in
if n <> 0 then n
else index_compare index1 index2
let pp_id fmt (id, index) = match index with
| Node_index -> Cfg.Node.pp_id fmt id
| Instr_index i -> F.fprintf fmt "(%a: %d)" Cfg.Node.pp_id id i
| Node_index -> Procdesc.Node.pp_id fmt id
| Instr_index i -> F.fprintf fmt "(%a: %d)" Procdesc.Node.pp_id id i
end
module type S = sig
@ -104,74 +104,74 @@ module type S = sig
val exit_node : t -> node
val proc_desc : t -> Cfg.Procdesc.t
val proc_desc : t -> Procdesc.t
val nodes : t -> node list
val from_pdesc : Cfg.Procdesc.t -> t
val from_pdesc : Procdesc.t -> t
end
(** Forward CFG with no exceptional control-flow *)
module Normal = struct
type t = Cfg.Procdesc.t
type t = Procdesc.t
type node = DefaultNode.t
include (DefaultNode : module type of DefaultNode with type t := node)
let instrs = Cfg.Node.get_instrs
let instrs = Procdesc.Node.get_instrs
let instr_ids n = IList.map (fun i -> i, None) (instrs n)
let normal_succs _ n = Cfg.Node.get_succs n
let normal_preds _ n = Cfg.Node.get_preds n
let normal_succs _ n = Procdesc.Node.get_succs n
let normal_preds _ n = Procdesc.Node.get_preds n
(* prune away exceptional control flow *)
let exceptional_succs _ _ = []
let exceptional_preds _ _ = []
let succs = normal_succs
let preds = normal_preds
let start_node = Cfg.Procdesc.get_start_node
let exit_node = Cfg.Procdesc.get_exit_node
let start_node = Procdesc.get_start_node
let exit_node = Procdesc.get_exit_node
let proc_desc t = t
let nodes = Cfg.Procdesc.get_nodes
let nodes = Procdesc.get_nodes
let from_pdesc pdesc = pdesc
end
(** Forward CFG with exceptional control-flow *)
module Exceptional = struct
type node = DefaultNode.t
type id_node_map = node list Cfg.IdMap.t
type t = Cfg.Procdesc.t * id_node_map
type id_node_map = node list Procdesc.IdMap.t
type t = Procdesc.t * id_node_map
include (DefaultNode : module type of DefaultNode with type t := node)
let from_pdesc pdesc =
(* map from a node to its exceptional predecessors *)
let add_exn_preds exn_preds_acc n =
let add_exn_pred exn_preds_acc exn_succ_node =
let exn_succ_node_id = Cfg.Node.get_id exn_succ_node in
let exn_succ_node_id = Procdesc.Node.get_id exn_succ_node in
let existing_exn_preds =
try Cfg.IdMap.find exn_succ_node_id exn_preds_acc
try Procdesc.IdMap.find exn_succ_node_id exn_preds_acc
with Not_found -> [] in
if not (IList.mem Cfg.Node.equal n existing_exn_preds)
if not (IList.mem Procdesc.Node.equal n existing_exn_preds)
then (* don't add duplicates *)
Cfg.IdMap.add exn_succ_node_id (n :: existing_exn_preds) exn_preds_acc
Procdesc.IdMap.add exn_succ_node_id (n :: existing_exn_preds) exn_preds_acc
else
exn_preds_acc in
IList.fold_left add_exn_pred exn_preds_acc (Cfg.Node.get_exn n) in
IList.fold_left add_exn_pred exn_preds_acc (Procdesc.Node.get_exn n) in
let exceptional_preds =
IList.fold_left add_exn_preds Cfg.IdMap.empty (Cfg.Procdesc.get_nodes pdesc) in
IList.fold_left add_exn_preds Procdesc.IdMap.empty (Procdesc.get_nodes pdesc) in
pdesc, exceptional_preds
let instrs = Cfg.Node.get_instrs
let instrs = Procdesc.Node.get_instrs
let instr_ids n = IList.map (fun i -> i, None) (instrs n)
let nodes (t, _) = Cfg.Procdesc.get_nodes t
let nodes (t, _) = Procdesc.get_nodes t
let normal_succs _ n = Cfg.Node.get_succs n
let normal_succs _ n = Procdesc.Node.get_succs n
let normal_preds _ n = Cfg.Node.get_preds n
let normal_preds _ n = Procdesc.Node.get_preds n
let exceptional_succs _ n = Cfg.Node.get_exn n
let exceptional_succs _ n = Procdesc.Node.get_exn n
let exceptional_preds (_, exn_pred_map) n =
try Cfg.IdMap.find (Cfg.Node.get_id n) exn_pred_map
try Procdesc.IdMap.find (Procdesc.Node.get_id n) exn_pred_map
with Not_found -> []
(** get all normal and exceptional successors of [n]. *)
@ -182,8 +182,8 @@ module Exceptional = struct
normal_succs
| exceptional_succs ->
normal_succs @ exceptional_succs
|> IList.sort Cfg.Node.compare
|> IList.remove_duplicates Cfg.Node.compare
|> IList.sort Procdesc.Node.compare
|> IList.remove_duplicates Procdesc.Node.compare
(** get all normal and exceptional predecessors of [n]. *)
let preds t n =
@ -193,12 +193,12 @@ module Exceptional = struct
normal_preds
| exceptional_preds ->
normal_preds @ exceptional_preds
|> IList.sort Cfg.Node.compare
|> IList.remove_duplicates Cfg.Node.compare
|> IList.sort Procdesc.Node.compare
|> IList.remove_duplicates Procdesc.Node.compare
let proc_desc (pdesc, _) = pdesc
let start_node (pdesc, _) = Cfg.Procdesc.get_start_node pdesc
let exit_node (pdesc, _) = Cfg.Procdesc.get_exit_node pdesc
let start_node (pdesc, _) = Procdesc.get_start_node pdesc
let exit_node (pdesc, _) = Procdesc.get_exit_node pdesc
end
(** Wrapper that reverses the direction of the CFG *)
@ -217,9 +217,9 @@ module Backward (Base : S) = struct
let exceptional_preds = Base.exceptional_succs
end
module OneInstrPerNode (Base : S with type node = Cfg.Node.t
and type id = Cfg.Node.id) = struct
include (Base : module type of Base with type id := Cfg.Node.id and type t = Base.t)
module OneInstrPerNode (Base : S with type node = Procdesc.Node.t
and type id = Procdesc.Node.id) = struct
include (Base : module type of Base with type id := Procdesc.Node.id and type t = Base.t)
type id = Base.id * index
include (InstrNode : module type of InstrNode with type t := node and type id := id)
@ -227,7 +227,7 @@ module OneInstrPerNode (Base : S with type node = Cfg.Node.t
let instr_ids t =
IList.mapi
(fun i instr ->
let id = Cfg.Node.get_id t, Instr_index i in
let id = Procdesc.Node.get_id t, Instr_index i in
instr, Some id)
(instrs t)
end

16
infer/src/checkers/procCfg.mli
Unescape View File

@ -17,10 +17,10 @@ module type Node = sig
type t
type id
val kind : t -> Cfg.Node.nodekind
val kind : t -> Procdesc.Node.nodekind
val id : t -> id
val loc : t -> Location.t
val underlying_id : t -> Cfg.Node.id
val underlying_id : t -> Procdesc.Node.id
val id_compare : id -> id -> int
val pp_id : Format.formatter -> id -> unit
end
@ -60,24 +60,24 @@ module type S = sig
val exit_node : t -> node
val proc_desc : t -> Cfg.Procdesc.t
val proc_desc : t -> Procdesc.t
val nodes : t -> node list
val from_pdesc : Cfg.Procdesc.t -> t
val from_pdesc : Procdesc.t -> t
end
module DefaultNode : Node with type t = Cfg.Node.t and type id = Cfg.Node.id
module DefaultNode : Node with type t = Procdesc.Node.t and type id = Procdesc.Node.id
module InstrNode : Node with type t = Cfg.Node.t and type id = Cfg.Node.id * index
module InstrNode : Node with type t = Procdesc.Node.t and type id = Procdesc.Node.id * index
(** Forward CFG with no exceptional control-flow *)
module Normal : S with type t = Cfg.Procdesc.t
module Normal : S with type t = Procdesc.t
and type node = DefaultNode.t
and type id = DefaultNode.id
(** Forward CFG with exceptional control-flow *)
module Exceptional : S with type t = Cfg.Procdesc.t * DefaultNode.t list Cfg.IdMap.t
module Exceptional : S with type t = Procdesc.t * DefaultNode.t list Procdesc.IdMap.t
and type node = DefaultNode.t
and type id = DefaultNode.id

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

@ -9,7 +9,7 @@
open! Utils
type 'a t = { pdesc : Cfg.Procdesc.t; tenv : Tenv.t; extras : 'a; }
type 'a t = { pdesc : Procdesc.t; tenv : Tenv.t; extras : 'a; }
type no_extras = unit

6
infer/src/checkers/procData.mli
Unescape View File

@ -7,12 +7,12 @@
* of patent rights can be found in the PATENTS file in the same directory.
*)
type 'a t = { pdesc : Cfg.Procdesc.t; tenv : Tenv.t; extras : 'a; }
type 'a t = { pdesc : Procdesc.t; tenv : Tenv.t; extras : 'a; }
type no_extras
val empty_extras : no_extras
val make : Cfg.Procdesc.t -> Tenv.t -> 'a -> 'a t
val make : Procdesc.t -> Tenv.t -> 'a -> 'a t
val make_default : Cfg.Procdesc.t -> Tenv.t -> no_extras t
val make_default : Procdesc.t -> Tenv.t -> no_extras t

6
infer/src/checkers/repeatedCallsChecker.ml
Unescape View File

@ -73,7 +73,7 @@ struct
| Sil.Call (_, Exp.Const (Const.Cfun pn), _, loc, _) when proc_is_new pn ->
found := Some loc
| _ -> () in
IList.iter do_instr (Cfg.Node.get_instrs node);
IList.iter do_instr (Procdesc.Node.get_instrs node);
!found in
let module DFAllocCheck = Dataflow.MakeDF(struct
@ -98,7 +98,7 @@ struct
end) in
let transitions = DFAllocCheck.run tenv pdesc None in
match transitions (Cfg.Procdesc.get_exit_node pdesc) with
match transitions (Procdesc.get_exit_node pdesc) with
| DFAllocCheck.Transition (loc, _, _) -> loc
| DFAllocCheck.Dead_state -> None
@ -144,7 +144,7 @@ struct
let () = match get_proc_desc callee_pname with
| None -> ()
| Some proc_desc ->
if Cfg.Procdesc.is_defined proc_desc
if Procdesc.is_defined proc_desc
then report proc_desc in
add_call instr_normalized_args extension
| _ -> extension

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

@ -66,5 +66,5 @@ let callback_sql { Callbacks.proc_desc; proc_name; tenv } =
try
let const_map = ConstantPropagation.build_const_map tenv proc_desc in
if verbose then L.stdout "Analyzing %a...\n@." Procname.pp proc_name;
Cfg.Procdesc.iter_instrs (do_instr const_map) proc_desc
Procdesc.iter_instrs (do_instr const_map) proc_desc
with _ -> ()

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

@ -25,7 +25,7 @@ module type S = sig
val write_summary : Procname.t -> summary -> unit
(* read and return the summary for [callee_pname] called from [caller_pdesc]. does the analysis to
create the summary if needed *)
val read_summary : Tenv.t -> Cfg.Procdesc.t -> Procname.t -> summary option
val read_summary : Tenv.t -> Procdesc.t -> Procname.t -> summary option
end
module Make (H : Helper) = struct

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

@ -22,7 +22,7 @@ type curr_class =
| ContextClsDeclPtr of Clang_ast_t.pointer
| ContextNoCls
type str_node_map = (string, Cfg.Node.t) Hashtbl.t
type str_node_map = (string, Procdesc.Node.t) Hashtbl.t
type t =
{
@ -30,7 +30,7 @@ type t =
tenv : Tenv.t;
cg : Cg.t;
cfg : Cfg.cfg;
procdesc : Cfg.Procdesc.t;
procdesc : Procdesc.t;
is_objc_method : bool;
curr_class: curr_class;
return_param_typ : Typ.t option;
@ -65,7 +65,7 @@ let rec is_objc_instance context =
match context.outer_context with
| Some outer_context -> is_objc_instance outer_context
| None ->
let attrs = Cfg.Procdesc.get_attributes context.procdesc in
let attrs = Procdesc.get_attributes context.procdesc in
attrs.ProcAttributes.is_objc_instance_method
let rec get_curr_class context =
@ -157,4 +157,4 @@ let static_vars_for_block context block_name =
let rec get_outer_procname context =
match context.outer_context with
| Some outer_context -> get_outer_procname outer_context
| None -> Cfg.Procdesc.get_proc_name context.procdesc
| None -> Procdesc.get_proc_name context.procdesc

8
infer/src/clang/cContext.mli
Unescape View File

@ -20,7 +20,7 @@ type curr_class =
| ContextClsDeclPtr of Clang_ast_t.pointer
| ContextNoCls
type str_node_map = (string, Cfg.Node.t) Hashtbl.t
type str_node_map = (string, Procdesc.Node.t) Hashtbl.t
type t =
{
@ -28,7 +28,7 @@ type t =
tenv : Tenv.t;
cg : Cg.t;
cfg : Cfg.cfg;
procdesc : Cfg.Procdesc.t;
procdesc : Procdesc.t;
is_objc_method : bool;
curr_class: curr_class;
return_param_typ : Typ.t option;
@ -38,7 +38,7 @@ type t =
label_map : str_node_map;
}
val get_procdesc : t -> Cfg.Procdesc.t
val get_procdesc : t -> Procdesc.t
val get_cfg : t -> Cfg.cfg
@ -61,7 +61,7 @@ val is_objc_method : t -> bool
val get_tenv : t -> Tenv.t
val create_context : CFrontend_config.translation_unit_context -> Tenv.t -> Cg.t -> Cfg.cfg ->
Cfg.Procdesc.t -> curr_class -> Typ.t option -> bool -> t option -> t
Procdesc.t -> curr_class -> Typ.t option -> bool -> t option -> t
val create_curr_class : Tenv.t -> string -> Csu.class_kind -> curr_class

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

@ -28,21 +28,21 @@ struct
try
(match Cfg.find_proc_desc_from_name cfg procname with
| Some procdesc ->
if (Cfg.Procdesc.is_defined procdesc && not (model_exists procname)) then
if (Procdesc.is_defined procdesc && not (model_exists procname)) then
(let context =
CContext.create_context trans_unit_ctx tenv cg cfg procdesc class_decl_opt
has_return_param is_objc_method outer_context_opt in
let start_node = Cfg.Procdesc.get_start_node procdesc in
let exit_node = Cfg.Procdesc.get_exit_node procdesc in
let start_node = Procdesc.get_start_node procdesc in
let exit_node = Procdesc.get_exit_node procdesc in
Logging.out_debug
"\n\n>>---------- Start translating body of function: '%s' ---------<<\n@."
(Procname.to_string procname);
let meth_body_nodes = T.instructions_trans context body extra_instrs exit_node in
let proc_attributes = Cfg.Procdesc.get_attributes procdesc in
Cfg.Node.add_locals_ret_declaration
start_node proc_attributes (Cfg.Procdesc.get_locals procdesc);
Cfg.Procdesc.node_set_succs_exn procdesc start_node meth_body_nodes [];
Cg.add_defined_node (CContext.get_cg context) (Cfg.Procdesc.get_proc_name procdesc))
let proc_attributes = Procdesc.get_attributes procdesc in
Procdesc.Node.add_locals_ret_declaration
start_node proc_attributes (Procdesc.get_locals procdesc);
Procdesc.node_set_succs_exn procdesc start_node meth_body_nodes [];
Cg.add_defined_node (CContext.get_cg context) (Procdesc.get_proc_name procdesc))
| None -> ())
with
| Not_found -> ()

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

@ -330,9 +330,9 @@ let sil_func_attributes_of_attributes attrs =
let should_create_procdesc cfg procname defined =
match Cfg.find_proc_desc_from_name cfg procname with
| Some previous_procdesc ->
let is_defined_previous = Cfg.Procdesc.is_defined previous_procdesc in
let is_defined_previous = Procdesc.is_defined previous_procdesc in
if defined && (not is_defined_previous) then
(Cfg.remove_proc_desc cfg (Cfg.Procdesc.get_proc_name previous_procdesc);
(Cfg.remove_proc_desc cfg (Procdesc.get_proc_name previous_procdesc);
true)
else false
| None -> true
@ -421,13 +421,13 @@ let create_local_procdesc trans_unit_ctx cfg tenv ms fbody captured is_objc_inst
Cfg.create_proc_desc cfg proc_attributes in
if defined then
(if !Config.arc_mode then
Cfg.Procdesc.set_flag procdesc Mleak_buckets.objc_arc_flag "true";
let start_kind = Cfg.Node.Start_node proc_name in
let start_node = Cfg.Procdesc.create_node procdesc loc_start start_kind [] in
let exit_kind = Cfg.Node.Exit_node proc_name in
let exit_node = Cfg.Procdesc.create_node procdesc loc_exit exit_kind [] in
Cfg.Procdesc.set_start_node procdesc start_node;
Cfg.Procdesc.set_exit_node procdesc exit_node) in
Procdesc.set_flag procdesc Mleak_buckets.objc_arc_flag "true";
let start_kind = Procdesc.Node.Start_node proc_name in
let start_node = Procdesc.create_node procdesc loc_start start_kind [] in
let exit_kind = Procdesc.Node.Exit_node proc_name in
let exit_node = Procdesc.create_node procdesc loc_exit exit_kind [] in
Procdesc.set_start_node procdesc start_node;
Procdesc.set_exit_node procdesc exit_node) in
if should_create_procdesc cfg proc_name defined then
(create_new_procdesc (); true)
else false

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

@ -26,7 +26,7 @@ sig
added before clang statements and the exit node and it returns a list of cfg nodes that
represent the translation of the stmts into sil. *)
val instructions_trans : CContext.t -> Clang_ast_t.stmt -> instr_type list ->
Cfg.Node.t -> Cfg.Node.t list
Procdesc.Node.t -> Procdesc.Node.t list
end
module type CFrontend = sig

102
infer/src/clang/cTrans.ml
Unescape View File

@ -69,7 +69,7 @@ struct
let add_autorelease_call context exp typ sil_loc =
let method_name = Procname.get_method (Cfg.Procdesc.get_proc_name context.CContext.procdesc) in
let method_name = Procname.get_method (Procdesc.get_proc_name context.CContext.procdesc) in
if !Config.arc_mode &&
not (CTrans_utils.is_owning_name method_name) &&
ObjcInterface_decl.is_pointer_to_objc_class typ then
@ -105,7 +105,7 @@ struct
let allocate_block trans_state block_name captured_vars loc =
let tenv = trans_state.context.CContext.tenv in
let procdesc = trans_state.context.CContext.procdesc in
let procname = Cfg.Procdesc.get_proc_name procdesc in
let procname = Procdesc.get_proc_name procdesc in
let mk_field_from_captured_var (var, typ) =
let vname = Pvar.get_name var in
let qual_name = Ast_utils.make_qual_name_decl [block_name] (Mangled.to_string vname) in
@ -244,7 +244,7 @@ struct
Ident.NameGenerator.set_current ident_state
let mk_temp_sil_var procdesc var_name_suffix =
let procname = Cfg.Procdesc.get_proc_name procdesc in
let procname = Procdesc.get_proc_name procdesc in
Pvar.mk_tmp var_name_suffix procname
let mk_temp_sil_var_for_expr tenv procdesc var_name_prefix expr_info =
@ -257,7 +257,7 @@ struct
let procdesc = context.CContext.procdesc in
let (pvar, typ) = mk_temp_sil_var_for_expr context.CContext.tenv procdesc
var_name expr_info in
Cfg.Procdesc.append_locals procdesc [(Pvar.get_name pvar, typ)];
Procdesc.append_locals procdesc [(Pvar.get_name pvar, typ)];
Exp.Lvar pvar, typ
let create_call_instr trans_state return_type function_sil params_sil sil_loc
@ -273,7 +273,7 @@ struct
| _ ->
let procdesc = trans_state.context.CContext.procdesc in
let pvar = mk_temp_sil_var procdesc "__temp_return_" in
Cfg.Procdesc.append_locals procdesc [(Pvar.get_name pvar, return_type)];
Procdesc.append_locals procdesc [(Pvar.get_name pvar, return_type)];
Exp.Lvar pvar in
(* It is very confusing - same expression has two different types in two contexts:*)
(* 1. if passed as parameter it's RETURN_TYPE* since we are passing it as rvalue *)
@ -577,7 +577,7 @@ struct
let this_expr_trans trans_state sil_loc class_type_ptr =
let context = trans_state.context in
let procname = Cfg.Procdesc.get_proc_name context.CContext.procdesc in
let procname = Procdesc.get_proc_name context.CContext.procdesc in
let name = CFrontend_config.this in
let pvar = Pvar.mk (Mangled.from_string name) procname in
let exp = Exp.Lvar pvar in
@ -600,7 +600,7 @@ struct
(* create the label root node into the hashtbl *)
let sil_loc = CLocation.get_sil_location stmt_info context in
let root_node' = GotoLabel.find_goto_label trans_state.context label_name sil_loc in
Cfg.Procdesc.node_set_succs_exn context.procdesc root_node' res_trans.root_nodes [];
Procdesc.node_set_succs_exn context.procdesc root_node' res_trans.root_nodes [];
{ empty_res_trans with root_nodes = [root_node']; leaf_nodes = trans_state.succ_nodes }
and var_deref_trans trans_state stmt_info (decl_ref : Clang_ast_t.decl_ref) =
@ -614,7 +614,7 @@ struct
Typ.Tptr (ast_typ, Pk_reference)
else ast_typ
| _ -> ast_typ in
let procname = Cfg.Procdesc.get_proc_name context.procdesc in
let procname = Procdesc.get_proc_name context.procdesc in
let sil_loc = CLocation.get_sil_location stmt_info context in
let pvar = CVar_decl.sil_var_of_decl_ref context decl_ref procname in
CContext.add_block_static_var context procname (pvar, typ);
@ -750,7 +750,7 @@ struct
if res_trans_idx.root_nodes <> []
then
IList.iter
(fun n -> Cfg.Procdesc.node_set_succs_exn context.procdesc n res_trans_idx.root_nodes [])
(fun n -> Procdesc.node_set_succs_exn context.procdesc n res_trans_idx.root_nodes [])
res_trans_a.leaf_nodes;
(* Note the order of res_trans_idx.ids @ res_trans_a.ids is important. *)
@ -832,7 +832,7 @@ struct
let context = trans_state.context in
let fn_type_no_ref = CType_decl.get_type_from_expr_info expr_info context.CContext.tenv in
let function_type = add_reference_if_glvalue fn_type_no_ref expr_info in
let procname = Cfg.Procdesc.get_proc_name context.CContext.procdesc in
let procname = Procdesc.get_proc_name context.CContext.procdesc in
let sil_loc = CLocation.get_sil_location si context in
(* First stmt is the function expr and the rest are params *)
let fun_exp_stmt, params_stmt = (match stmt_list with
@ -909,7 +909,7 @@ struct
si function_type is_cpp_call_virtual extra_res_trans =
let open CContext in
let context = trans_state_pri.context in
let procname = Cfg.Procdesc.get_proc_name context.procdesc in
let procname = Procdesc.get_proc_name context.procdesc in
let sil_loc = CLocation.get_sil_location si context in
(* first for method address, second for 'this' expression *)
assert ((IList.length result_trans_callee.exps) = 2);
@ -973,9 +973,9 @@ struct
| Some exp_typ -> exp_typ
| None ->
let procdesc = trans_state.context.CContext.procdesc in
let pvar = Pvar.mk_tmp "__temp_construct_" (Cfg.Procdesc.get_proc_name procdesc) in
let pvar = Pvar.mk_tmp "__temp_construct_" (Procdesc.get_proc_name procdesc) in
let class_type = CType_decl.get_type_from_expr_info ei context.CContext.tenv in
Cfg.Procdesc.append_locals procdesc [(Pvar.get_name pvar, class_type)];
Procdesc.append_locals procdesc [(Pvar.get_name pvar, class_type)];
Exp.Lvar pvar, class_type in
let this_type = Typ.Tptr (class_type, Typ.Pk_pointer) in
let this_res_trans = { empty_res_trans with
@ -1067,7 +1067,7 @@ struct
method_type trans_state_pri sil_loc subexpr_exprs with
| Some res -> res
| None ->
let procname = Cfg.Procdesc.get_proc_name context.CContext.procdesc in
let procname = Procdesc.get_proc_name context.CContext.procdesc in
let callee_name, method_call_type = get_callee_objc_method context obj_c_message_expr_info
subexpr_exprs in
let res_trans_add_self = Self.add_self_parameter_for_super_instance context procname sil_loc
@ -1101,7 +1101,7 @@ struct
and block_enumeration_trans trans_state stmt_info stmt_list ei =
Logging.out_debug "\n Call to a block enumeration function treated as special case...\n@.";
let procname = Cfg.Procdesc.get_proc_name trans_state.context.CContext.procdesc in
let procname = Procdesc.get_proc_name trans_state.context.CContext.procdesc in
let pvar = CFrontend_utils.General_utils.get_next_block_pvar procname in
let transformed_stmt, _ =
Ast_expressions.translate_block_enumerate (Pvar.to_string pvar) stmt_info stmt_list ei in
@ -1132,7 +1132,7 @@ struct
let prune_nodes_t, prune_nodes_f = IList.partition is_true_prune_node prune_nodes in
let prune_nodes' = if branch then prune_nodes_t else prune_nodes_f in
IList.iter
(fun n -> Cfg.Procdesc.node_set_succs_exn context.procdesc n res_trans.root_nodes [])
(fun n -> Procdesc.node_set_succs_exn context.procdesc n res_trans.root_nodes [])
prune_nodes' in
(match stmt_list with
| [cond; exp1; exp2] ->
@ -1140,10 +1140,10 @@ struct
CType_decl.type_ptr_to_sil_type
context.CContext.tenv expr_info.Clang_ast_t.ei_type_ptr in
let var_typ = add_reference_if_glvalue typ expr_info in
let join_node = create_node (Cfg.Node.Join_node) [] sil_loc context in
Cfg.Procdesc.node_set_succs_exn context.procdesc join_node succ_nodes [];
let join_node = create_node (Procdesc.Node.Join_node) [] sil_loc context in
Procdesc.node_set_succs_exn context.procdesc join_node succ_nodes [];
let pvar = mk_temp_sil_var procdesc "SIL_temp_conditional___" in
Cfg.Procdesc.append_locals procdesc [(Pvar.get_name pvar, var_typ)];
Procdesc.append_locals procdesc [(Pvar.get_name pvar, var_typ)];
let continuation' = mk_cond_continuation trans_state.continuation in
let trans_state' = { trans_state with continuation = continuation'; succ_nodes = [] } in
let res_trans_cond = exec_with_priority_exception trans_state' cond cond_trans in
@ -1214,7 +1214,7 @@ struct
let prune_t = mk_prune_node true e' instrs' in
let prune_f = mk_prune_node false e' instrs' in
IList.iter
(fun n' -> Cfg.Procdesc.node_set_succs_exn context.procdesc n' [prune_t; prune_f] [])
(fun n' -> Procdesc.node_set_succs_exn context.procdesc n' [prune_t; prune_f] [])
res_trans_cond.leaf_nodes;
let rnodes = if (IList.length res_trans_cond.root_nodes) = 0 then
[prune_t; prune_f]
@ -1247,7 +1247,7 @@ struct
| Binop.LOr -> prune_nodes_f, prune_nodes_t
| _ -> assert false) in
IList.iter
(fun n -> Cfg.Procdesc.node_set_succs_exn context.procdesc n res_trans_s2.root_nodes [])
(fun n -> Procdesc.node_set_succs_exn context.procdesc n res_trans_s2.root_nodes [])
prune_to_s2;
let root_nodes_to_parent =
if (IList.length res_trans_s1.root_nodes) = 0
@ -1287,8 +1287,8 @@ struct
let context = trans_state.context in
let succ_nodes = trans_state.succ_nodes in
let sil_loc = CLocation.get_sil_location stmt_info context in
let join_node = create_node (Cfg.Node.Join_node) [] sil_loc context in
Cfg.Procdesc.node_set_succs_exn context.procdesc join_node succ_nodes [];
let join_node = create_node (Procdesc.Node.Join_node) [] sil_loc context in
Procdesc.node_set_succs_exn context.procdesc join_node succ_nodes [];
let trans_state' = { trans_state with succ_nodes = [join_node] } in
let do_branch branch stmt_branch prune_nodes =
(* leaf nodes are ignored here as they will be already attached to join_node *)
@ -1296,13 +1296,14 @@ struct
let nodes_branch =
(match res_trans_b.root_nodes with
| [] ->
[create_node (Cfg.Node.Stmt_node "IfStmt Branch") res_trans_b.instrs sil_loc context]
[create_node
(Procdesc.Node.Stmt_node "IfStmt Branch") res_trans_b.instrs sil_loc context]
| _ ->
res_trans_b.root_nodes) in
let prune_nodes_t, prune_nodes_f = IList.partition is_true_prune_node prune_nodes in
let prune_nodes' = if branch then prune_nodes_t else prune_nodes_f in
IList.iter
(fun n -> Cfg.Procdesc.node_set_succs_exn context.procdesc n nodes_branch [])
(fun n -> Procdesc.node_set_succs_exn context.procdesc n nodes_branch [])
prune_nodes' in
(match stmt_list with
| [_; decl_stmt; cond; stmt1; stmt2] ->
@ -1336,11 +1337,11 @@ struct
let trans_state' ={ trans_state_pri with succ_nodes = []} in
let res_trans_cond_tmp = instruction trans_state' cond in
let switch_special_cond_node =
let node_kind = Cfg.Node.Stmt_node "Switch_stmt" in
let node_kind = Procdesc.Node.Stmt_node "Switch_stmt" in
create_node node_kind res_trans_cond_tmp.instrs sil_loc context in
IList.iter
(fun n' ->
Cfg.Procdesc.node_set_succs_exn context.procdesc n' [switch_special_cond_node] [])
Procdesc.node_set_succs_exn context.procdesc n' [switch_special_cond_node] [])
res_trans_cond_tmp.leaf_nodes;
let root_nodes =
if res_trans_cond_tmp.root_nodes <> [] then res_trans_cond_tmp.root_nodes
@ -1438,29 +1439,30 @@ struct
let case_entry_point = connected_instruction (IList.rev case_content) last_nodes in
(* connects between cases, then continuation has priority about breaks *)
let prune_node_t, prune_node_f = create_prune_nodes_for_case case in
Cfg.Procdesc.node_set_succs_exn context.procdesc prune_node_t case_entry_point [];
Cfg.Procdesc.node_set_succs_exn context.procdesc prune_node_f last_prune_nodes [];
Procdesc.node_set_succs_exn context.procdesc prune_node_t case_entry_point [];
Procdesc.node_set_succs_exn context.procdesc prune_node_f last_prune_nodes [];
case_entry_point, [prune_node_t; prune_node_f]
| DefaultStmt(stmt_info, default_content) :: rest ->
let sil_loc = CLocation.get_sil_location stmt_info context in
let placeholder_entry_point =
create_node (Cfg.Node.Stmt_node "DefaultStmt_placeholder") [] sil_loc context in
create_node
(Procdesc.Node.Stmt_node "DefaultStmt_placeholder") [] sil_loc context in
let last_nodes, last_prune_nodes =
translate_and_connect_cases rest next_nodes [placeholder_entry_point] in
let default_entry_point =
connected_instruction (IList.rev default_content) last_nodes in
Cfg.Procdesc.node_set_succs_exn
Procdesc.node_set_succs_exn
context.procdesc placeholder_entry_point default_entry_point [];
default_entry_point, last_prune_nodes
| _ -> assert false in
let top_entry_point, top_prune_nodes =
translate_and_connect_cases list_of_cases succ_nodes succ_nodes in
let _ = connected_instruction (IList.rev pre_case_stmts) top_entry_point in
Cfg.Procdesc.node_set_succs_exn
Procdesc.node_set_succs_exn
context.procdesc switch_special_cond_node top_prune_nodes [];
let top_nodes = res_trans_decl.root_nodes in
IList.iter
(fun n' -> Cfg.Node.append_instrs n' []) succ_nodes;
(fun n' -> Procdesc.Node.append_instrs n' []) succ_nodes;
(* succ_nodes will remove the temps *)
{ empty_res_trans with root_nodes = top_nodes; leaf_nodes = succ_nodes }
| _ -> assert false
@ -1480,7 +1482,7 @@ struct
let context = trans_state.context in
let succ_nodes = trans_state.succ_nodes in
let sil_loc = CLocation.get_sil_location stmt_info context in
let join_node = create_node Cfg.Node.Join_node [] sil_loc context in
let join_node = create_node Procdesc.Node.Join_node [] sil_loc context in
let continuation = Some { break = succ_nodes; continue = [join_node]; return_temp = false } in
(* set the flat to inform that we are translating a condition of a if *)
let continuation_cond = mk_cond_continuation outer_continuation in
@ -1538,12 +1540,12 @@ struct
match loop_kind with
| Loops.For _ | Loops.While _ -> res_trans_body.root_nodes
| Loops.DoWhile _ -> [join_node] in
Cfg.Procdesc.node_set_succs_exn context.procdesc join_node join_succ_nodes [];
Procdesc.node_set_succs_exn context.procdesc join_node join_succ_nodes [];
IList.iter
(fun n -> Cfg.Procdesc.node_set_succs_exn context.procdesc n prune_t_succ_nodes [])
(fun n -> Procdesc.node_set_succs_exn context.procdesc n prune_t_succ_nodes [])
prune_nodes_t;
IList.iter
(fun n -> Cfg.Procdesc.node_set_succs_exn context.procdesc n succ_nodes [])
(fun n -> Procdesc.node_set_succs_exn context.procdesc n succ_nodes [])
prune_nodes_f;
let root_nodes =
match loop_kind with
@ -1719,7 +1721,7 @@ struct
let open Clang_ast_t in
let context = trans_state.context in
let procdesc = context.CContext.procdesc in
let procname = Cfg.Procdesc.get_proc_name procdesc in
let procname = Procdesc.get_proc_name procdesc in
let do_var_dec (di, var_name, qual_type, vdi) next_node =
let var_decl = VarDecl (di, var_name, qual_type, vdi) in
let pvar = CVar_decl.sil_var_of_decl context var_decl procname in
@ -1891,26 +1893,26 @@ struct
let sil_loc = CLocation.get_sil_location stmt_info context in
let trans_state_pri = PriorityNode.try_claim_priority_node trans_state stmt_info in
let mk_ret_node instrs =
let ret_node = create_node (Cfg.Node.Stmt_node "Return Stmt") instrs sil_loc context in
Cfg.Procdesc.node_set_succs_exn
let ret_node = create_node (Procdesc.Node.Stmt_node "Return Stmt") instrs sil_loc context in
Procdesc.node_set_succs_exn
context.procdesc
ret_node [(Cfg.Procdesc.get_exit_node context.CContext.procdesc)] [];
ret_node [(Procdesc.get_exit_node context.CContext.procdesc)] [];
ret_node in
let trans_result = (match stmt_list with
| [stmt] -> (* return exp; *)
let procdesc = context.CContext.procdesc in
let ret_type = Cfg.Procdesc.get_ret_type procdesc in
let ret_type = Procdesc.get_ret_type procdesc in
let ret_exp, ret_typ, var_instrs = match context.CContext.return_param_typ with
| Some ret_param_typ ->
let name = CFrontend_config.return_param in
let procname = Cfg.Procdesc.get_proc_name procdesc in
let procname = Procdesc.get_proc_name procdesc in
let pvar = Pvar.mk (Mangled.from_string name) procname in
let id = Ident.create_fresh Ident.knormal in
let instr = Sil.Load (id, Exp.Lvar pvar, ret_param_typ, sil_loc) in
let ret_typ = match ret_param_typ with Typ.Tptr (t, _) -> t | _ -> assert false in
Exp.Var id, ret_typ, [instr]
| None ->
Exp.Lvar (Cfg.Procdesc.get_ret_var procdesc), ret_type, [] in
Exp.Lvar (Procdesc.get_ret_var procdesc), ret_type, [] in
let trans_state' = { trans_state_pri with
succ_nodes = [];
var_exp_typ = Some (ret_exp, ret_typ) } in
@ -1926,7 +1928,7 @@ struct
let instrs = var_instrs @ res_trans_stmt.instrs @ ret_instrs @ autorelease_instrs in
let ret_node = mk_ret_node instrs in
IList.iter
(fun n -> Cfg.Procdesc.node_set_succs_exn procdesc n [ret_node] [])
(fun n -> Procdesc.node_set_succs_exn procdesc n [ret_node] [])
res_trans_stmt.leaf_nodes;
let root_nodes_to_parent =
if IList.length res_trans_stmt.root_nodes >0
@ -2011,9 +2013,9 @@ struct
Sil.Call
(ret_id, (Exp.Const (Const.Cfun fname)),
autorelease_pool_vars, sil_loc, CallFlags.default) in
let node_kind = Cfg.Node.Stmt_node ("Release the autorelease pool") in
let node_kind = Procdesc.Node.Stmt_node ("Release the autorelease pool") in
let call_node = create_node node_kind [stmt_call] sil_loc context in
Cfg.Procdesc.node_set_succs_exn context.procdesc call_node trans_state.succ_nodes [];
Procdesc.node_set_succs_exn context.procdesc call_node trans_state.succ_nodes [];
let trans_state'={ trans_state with continuation = None; succ_nodes =[call_node] } in
instructions trans_state' stmts
@ -2029,7 +2031,7 @@ struct
and blockExpr_trans trans_state stmt_info expr_info decl =
let context = trans_state.context in
let procname = Cfg.Procdesc.get_proc_name context.CContext.procdesc in
let procname = Procdesc.get_proc_name context.CContext.procdesc in
let loc =
(match stmt_info.Clang_ast_t.si_source_range with (l1, _) ->
CLocation.clang_to_sil_location context.CContext.translation_unit_context l1) in
@ -2099,7 +2101,7 @@ struct
let type_ptr = expr_info.Clang_ast_t.ei_type_ptr in
let context = trans_state.context in
call_translation context decl;
let procname = Cfg.Procdesc.get_proc_name context.procdesc in
let procname = Procdesc.get_proc_name context.procdesc in
let lambda_pname = CMethod_trans.get_procname_from_cpp_lambda context decl in
let typ = CType_decl.type_ptr_to_sil_type context.tenv type_ptr in
(* We need to set the explicit dependency between the newly created lambda and the *)
@ -2199,7 +2201,7 @@ struct
let (pvar, typ) = mk_temp_sil_var_for_expr context.CContext.tenv procdesc
"SIL_materialize_temp__" expr_info in
let temp_exp = match stmt_list with [p] -> p | _ -> assert false in
Cfg.Procdesc.append_locals procdesc [(Pvar.get_name pvar, typ)];
Procdesc.append_locals procdesc [(Pvar.get_name pvar, typ)];
let var_exp_typ = (Exp.Lvar pvar, typ) in
let res_trans = init_expr_trans trans_state var_exp_typ stmt_info (Some temp_exp) in
{ res_trans with exps = [var_exp_typ] }

44
infer/src/clang/cTrans_utils.ml
Unescape View File

@ -35,26 +35,26 @@ let extract_exp_from_list el warning_string =
module Nodes =
struct
let prune_kind b = Cfg.Node.Prune_node(b, Sil.Ik_bexp , ((string_of_bool b)^" Branch"))
let prune_kind b = Procdesc.Node.Prune_node(b, Sil.Ik_bexp , ((string_of_bool b)^" Branch"))
let is_join_node n =
match Cfg.Node.get_kind n with
| Cfg.Node.Join_node -> true
match Procdesc.Node.get_kind n with
| Procdesc.Node.Join_node -> true
| _ -> false
let is_prune_node n =
match Cfg.Node.get_kind n with
| Cfg.Node.Prune_node _ -> true
match Procdesc.Node.get_kind n with
| Procdesc.Node.Prune_node _ -> true
| _ -> false
let is_true_prune_node n =
match Cfg.Node.get_kind n with
| Cfg.Node.Prune_node(true, _, _) -> true
match Procdesc.Node.get_kind n with
| Procdesc.Node.Prune_node(true, _, _) -> true
| _ -> false
let create_node node_kind instrs loc context =
let procdesc = CContext.get_procdesc context in
Cfg.Procdesc.create_node procdesc loc node_kind instrs
Procdesc.create_node procdesc loc node_kind instrs
let create_prune_node branch e_cond instrs_cond loc ik context =
let (e_cond', _) = extract_exp_from_list e_cond
@ -92,14 +92,14 @@ struct
Hashtbl.find context.CContext.label_map label
with Not_found ->
let node_name = Format.sprintf "GotoLabel_%s" label in
let new_node = Nodes.create_node (Cfg.Node.Skip_node node_name) [] sil_loc context in
let new_node = Nodes.create_node (Procdesc.Node.Skip_node node_name) [] sil_loc context in
Hashtbl.add context.CContext.label_map label new_node;
new_node
end
type continuation = {
break: Cfg.Node.t list;
continue: Cfg.Node.t list;
break: Procdesc.Node.t list;
continue: Procdesc.Node.t list;
return_temp : bool; (* true if temps should not be removed in the node but returned to ancestors *)
}
@ -127,7 +127,7 @@ type priority_node =
(* it need to carry on the tranlsation. *)
type trans_state = {
context: CContext.t; (* current context of the translation *)
succ_nodes: Cfg.Node.t list; (* successor nodes in the cfg *)
succ_nodes: Procdesc.Node.t list; (* successor nodes in the cfg *)
continuation: continuation option; (* current continuation *)
priority: priority_node;
var_exp_typ: (Exp.t * Typ.t) option;
@ -137,8 +137,8 @@ type trans_state = {
(* A translation result. It is returned by the translation function. *)
type trans_result = {
root_nodes: Cfg.Node.t list; (* Top cfg nodes (root) created by the translation *)
leaf_nodes: Cfg.Node.t list; (* Bottom cfg nodes (leaf) created by the translate *)
root_nodes: Procdesc.Node.t list; (* Top cfg nodes (root) created by the translation *)
leaf_nodes: Procdesc.Node.t list; (* Bottom cfg nodes (leaf) created by the translate *)
instrs: Sil.instr list; (* list of SIL instruction that need to be placed in cfg nodes of the parent*)
exps: (Exp.t * Typ.t) list; (* SIL expressions resulting from translation of clang stmt *)
initd_exps: Exp.t list;
@ -171,7 +171,7 @@ let collect_res_trans pdesc l =
else rt.leaf_nodes in
if rt'.root_nodes <> [] then
IList.iter
(fun n -> Cfg.Procdesc.node_set_succs_exn pdesc n rt'.root_nodes [])
(fun n -> Procdesc.node_set_succs_exn pdesc n rt'.root_nodes [])
rt.leaf_nodes;
collect l'
{ root_nodes = root_nodes;
@ -244,11 +244,11 @@ struct
let create_node = own_priority_node trans_state.priority stmt_info && res_state.instrs <> [] in
if create_node then
(* We need to create a node *)
let node_kind = Cfg.Node.Stmt_node (nd_name) in
let node_kind = Procdesc.Node.Stmt_node (nd_name) in
let node = Nodes.create_node node_kind res_state.instrs loc trans_state.context in
Cfg.Procdesc.node_set_succs_exn trans_state.context.procdesc node trans_state.succ_nodes [];
Procdesc.node_set_succs_exn trans_state.context.procdesc node trans_state.succ_nodes [];
IList.iter
(fun leaf -> Cfg.Procdesc.node_set_succs_exn trans_state.context.procdesc leaf [node] [])
(fun leaf -> Procdesc.node_set_succs_exn trans_state.context.procdesc leaf [node] [])
res_state.leaf_nodes;
(* Invariant: if root_nodes is empty then the params have not created a node.*)
let root_nodes = (if res_state.root_nodes <> [] then res_state.root_nodes
@ -446,16 +446,16 @@ let trans_assertion_failure sil_loc (context : CContext.t) =
let assert_fail_builtin = Exp.Const (Const.Cfun BuiltinDecl.__infer_fail) in
let args = [Exp.Const (Const.Cstr Config.default_failure_name), Typ.Tvoid] in
let call_instr = Sil.Call (None, assert_fail_builtin, args, sil_loc, CallFlags.default) in
let exit_node = Cfg.Procdesc.get_exit_node (CContext.get_procdesc context)
let exit_node = Procdesc.get_exit_node (CContext.get_procdesc context)
and failure_node =
Nodes.create_node (Cfg.Node.Stmt_node "Assertion failure") [call_instr] sil_loc context in
Cfg.Procdesc.node_set_succs_exn context.procdesc failure_node [exit_node] [];
Nodes.create_node (Procdesc.Node.Stmt_node "Assertion failure") [call_instr] sil_loc context in
Procdesc.node_set_succs_exn context.procdesc failure_node [exit_node] [];
{ empty_res_trans with root_nodes = [failure_node]; }
let trans_assume_false sil_loc (context : CContext.t) succ_nodes =
let instrs_cond = [Sil.Prune (Exp.zero, sil_loc, true, Sil.Ik_land_lor)] in
let prune_node = Nodes.create_node (Nodes.prune_kind true) instrs_cond sil_loc context in
Cfg.Procdesc.node_set_succs_exn context.procdesc prune_node succ_nodes [];
Procdesc.node_set_succs_exn context.procdesc prune_node succ_nodes [];
{ empty_res_trans with root_nodes = [prune_node]; leaf_nodes = [prune_node] }
let trans_assertion trans_state sil_loc =

27
infer/src/clang/cTrans_utils.mli
Unescape View File

@ -12,8 +12,8 @@ open! Utils
(** Utility methods to support the translation of clang ast constructs into sil instructions. *)
type continuation = {
break: Cfg.Node.t list;
continue: Cfg.Node.t list;
break: Procdesc.Node.t list;
continue: Procdesc.Node.t list;
return_temp : bool; (* true if temps should not be removed in the node but returned to ancestors *)
}
@ -23,7 +23,7 @@ type priority_node =
type trans_state = {
context: CContext.t;
succ_nodes: Cfg.Node.t list;
succ_nodes: Procdesc.Node.t list;
continuation: continuation option;
priority: priority_node;
var_exp_typ: (Exp.t * Typ.t) option;
@ -32,8 +32,8 @@ type trans_state = {
}
type trans_result = {
root_nodes: Cfg.Node.t list;
leaf_nodes: Cfg.Node.t list;
root_nodes: Procdesc.Node.t list;
leaf_nodes: Procdesc.Node.t list;
instrs: Sil.instr list;
exps: (Exp.t * Typ.t) list;
initd_exps: Exp.t list;
@ -44,7 +44,7 @@ val empty_res_trans: trans_result
val undefined_expression: unit -> Exp.t
val collect_res_trans : Cfg.Procdesc.t -> trans_result list -> trans_result
val collect_res_trans : Procdesc.t -> trans_result list -> trans_result
val extract_var_exp_or_fail : trans_state -> Exp.t * Typ.t
@ -125,19 +125,20 @@ sig
val need_unary_op_node : Clang_ast_t.unary_operator_info -> bool
val create_node : Cfg.Node.nodekind -> Sil.instr list -> Location.t -> CContext.t -> Cfg.Node.t
val create_node :
Procdesc.Node.nodekind -> Sil.instr list -> Location.t -> CContext.t -> Procdesc.Node.t
val is_join_node : Cfg.Node.t -> bool
val is_join_node : Procdesc.Node.t -> bool
val create_prune_node :
bool -> (Exp.t * Typ.t) list -> Sil.instr list -> Location.t -> Sil.if_kind ->
CContext.t -> Cfg.Node.t
CContext.t -> Procdesc.Node.t
val is_prune_node : Cfg.Node.t -> bool
val is_prune_node : Procdesc.Node.t -> bool
val is_true_prune_node : Cfg.Node.t -> bool
val is_true_prune_node : Procdesc.Node.t -> bool
val prune_kind : bool -> Cfg.Node.nodekind
val prune_kind : bool -> Procdesc.Node.nodekind
end
@ -175,7 +176,7 @@ end
(** Module for translating goto instructions by keeping a map of labels. *)
module GotoLabel :
sig
val find_goto_label : CContext.t -> string -> Location.t -> Cfg.Node.t
val find_goto_label : CContext.t -> string -> Location.t -> Procdesc.Node.t
end
(** Module that provides utility functions for translating different types of loops. *)

6
infer/src/clang/cVar_decl.ml
Unescape View File

@ -59,11 +59,11 @@ let add_var_to_locals procdesc var_decl sil_typ pvar =
match var_decl with
| VarDecl (_, _, _, vdi) ->
if not vdi.Clang_ast_t.vdi_is_global then
Cfg.Procdesc.append_locals procdesc [(Pvar.get_name pvar, sil_typ)]
Procdesc.append_locals procdesc [(Pvar.get_name pvar, sil_typ)]
| _ -> assert false
let rec compute_autorelease_pool_vars context stmts =
let procname = Cfg.Procdesc.get_proc_name context.CContext.procdesc in
let procname = Procdesc.get_proc_name context.CContext.procdesc in
match stmts with
| [] -> []
| Clang_ast_t.DeclRefExpr (_, _, _, drei):: stmts' ->
@ -86,7 +86,7 @@ let rec compute_autorelease_pool_vars context stmts =
(* Returns a list of captured variables as sil variables. *)
let captured_vars_from_block_info context cvl =
let procname = Cfg.Procdesc.get_proc_name context.CContext.procdesc in
let procname = Procdesc.get_proc_name context.CContext.procdesc in
let sil_var_of_captured_var cv vars =
match cv.Clang_ast_t.bcv_variable with
| Some dr ->

2
infer/src/clang/cVar_decl.mli
Unescape View File

@ -16,7 +16,7 @@ val sil_var_of_decl : CContext.t -> Clang_ast_t.decl -> Procname.t -> Pvar.t
val sil_var_of_decl_ref : CContext.t -> Clang_ast_t.decl_ref -> Procname.t -> Pvar.t
val add_var_to_locals : Cfg.Procdesc.t -> Clang_ast_t.decl -> Typ.t -> Pvar.t -> unit
val add_var_to_locals : Procdesc.t -> Clang_ast_t.decl -> Typ.t -> Pvar.t -> unit
val compute_autorelease_pool_vars : CContext.t -> Clang_ast_t.stmt list -> (Exp.t * Typ.t) list

6
infer/src/clang/printing.ml
Unescape View File

@ -57,14 +57,14 @@ let print_procedures cfg =
let procs = Cfg.get_all_procs cfg in
Logging.do_out "%s"
(IList.to_string (fun pdesc ->
let pname = Cfg.Procdesc.get_proc_name pdesc in
let pname = Procdesc.get_proc_name pdesc in
"name> "^
(Procname.to_string pname) ^
" defined? " ^ (string_of_bool (Cfg.Procdesc.is_defined pdesc)) ^ "\n")
" defined? " ^ (string_of_bool (Procdesc.is_defined pdesc)) ^ "\n")
procs)
let print_nodes nodes =
IList.iter (fun node -> Logging.do_out "%s" (Cfg.Node.get_description pe_text node)) nodes
IList.iter (fun node -> Logging.do_out "%s" (Procdesc.Node.get_description pe_text node)) nodes
let instrs_to_string instrs =
let pp fmt () = Format.fprintf fmt "%a" (Sil.pp_instr_list pe_text) instrs in

2
infer/src/clang/printing.mli
Unescape View File

@ -15,7 +15,7 @@ val print_tenv_struct_unions : Tenv.t -> unit
val print_procedures : Cfg.cfg -> unit
val print_nodes : Cfg.Node.t list -> unit
val print_nodes : Procdesc.Node.t list -> unit
val instrs_to_string : Sil.instr list -> string

26
infer/src/eradicate/eradicate.ml
Unescape View File

@ -46,7 +46,7 @@ struct
let update_summary proc_name proc_desc final_typestate_opt =
match Specs.get_summary proc_name with
| Some old_summ ->
let nodes = IList.map (fun n -> Cfg.Node.get_id n) (Cfg.Procdesc.get_nodes proc_desc) in
let nodes = IList.map (fun n -> Procdesc.Node.get_id n) (Procdesc.get_nodes proc_desc) in
let method_annotation =
(Specs.pdesc_resolve_attributes proc_desc).ProcAttributes.method_annotation in
let new_summ =
@ -58,7 +58,7 @@ struct
Specs.attributes =
{
old_summ.Specs.attributes with
ProcAttributes.loc = Cfg.Procdesc.get_loc proc_desc;
ProcAttributes.loc = Procdesc.get_loc proc_desc;
method_annotation;
};
} in
@ -82,7 +82,7 @@ struct
(* Check the nullable flag computed for the return value and report inconsistencies. *)
let check_return find_canonical_duplicate exit_node final_typestate ret_ia ret_type loc : unit =
let ret_pvar = Cfg.Procdesc.get_ret_var curr_pdesc in
let ret_pvar = Procdesc.get_ret_var curr_pdesc in
let ret_range = TypeState.lookup_pvar ret_pvar final_typestate in
let typ_found_opt = match ret_range with
| Some (typ_found, _, _) -> Some typ_found
@ -106,7 +106,7 @@ struct
(TypeState.pp Extension.ext) initial_typestate in
let do_after_dataflow find_canonical_duplicate final_typestate =
let exit_node = Cfg.Procdesc.get_exit_node curr_pdesc in
let exit_node = Procdesc.get_exit_node curr_pdesc in
let ia, ret_type = annotated_signature.Annotations.ret in
check_return find_canonical_duplicate exit_node final_typestate ia ret_type proc_loc in
@ -124,7 +124,7 @@ struct
IList.iter (fun typestate_succ ->
L.stdout
"Typestate After Node %a@\n%a@."
Cfg.Node.pp node
Procdesc.Node.pp node
(TypeState.pp Extension.ext) typestate_succ)
typestates_succ;
typestates_succ, typestates_exn
@ -133,7 +133,7 @@ struct
let initial_typestate = get_initial_typestate () in
do_before_dataflow initial_typestate;
let transitions = DFTypeCheck.run tenv curr_pdesc initial_typestate in
match transitions (Cfg.Procdesc.get_exit_node curr_pdesc) with
match transitions (Procdesc.get_exit_node curr_pdesc) with
| DFTypeCheck.Transition (final_typestate, _, _) ->
do_after_dataflow find_canonical_duplicate final_typestate;
!calls_this, Some final_typestate
@ -155,7 +155,7 @@ struct
let find_duplicate_nodes = State.mk_find_duplicate_nodes curr_pdesc in
let find_canonical_duplicate node =
let duplicate_nodes = find_duplicate_nodes node in
try Cfg.NodeSet.min_elt duplicate_nodes with
try Procdesc.NodeSet.min_elt duplicate_nodes with
| Not_found -> node in
let typecheck_proc do_checks pname pdesc proc_details_opt =
@ -164,8 +164,8 @@ struct
(ann_sig, loc, idenv_pn)
| None ->
let ann_sig =
Models.get_modelled_annotated_signature (Cfg.Procdesc.get_attributes pdesc) in
let loc = Cfg.Procdesc.get_loc pdesc in
Models.get_modelled_annotated_signature (Procdesc.get_attributes pdesc) in
let loc = Procdesc.get_loc pdesc in
let idenv_pn = Idenv.create_from_idenv idenv pdesc in
(ann_sig, loc, idenv_pn) in
let checks', calls_this' =
@ -181,7 +181,7 @@ struct
pname pdesc ann_sig linereader loc in
let module Initializers = struct
type init = Procname.t * Cfg.Procdesc.t
type init = Procname.t * Procdesc.t
let final_typestates initializers_current_class =
(* Get the private methods, from the same class, directly called by the initializers. *)
@ -294,7 +294,7 @@ struct
let do_final_typestate typestate_opt calls_this =
let do_typestate typestate =
let start_node = Cfg.Procdesc.get_start_node curr_pdesc in
let start_node = Procdesc.get_start_node curr_pdesc in
if not calls_this && (* if 'this(...)' is called, no need to check initialization *)
check_field_initialization &&
checks.TypeCheck.eradicate
@ -346,7 +346,7 @@ struct
match filter_special_cases () with
| None -> ()
| Some annotated_signature ->
let loc = Cfg.Procdesc.get_loc proc_desc in
let loc = Procdesc.get_loc proc_desc in
let linereader = Printer.LineReader.create () in
if Config.eradicate_verbose then
L.stdout "%a@."
@ -404,7 +404,7 @@ let callback_eradicate
Main.callback checks
{ callback_args with
Callbacks.idenv = idenv_pname;
proc_name = (Cfg.Procdesc.get_proc_name pdesc);
proc_name = (Procdesc.get_proc_name pdesc);
proc_desc = pdesc; } in
{
Ondemand.analyze_ondemand;

18
infer/src/eradicate/eradicateChecks.ml
Unescape View File

@ -112,7 +112,7 @@ let check_condition tenv case_zero find_canonical_duplicate curr_pdesc
let contains_instanceof_throwable pdesc node =
(* Check if the current procedure has a catch Throwable. *)
(* That always happens in the bytecode generated by try-with-resources. *)
let loc = Cfg.Node.get_loc node in
let loc = Procdesc.Node.get_loc node in
let throwable_found = ref false in
let typ_is_throwable = function
| Typ.Tstruct (TN_csu (Class Java, _) as name) ->
@ -124,9 +124,9 @@ let check_condition tenv case_zero find_canonical_duplicate curr_pdesc
throwable_found := true
| _ -> () in
let do_node n =
if Location.equal loc (Cfg.Node.get_loc n)
then IList.iter do_instr (Cfg.Node.get_instrs n) in
Cfg.Procdesc.iter_nodes do_node pdesc;
if Location.equal loc (Procdesc.Node.get_loc n)
then IList.iter do_instr (Procdesc.Node.get_instrs n) in
Procdesc.iter_nodes do_node pdesc;
!throwable_found in
let from_try_with_resources () : bool =
@ -168,7 +168,7 @@ let check_nonzero tenv find_canonical_duplicate = check_condition tenv false fin
let check_field_assignment tenv
find_canonical_duplicate curr_pdesc node instr_ref typestate exp_lhs
exp_rhs typ loc fname t_ia_opt typecheck_expr : unit =
let curr_pname = Cfg.Procdesc.get_proc_name curr_pdesc in
let curr_pname = Procdesc.get_proc_name curr_pdesc in
let (t_lhs, ta_lhs, _) =
typecheck_expr node instr_ref curr_pdesc typestate exp_lhs
(typ, TypeAnnotation.const Annotations.Nullable false TypeOrigin.ONone, [loc]) loc in
@ -233,7 +233,7 @@ let check_constructor_initialization tenv
State.set_node start_node;
if Procname.is_constructor curr_pname
then begin
match PatternMatch.get_this_type (Cfg.Procdesc.get_attributes curr_pdesc) with
match PatternMatch.get_this_type (Procdesc.get_attributes curr_pdesc) with
| Some (Tptr (Tstruct name as ts, _)) -> (
match Tenv.lookup tenv name with
| Some { fields } ->
@ -332,7 +332,7 @@ let spec_make_return_nullable curr_pname =
let check_return_annotation tenv
find_canonical_duplicate curr_pdesc ret_range
ret_ia ret_implicitly_nullable loc : unit =
let curr_pname = Cfg.Procdesc.get_proc_name curr_pdesc in
let curr_pname = Procdesc.get_proc_name curr_pdesc in
let ret_annotated_nullable = Annotations.ia_is_nullable ret_ia in
let ret_annotated_present = Annotations.ia_is_present ret_ia in
let ret_annotated_nonnull = Annotations.ia_is_nonnull ret_ia in
@ -493,8 +493,8 @@ let check_call_parameters tenv
implemented interfaces *)
let check_overridden_annotations
find_canonical_duplicate tenv proc_name proc_desc annotated_signature =
let start_node = Cfg.Procdesc.get_start_node proc_desc in
let loc = Cfg.Node.get_loc start_node in
let start_node = Procdesc.get_start_node proc_desc in
let loc = Procdesc.Node.get_loc start_node in
let check_return overriden_proc_name overriden_signature =
let ret_is_nullable =

28
infer/src/eradicate/typeCheck.ml
Unescape View File

@ -142,9 +142,9 @@ module ComplexExpressions = struct
end (* ComplexExpressions *)
type check_return_type =
Procname.t -> Cfg.Procdesc.t -> Typ.t -> Typ.t option -> Location.t -> unit
Procname.t -> Procdesc.t -> Typ.t -> Typ.t option -> Location.t -> unit
type find_canonical_duplicate = Cfg.Node.t -> Cfg.Node.t
type find_canonical_duplicate = Procdesc.Node.t -> Procdesc.Node.t
type get_proc_desc = TypeState.get_proc_desc
@ -157,7 +157,7 @@ type checks =
(** Typecheck an expression. *)
let rec typecheck_expr
find_canonical_duplicate visited checks tenv node instr_ref (curr_pdesc : Cfg.Procdesc.t)
find_canonical_duplicate visited checks tenv node instr_ref (curr_pdesc : Procdesc.t)
typestate e tr_default loc : TypeState.range = match e with
| Exp.Lvar pvar ->
(match TypeState.lookup_pvar pvar typestate with
@ -236,11 +236,11 @@ let rec typecheck_expr
(** Typecheck an instruction. *)
let typecheck_instr
tenv ext calls_this checks (node: Cfg.Node.t) idenv get_proc_desc curr_pname
tenv ext calls_this checks (node: Procdesc.Node.t) idenv get_proc_desc curr_pname
curr_pdesc find_canonical_duplicate annotated_signature instr_ref linereader typestate instr =
(* let print_current_state () = *)
(* L.stdout "Current Typestate in node %a@\n%a@." *)
(* Cfg.Node.pp (TypeErr.InstrRef.get_node instr_ref) *)
(* Procdesc.Node.pp (TypeErr.InstrRef.get_node instr_ref) *)
(* (TypeState.pp ext) typestate; *)
(* L.stdout " %a@." (Sil.pp_instr pe_text) instr in *)
@ -429,7 +429,7 @@ let typecheck_instr
annotated_signature.Annotations.params in
let is_return pvar =
let ret_pvar = Cfg.Procdesc.get_ret_var curr_pdesc in
let ret_pvar = Procdesc.get_ret_var curr_pdesc in
Pvar.equal pvar ret_pvar in
(* Apply a function to a pvar and its associated content if front-end generated. *)
@ -702,7 +702,7 @@ let typecheck_instr
| _ -> ()
end
| _ -> () in
IList.iter do_instr (Cfg.Node.get_instrs cond_node) in
IList.iter do_instr (Procdesc.Node.get_instrs cond_node) in
let handle_optional_isPresent node' e =
match convert_complex_exp_to_pvar node' false e typestate' loc with
| Exp.Lvar pvar', _ ->
@ -718,7 +718,9 @@ let typecheck_instr
(* In foo(cond1 && cond2), the node that sets the result to false
has all the negated conditions as parents. *)
| Some boolean_assignment_node ->
IList.iter handle_negated_condition (Cfg.Node.get_preds boolean_assignment_node);
IList.iter
handle_negated_condition
(Procdesc.Node.get_preds boolean_assignment_node);
!res_typestate
| None ->
begin
@ -1018,7 +1020,7 @@ let typecheck_instr
(* Handle assigment fron a temp pvar in a condition.
This recognizes the handling of temp variables in ((x = ...) != null) *)
let handle_assignment_in_condition pvar =
match Cfg.Node.get_preds node with
match Procdesc.Node.get_preds node with
| [prev_node] ->
let found = ref None in
let do_instr i = match i with
@ -1026,7 +1028,7 @@ let typecheck_instr
when Exp.equal (Exp.Lvar pvar) (Idenv.expand_expr idenv e') ->
found := Some e
| _ -> () in
IList.iter do_instr (Cfg.Node.get_instrs prev_node);
IList.iter do_instr (Procdesc.Node.get_instrs prev_node);
!found
| _ -> None in
@ -1060,7 +1062,7 @@ let typecheck_node
tenv ext calls_this checks idenv get_proc_desc curr_pname curr_pdesc
find_canonical_duplicate annotated_signature typestate node linereader =
let instrs = Cfg.Node.get_instrs node in
let instrs = Procdesc.Node.get_instrs node in
let instr_ref_gen = TypeErr.InstrRef.create_generator node in
let typestates_exn = ref [] in
@ -1077,7 +1079,7 @@ let typecheck_node
typestates_exn := typestate :: !typestates_exn
| Sil.Store (Exp.Lvar pv, _, _, _) when
Pvar.is_return pv &&
Cfg.Node.get_kind node = Cfg.Node.throw_kind ->
Procdesc.Node.get_kind node = Procdesc.Node.throw_kind ->
(* throw instruction *)
typestates_exn := typestate :: !typestates_exn
| _ -> () in
@ -1099,6 +1101,6 @@ let typecheck_node
TypeErr.node_reset_forall canonical_node;
let typestate_succ = IList.fold_left (do_instruction ext) typestate instrs in
if Cfg.Node.get_kind node = Cfg.Node.exn_sink_kind
if Procdesc.Node.get_kind node = Procdesc.Node.exn_sink_kind
then [], [] (* don't propagate exceptions to exit node *)
else [typestate_succ], !typestates_exn

8
infer/src/eradicate/typeCheck.mli
Unescape View File

@ -13,9 +13,9 @@ open! Utils
(** Module type for the type checking functions. *)
type check_return_type =
Procname.t -> Cfg.Procdesc.t -> Typ.t -> Typ.t option -> Location.t -> unit
Procname.t -> Procdesc.t -> Typ.t -> Typ.t option -> Location.t -> unit
type find_canonical_duplicate = Cfg.Node.t -> Cfg.Node.t
type find_canonical_duplicate = Procdesc.Node.t -> Procdesc.Node.t
type get_proc_desc = TypeState.get_proc_desc
@ -29,6 +29,6 @@ type checks =
val typecheck_node :
Tenv.t -> 'a TypeState.ext ->
bool ref -> checks -> Idenv.t ->
get_proc_desc -> Procname.t -> Cfg.Procdesc.t ->
get_proc_desc -> Procname.t -> Procdesc.t ->
find_canonical_duplicate -> Annotations.annotated_signature -> 'a TypeState.t ->
Cfg.Node.t -> Printer.LineReader.t -> 'a TypeState.t list * 'a TypeState.t list
Procdesc.Node.t -> Printer.LineReader.t -> 'a TypeState.t list * 'a TypeState.t list

20
infer/src/eradicate/typeErr.ml
Unescape View File

@ -20,23 +20,23 @@ module type InstrRefT =
sig
type t
type generator
val create_generator : Cfg.Node.t -> generator
val create_generator : Procdesc.Node.t -> generator
val equal : t -> t -> bool
val gen : generator -> t
val get_node : t -> Cfg.Node.t
val get_node : t -> Procdesc.Node.t
val hash : t -> int
val replace_node : t -> Cfg.Node.t -> t
val replace_node : t -> Procdesc.Node.t -> t
end (* InstrRefT *)
(** Per-node instruction reference. *)
module InstrRef : InstrRefT =
struct
type t = Cfg.Node.t * int
type generator = Cfg.Node.t * int ref
type t = Procdesc.Node.t * int
type generator = Procdesc.Node.t * int ref
let equal (n1, i1) (n2, i2) =
Cfg.Node.equal n1 n2 && i1 = i2
let hash (n, i) = Hashtbl.hash (Cfg.Node.hash n, i)
Procdesc.Node.equal n1 n2 && i1 = i2
let hash (n, i) = Hashtbl.hash (Procdesc.Node.hash n, i)
let get_node (n, _) = n
let replace_node (_, i) n' = (n', i)
let create_generator n = (n, ref 0)
@ -227,7 +227,7 @@ let node_reset_forall node =
match instr_ref_opt, get_forall err_instance with
| Some instr_ref, is_forall ->
let node' = InstrRef.get_node instr_ref in
if is_forall && Cfg.Node.equal node node' then err_state.always <- false
if is_forall && Procdesc.Node.equal node node' then err_state.always <- false
| None, _ -> () in
H.iter iter err_tbl
@ -293,7 +293,7 @@ end (* Strict *)
type st_report_error =
Procname.t ->
Cfg.Procdesc.t ->
Procdesc.t ->
string ->
Location.t ->
?advice: string option ->
@ -307,7 +307,7 @@ type st_report_error =
(** Report an error right now. *)
let report_error_now tenv
(st_report_error : st_report_error) err_instance loc pdesc : unit =
let pname = Cfg.Procdesc.get_proc_name pdesc in
let pname = Procdesc.get_proc_name pdesc in
let demo_mode = true in
let do_print_base ew_string kind_s s =
let mname = match pname with

16
infer/src/eradicate/typeErr.mli
Unescape View File

@ -17,12 +17,12 @@ module type InstrRefT =
sig
type t
type generator
val create_generator : Cfg.Node.t -> generator
val create_generator : Procdesc.Node.t -> generator
val equal : t -> t -> bool
val gen : generator -> t
val get_node : t -> Cfg.Node.t
val get_node : t -> Procdesc.Node.t
val hash : t -> int
val replace_node : t -> Cfg.Node.t -> t
val replace_node : t -> Procdesc.Node.t -> t
end (* InstrRefT *)
module InstrRef : InstrRefT
@ -64,11 +64,11 @@ type err_instance =
| Return_over_annotated of Procname.t
val node_reset_forall : Cfg.Node.t -> unit
val node_reset_forall : Procdesc.Node.t -> unit
type st_report_error =
Procname.t ->
Cfg.Procdesc.t ->
Procdesc.t ->
string ->
Location.t ->
?advice: string option ->
@ -81,10 +81,10 @@ type st_report_error =
val report_error :
Tenv.t -> st_report_error ->
(Cfg.Node.t -> Cfg.Node.t) ->
(Procdesc.Node.t -> Procdesc.Node.t) ->
err_instance -> InstrRef.t option -> Location.t ->
Cfg.Procdesc.t -> unit
Procdesc.t -> unit
val report_forall_checks_and_reset : Tenv.t -> st_report_error -> Cfg.Procdesc.t -> unit
val report_forall_checks_and_reset : Tenv.t -> st_report_error -> Procdesc.t -> unit
val reset : unit -> unit

4
infer/src/eradicate/typeState.ml
Unescape View File

@ -18,7 +18,7 @@ module P = Printf
(** Parameters of a call. *)
type parameters = (Exp.t * Typ.t) list
type get_proc_desc = Procname.t -> Cfg.Procdesc.t option
type get_proc_desc = Procname.t -> Procdesc.t option
(** Extension to a typestate with values of type 'a. *)
type 'a ext =
@ -26,7 +26,7 @@ type 'a ext =
empty : 'a; (** empty extension *)
check_instr :
Tenv.t -> get_proc_desc -> Procname.t ->
Cfg.Procdesc.t -> 'a -> Sil.instr -> parameters ->
Procdesc.t -> 'a -> Sil.instr -> parameters ->
'a; (** check the extension for an instruction *)
join : 'a -> 'a -> 'a; (** join two extensions *)
pp : Format.formatter -> 'a -> unit (** pretty print an extension *)

4
infer/src/eradicate/typeState.mli
Unescape View File

@ -14,7 +14,7 @@ open! Utils
(** Parameters of a call. *)
type parameters = (Exp.t * Typ.t) list
type get_proc_desc = Procname.t -> Cfg.Procdesc.t option
type get_proc_desc = Procname.t -> Procdesc.t option
(** Extension to a typestate with values of type 'a. *)
type 'a ext =
@ -22,7 +22,7 @@ type 'a ext =
empty : 'a; (** empty extension *)
check_instr :
Tenv.t -> get_proc_desc -> Procname.t ->
Cfg.Procdesc.t ->'a -> Sil.instr -> parameters ->
Procdesc.t ->'a -> Sil.instr -> parameters ->
'a; (** check the extension for an instruction *)
join : 'a -> 'a -> 'a; (** join two extensions *)
pp : Format.formatter -> 'a -> unit (** pretty print an extension *)

28
infer/src/harness/inhabit.ml
Unescape View File

@ -41,7 +41,7 @@ let procdesc_from_name cfg pname =
let formals_from_name cfg pname =
match procdesc_from_name cfg pname with
| Some pdesc -> Cfg.Procdesc.get_formals pdesc
| Some pdesc -> Procdesc.get_formals pdesc
| None -> []
(** add an instruction to the env, update tmp_vars, and bump the pc *)
@ -172,7 +172,7 @@ and inhabit_constructor tenv constr_name (allocated_obj, obj_type) cfg env =
let inhabit_call_with_args procname procdesc args env =
let retval =
let ret_typ = Cfg.Procdesc.get_ret_type procdesc in
let ret_typ = Procdesc.get_ret_type procdesc in
let is_void = ret_typ = Typ.Tvoid in
if is_void then None else Some (Ident.create_fresh Ident.knormal, ret_typ) in
let call_instr =
@ -188,7 +188,7 @@ let inhabit_call tenv (procname, receiver) cfg env =
match procdesc_from_name cfg procname with
| Some procdesc ->
(* swap the type of the 'this' formal with the receiver type, if there is one *)
let formals = match (Cfg.Procdesc.get_formals procdesc, receiver) with
let formals = match (Procdesc.get_formals procdesc, receiver) with
| ((name, _) :: formals, Some receiver) -> (name, receiver) :: formals
| (formals, None) -> formals
| ([], Some _) ->
@ -230,7 +230,7 @@ let add_harness_to_cg harness_name harness_node cg =
Cg.add_defined_node cg (Procname.Java harness_name);
IList.iter
(fun p -> Cg.add_edge cg (Procname.Java harness_name) p)
(Cfg.Node.get_callees harness_node)
(Procdesc.Node.get_callees harness_node)
(** create and fill the appropriate nodes and add them to the harness cfg. also add the harness
* proc to the cg *)
@ -248,18 +248,18 @@ let setup_harness_cfg harness_name env cg cfg =
let harness_node =
(* important to reverse the list or there will be scoping issues! *)
let instrs = (IList.rev env.instrs) in
let nodekind = Cfg.Node.Stmt_node "method_body" in
Cfg.Procdesc.create_node procdesc env.pc nodekind instrs in
let nodekind = Procdesc.Node.Stmt_node "method_body" in
Procdesc.create_node procdesc env.pc nodekind instrs in
let (start_node, exit_node) =
let create_node kind = Cfg.Procdesc.create_node procdesc env.pc kind [] in
let start_kind = Cfg.Node.Start_node procname in
let exit_kind = Cfg.Node.Exit_node procname in
let create_node kind = Procdesc.create_node procdesc env.pc kind [] in
let start_kind = Procdesc.Node.Start_node procname in
let exit_kind = Procdesc.Node.Exit_node procname in
(create_node start_kind, create_node exit_kind) in
Cfg.Procdesc.set_start_node procdesc start_node;
Cfg.Procdesc.set_exit_node procdesc exit_node;
Cfg.Node.add_locals_ret_declaration start_node proc_attributes [];
Cfg.Procdesc.node_set_succs_exn procdesc start_node [harness_node] [exit_node];
Cfg.Procdesc.node_set_succs_exn procdesc harness_node [exit_node] [exit_node];
Procdesc.set_start_node procdesc start_node;
Procdesc.set_exit_node procdesc exit_node;
Procdesc.Node.add_locals_ret_declaration start_node proc_attributes [];
Procdesc.node_set_succs_exn procdesc start_node [harness_node] [exit_node];
Procdesc.node_set_succs_exn procdesc harness_node [exit_node] [exit_node];
add_harness_to_cg harness_name harness_node cg
(** create a procedure named harness_name that calls each of the methods in trace in the specified

10
infer/src/java/jContext.ml
Unescape View File

@ -13,7 +13,7 @@ open! Utils
open Javalib_pack
open Sawja_pack
module NodeTbl = Cfg.NodeHash
module NodeTbl = Procdesc.NodeHash
type jump_kind =
| Next
@ -29,7 +29,7 @@ type icfg = {
type t =
{ icfg : icfg;
procdesc : Cfg.Procdesc.t;
procdesc : Procdesc.t;
impl : JBir.t;
mutable var_map : (Pvar.t * Typ.t * Typ.t) JBir.VarMap.t;
if_jumps : int NodeTbl.t;
@ -67,7 +67,7 @@ let get_or_set_pvar_type context var typ =
else set_var_map context (JBir.VarMap.add var (pvar, typ, typ) var_map);
(pvar, typ)
with Not_found ->
let procname = (Cfg.Procdesc.get_proc_name context.procdesc) in
let procname = (Procdesc.get_proc_name context.procdesc) in
let varname = Mangled.from_string (JBir.var_name_g var) in
let pvar = Pvar.mk varname procname in
set_var_map context (JBir.VarMap.add var (pvar, typ, typ) var_map);
@ -119,10 +119,10 @@ let exn_node_table = Procname.Hash.create 100
let reset_exn_node_table () =
Procname.Hash.clear exn_node_table
let add_exn_node procname (exn_node : Cfg.Node.t) =
let add_exn_node procname (exn_node : Procdesc.Node.t) =
Procname.Hash.add exn_node_table procname exn_node
let get_exn_node procdesc =
try
Some (Procname.Hash.find exn_node_table (Cfg.Procdesc.get_proc_name procdesc))
Some (Procname.Hash.find exn_node_table (Procdesc.get_proc_name procdesc))
with Not_found -> None

14
infer/src/java/jContext.mli
Unescape View File

@ -22,7 +22,7 @@ type jump_kind =
(** Hastable for storing nodes that correspond to if-instructions. These are
used when adding the edges in the contrl flow graph. *)
module NodeTbl : Hashtbl.S with type key = Cfg.Node.t
module NodeTbl : Hashtbl.S with type key = Procdesc.Node.t
(** data structure for saving the three structures tht contain the intermediate
@ -37,7 +37,7 @@ type icfg = {
(** data structure for storing the context elements. *)
type t = private
{ icfg : icfg;
procdesc : Cfg.Procdesc.t;
procdesc : Procdesc.t;
impl : JBir.t;
mutable var_map : (Pvar.t * Typ.t * Typ.t) JBir.VarMap.t;
if_jumps : int NodeTbl.t;
@ -51,7 +51,7 @@ type t = private
(** cretes a context for a given method. *)
val create_context :
icfg ->
Cfg.Procdesc.t ->
Procdesc.t ->
JBir.t ->
JBasics.class_name ->
DB.source_file ->
@ -68,10 +68,10 @@ val get_cg : t -> Cg.t
val get_cfg : t -> Cfg.cfg
(** adds to the context the line that an if-node will jump to *)
val add_if_jump : t -> Cfg.Node.t -> int -> unit
val add_if_jump : t -> Procdesc.Node.t -> int -> unit
(** returns whether the given node corresponds to an if-instruction *)
val get_if_jump : t -> Cfg.Node.t -> int option
val get_if_jump : t -> Procdesc.Node.t -> int option
(** adds to the context the line that the node in the given line will jump to. *)
val add_goto_jump : t -> int -> jump_kind -> unit
@ -96,7 +96,7 @@ val reset_pvar_type : t -> unit
val reset_exn_node_table : unit -> unit
(** adds the exception node for a given method *)
val add_exn_node : Procname.t -> Cfg.Node.t -> unit
val add_exn_node : Procname.t -> Procdesc.Node.t -> unit
(** returns the exception node of a given method *)
val get_exn_node : Cfg.Procdesc.t -> Cfg.Node.t option
val get_exn_node : Procdesc.t -> Procdesc.Node.t option

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

@ -48,7 +48,7 @@ let add_edges
if super_call then (fun _ -> exit_nodes)
else JTransExn.create_exception_handlers context [exn_node] get_body_nodes impl in
let connect node pc =
Cfg.Procdesc.node_set_succs_exn
Procdesc.node_set_succs_exn
context.procdesc node (get_succ_nodes node pc) (get_exn_nodes pc) in
let connect_nodes pc translated_instruction =
match translated_instruction with
@ -58,7 +58,7 @@ let add_edges
connect node_true pc;
connect node_false pc
| JTrans.Loop (join_node, node_true, node_false) ->
Cfg.Procdesc.node_set_succs_exn context.procdesc join_node [node_true; node_false] [];
Procdesc.node_set_succs_exn context.procdesc join_node [node_true; node_false] [];
connect node_true pc;
connect node_false pc in
let first_nodes =
@ -66,11 +66,11 @@ let add_edges
direct_successors (-1) in
(* the exceptions edges here are going directly to the exit node *)
Cfg.Procdesc.node_set_succs_exn context.procdesc start_node first_nodes exit_nodes;
Procdesc.node_set_succs_exn context.procdesc start_node first_nodes exit_nodes;
if not super_call then
(* the exceptions node is just before the exit node *)
Cfg.Procdesc.node_set_succs_exn context.procdesc exn_node exit_nodes exit_nodes;
Procdesc.node_set_succs_exn context.procdesc exn_node exit_nodes exit_nodes;
Array.iteri connect_nodes method_body_nodes
@ -80,8 +80,8 @@ let add_cmethod source_file program linereader icfg cm proc_name =
match JTrans.create_cm_procdesc source_file program linereader icfg cm proc_name with
| None -> ()
| Some (procdesc, impl) ->
let start_node = Cfg.Procdesc.get_start_node procdesc in
let exit_node = Cfg.Procdesc.get_exit_node procdesc in
let start_node = Procdesc.get_start_node procdesc in
let exit_node = Procdesc.get_exit_node procdesc in
let exn_node =
match JContext.get_exn_node procdesc with
| Some node -> node

100
infer/src/java/jTrans.ml
Unescape View File

@ -235,7 +235,7 @@ let trans_access = function
| `Private -> PredSymb.Private
| `Protected -> PredSymb.Protected
let create_am_procdesc program icfg am proc_name : Cfg.Procdesc.t =
let create_am_procdesc program icfg am proc_name : Procdesc.t =
let cfg = icfg.JContext.cfg in
let tenv = icfg.JContext.tenv in
let m = Javalib.AbstractMethod am in
@ -258,13 +258,13 @@ let create_am_procdesc program icfg am proc_name : Cfg.Procdesc.t =
ret_type = JTransType.return_type program tenv ms;
} in
Cfg.create_proc_desc cfg proc_attributes in
let start_kind = Cfg.Node.Start_node proc_name in
let start_node = Cfg.Procdesc.create_node procdesc Location.dummy start_kind [] in
let exit_kind = (Cfg.Node.Exit_node proc_name) in
let exit_node = Cfg.Procdesc.create_node procdesc Location.dummy exit_kind [] in
Cfg.Procdesc.node_set_succs_exn procdesc start_node [exit_node] [exit_node];
Cfg.Procdesc.set_start_node procdesc start_node;
Cfg.Procdesc.set_exit_node procdesc exit_node;
let start_kind = Procdesc.Node.Start_node proc_name in
let start_node = Procdesc.create_node procdesc Location.dummy start_kind [] in
let exit_kind = (Procdesc.Node.Exit_node proc_name) in
let exit_node = Procdesc.create_node procdesc Location.dummy exit_kind [] in
Procdesc.node_set_succs_exn procdesc start_node [exit_node] [exit_node];
Procdesc.set_start_node procdesc start_node;
Procdesc.set_exit_node procdesc exit_node;
procdesc
let create_native_procdesc program icfg cm proc_name =
@ -323,16 +323,16 @@ let create_cm_procdesc source_file program linereader icfg cm proc_name =
} in
let procdesc =
Cfg.create_proc_desc cfg proc_attributes in
let start_kind = Cfg.Node.Start_node proc_name in
let start_node = Cfg.Procdesc.create_node procdesc loc_start start_kind [] in
let exit_kind = (Cfg.Node.Exit_node proc_name) in
let exit_node = Cfg.Procdesc.create_node procdesc loc_exit exit_kind [] in
let exn_kind = Cfg.Node.exn_sink_kind in
let exn_node = Cfg.Procdesc.create_node procdesc loc_exit exn_kind [] in
let start_kind = Procdesc.Node.Start_node proc_name in
let start_node = Procdesc.create_node procdesc loc_start start_kind [] in
let exit_kind = (Procdesc.Node.Exit_node proc_name) in
let exit_node = Procdesc.create_node procdesc loc_exit exit_kind [] in
let exn_kind = Procdesc.Node.exn_sink_kind in
let exn_node = Procdesc.create_node procdesc loc_exit exn_kind [] in
JContext.add_exn_node proc_name exn_node;
Cfg.Procdesc.set_start_node procdesc start_node;
Cfg.Procdesc.set_exit_node procdesc exit_node;
Cfg.Node.add_locals_ret_declaration start_node proc_attributes locals;
Procdesc.set_start_node procdesc start_node;
Procdesc.set_exit_node procdesc exit_node;
Procdesc.Node.add_locals_ret_declaration start_node proc_attributes locals;
procdesc in
Some (procdesc, impl)
with JBir.Subroutine ->
@ -371,7 +371,7 @@ let rec expression (context : JContext.t) pc expr =
match c with (* We use the constant <field> internally to mean a variable. *)
| `String s when (JBasics.jstr_pp s) = JConfig.field_cst ->
let varname = JConfig.field_st in
let procname = (Cfg.Procdesc.get_proc_name context.procdesc) in
let procname = (Procdesc.get_proc_name context.procdesc) in
let pvar = Pvar.mk varname procname in
trans_var pvar
| _ -> ([], Exp.Const (get_constant c), type_of_expr)
@ -616,9 +616,9 @@ let detect_loop entry_pc impl =
type translation =
| Skip
| Instr of Cfg.Node.t
| Prune of Cfg.Node.t * Cfg.Node.t
| Loop of Cfg.Node.t * Cfg.Node.t * Cfg.Node.t
| Instr of Procdesc.Node.t
| Prune of Procdesc.Node.t * Procdesc.Node.t
| Loop of Procdesc.Node.t * Procdesc.Node.t * Procdesc.Node.t
(* TODO: unclear if this corresponds to what JControlFlow.resolve_method'*)
(* is trying to do. Normally, this implementation below goes deeper into *)
@ -705,14 +705,14 @@ let rec instruction (context : JContext.t) pc instr : translation =
let tenv = JContext.get_tenv context in
let cg = JContext.get_cg context in
let program = context.program in
let proc_name = Cfg.Procdesc.get_proc_name context.procdesc in
let proc_name = Procdesc.get_proc_name context.procdesc in
let ret_var = Pvar.get_ret_pvar proc_name in
let ret_type = Cfg.Procdesc.get_ret_type context.procdesc in
let ret_type = Procdesc.get_ret_type context.procdesc in
let loc = get_location context.source_file context.impl pc in
let file = loc.Location.file in
let match_never_null = Inferconfig.never_return_null_matcher in
let create_node node_kind sil_instrs =
Cfg.Procdesc.create_node context.procdesc loc node_kind sil_instrs in
Procdesc.create_node context.procdesc loc node_kind sil_instrs in
let return_not_null () =
match_never_null loc.Location.file proc_name in
let trans_monitor_enter_exit context expr pc loc builtin node_desc =
@ -723,7 +723,7 @@ let rec instruction (context : JContext.t) pc instr : translation =
| Typ.Tptr (typ, _) -> typ
| _ -> sil_type in
let deref_instr = create_sil_deref sil_expr typ_no_ptr loc in
let node_kind = Cfg.Node.Stmt_node node_desc in
let node_kind = Procdesc.Node.Stmt_node node_desc in
Instr (create_node node_kind (instrs @ [deref_instr; instr] )) in
try
match instr with
@ -731,11 +731,11 @@ let rec instruction (context : JContext.t) pc instr : translation =
let (stml, sil_expr, sil_type) = expression context pc expr in
let pvar = (JContext.set_pvar context var sil_type) in
let sil_instr = Sil.Store (Exp.Lvar pvar, sil_type, sil_expr, loc) in
let node_kind = Cfg.Node.Stmt_node "method_body" in
let node_kind = Procdesc.Node.Stmt_node "method_body" in
let node = create_node node_kind (stml @ [sil_instr]) in
Instr node
| JBir.Return expr_option ->
let node_kind = Cfg.Node.Stmt_node "method_body" in
let node_kind = Procdesc.Node.Stmt_node "method_body" in
let node =
match expr_option with
| None ->
@ -759,7 +759,7 @@ let rec instruction (context : JContext.t) pc instr : translation =
Sil.Store (
Exp.Lindex (sil_expr_array, sil_expr_index), value_typ, sil_expr_value, loc) in
let final_instrs = instrs_array @ instrs_index @ instrs_value @ [sil_instr] in
let node_kind = Cfg.Node.Stmt_node "method_body" in
let node_kind = Procdesc.Node.Stmt_node "method_body" in
let node = create_node node_kind final_instrs in
Instr node
| JBir.AffectField (e_lhs, cn, fs, e_rhs) ->
@ -770,7 +770,7 @@ let rec instruction (context : JContext.t) pc instr : translation =
let type_of_the_root_of_e_lhs = type_of_the_surrounding_class in
let expr_off = Exp.Lfield(sil_expr_lhs, field_name, type_of_the_surrounding_class) in
let sil_instr = Sil.Store (expr_off, type_of_the_root_of_e_lhs, sil_expr_rhs, loc) in
let node_kind = Cfg.Node.Stmt_node "method_body" in
let node_kind = Procdesc.Node.Stmt_node "method_body" in
let node = create_node node_kind (stml1 @ stml2 @ [sil_instr]) in
Instr node
| JBir.AffectStaticField (cn, fs, e_rhs) ->
@ -785,7 +785,7 @@ let rec instruction (context : JContext.t) pc instr : translation =
let type_of_the_root_of_e_lhs = type_of_the_surrounding_class in
let expr_off = Exp.Lfield(sil_expr_lhs, field_name, type_of_the_surrounding_class) in
let sil_instr = Sil.Store (expr_off, type_of_the_root_of_e_lhs, sil_expr_rhs, loc) in
let node_kind = Cfg.Node.Stmt_node "method_body" in
let node_kind = Procdesc.Node.Stmt_node "method_body" in
let node = create_node node_kind (stml1 @ stml2 @ [sil_instr]) in
Instr node
| JBir.Goto goto_pc ->
@ -801,14 +801,14 @@ let rec instruction (context : JContext.t) pc instr : translation =
let sil_test_true = Exp.UnOp(Unop.LNot, sil_test_false, None) in
let sil_instrs_true = Sil.Prune (sil_test_true, loc, true, Sil.Ik_if) in
let sil_instrs_false = Sil.Prune (sil_test_false, loc, false, Sil.Ik_if) in
let node_kind_true = Cfg.Node.Prune_node (true, Sil.Ik_if, "method_body") in
let node_kind_false = Cfg.Node.Prune_node (false, Sil.Ik_if, "method_body") in
let node_kind_true = Procdesc.Node.Prune_node (true, Sil.Ik_if, "method_body") in
let node_kind_false = Procdesc.Node.Prune_node (false, Sil.Ik_if, "method_body") in
let prune_node_true = create_node node_kind_true (instrs1 @ instrs2 @ [sil_instrs_true])
and prune_node_false =
create_node node_kind_false (instrs1 @ instrs2 @ [sil_instrs_false]) in
JContext.add_if_jump context prune_node_false if_pc;
if detect_loop pc context.impl then
let join_node_kind = Cfg.Node.Join_node in
let join_node_kind = Procdesc.Node.Join_node in
let join_node = create_node join_node_kind [] in
Loop (join_node, prune_node_true, prune_node_false)
else
@ -817,7 +817,7 @@ let rec instruction (context : JContext.t) pc instr : translation =
let (instrs, sil_expr, _) = expression context pc expr in
let sil_exn = Exp.Exn sil_expr in
let sil_instr = Sil.Store (Exp.Lvar ret_var, ret_type, sil_exn, loc) in
let node = create_node Cfg.Node.throw_kind (instrs @ [sil_instr]) in
let node = create_node Procdesc.Node.throw_kind (instrs @ [sil_instr]) in
JContext.add_goto_jump context pc JContext.Exit;
Instr node
| JBir.New (var, cn, constr_type_list, constr_arg_list) ->
@ -837,9 +837,9 @@ let rec instruction (context : JContext.t) pc instr : translation =
let pvar = JContext.set_pvar context var class_type in
let set_instr = Sil.Store (Exp.Lvar pvar, class_type, Exp.Var ret_id, loc) in
let instrs = (new_instr :: call_instrs) @ [set_instr] in
let node_kind = Cfg.Node.Stmt_node ("Call "^(Procname.to_string constr_procname)) in
let node_kind = Procdesc.Node.Stmt_node ("Call "^(Procname.to_string constr_procname)) in
let node = create_node node_kind instrs in
let caller_procname = (Cfg.Procdesc.get_proc_name context.procdesc) in
let caller_procname = (Procdesc.get_proc_name context.procdesc) in
Cg.add_edge cg caller_procname constr_procname;
Instr node
| JBir.NewArray (var, vt, expr_list) ->
@ -854,7 +854,7 @@ let rec instruction (context : JContext.t) pc instr : translation =
Sil.Call
(Some (ret_id, array_type), builtin_new_array, call_args, loc, CallFlags.default) in
let set_instr = Sil.Store (Exp.Lvar array_name, array_type, Exp.Var ret_id, loc) in
let node_kind = Cfg.Node.Stmt_node "method_body" in
let node_kind = Procdesc.Node.Stmt_node "method_body" in
let node = create_node node_kind (instrs @ [call_instr; set_instr]) in
Instr node
| JBir.InvokeStatic (var_opt, cn, ms, args) ->
@ -868,20 +868,20 @@ let rec instruction (context : JContext.t) pc instr : translation =
| _ -> None, args, [] in
let callee_procname, call_instrs =
method_invocation context loc pc var_opt cn ms sil_obj_opt args I_Static Procname.Static in
let node_kind = Cfg.Node.Stmt_node ("Call "^(Procname.to_string callee_procname)) in
let node_kind = Procdesc.Node.Stmt_node ("Call "^(Procname.to_string callee_procname)) in
let call_node = create_node node_kind (instrs @ call_instrs) in
let caller_procname = (Cfg.Procdesc.get_proc_name context.procdesc) in
let caller_procname = (Procdesc.get_proc_name context.procdesc) in
Cg.add_edge cg caller_procname callee_procname;
Instr call_node
| JBir.InvokeVirtual (var_opt, obj, call_kind, ms, args) ->
let caller_procname = (Cfg.Procdesc.get_proc_name context.procdesc) in
let caller_procname = (Procdesc.get_proc_name context.procdesc) in
let (instrs, sil_obj_expr, sil_obj_type) = expression context pc obj in
let create_call_node cn invoke_kind =
let callee_procname, call_instrs =
let ret_opt = Some (sil_obj_expr, sil_obj_type) in
method_invocation
context loc pc var_opt cn ms ret_opt args invoke_kind Procname.Non_Static in
let node_kind = Cfg.Node.Stmt_node ("Call "^(Procname.to_string callee_procname)) in
let node_kind = Procdesc.Node.Stmt_node ("Call "^(Procname.to_string callee_procname)) in
let call_node = create_node node_kind (instrs @ call_instrs) in
Cg.add_edge cg caller_procname callee_procname;
call_node in
@ -911,10 +911,10 @@ let rec instruction (context : JContext.t) pc instr : translation =
let (instrs, sil_obj_expr, sil_obj_type) = expression context pc obj in
let callee_procname, call_instrs =
method_invocation context loc pc var_opt cn ms (Some (sil_obj_expr, sil_obj_type)) args I_Special Procname.Non_Static in
let node_kind = Cfg.Node.Stmt_node ("Call "^(Procname.to_string callee_procname)) in
let node_kind = Procdesc.Node.Stmt_node ("Call "^(Procname.to_string callee_procname)) in
let call_node = create_node node_kind (instrs @ call_instrs) in
let procdesc = context.procdesc in
let caller_procname = (Cfg.Procdesc.get_proc_name procdesc) in
let caller_procname = (Procdesc.get_proc_name procdesc) in
Cg.add_edge cg caller_procname callee_procname;
Instr call_node
@ -924,7 +924,7 @@ let rec instruction (context : JContext.t) pc instr : translation =
let (instrs, sil_expr, _) = expression context pc expr in
let this_not_null_node =
create_node
(Cfg.Node.Stmt_node "this not null") (instrs @ [assume_not_null loc sil_expr]) in
(Procdesc.Node.Stmt_node "this not null") (instrs @ [assume_not_null loc sil_expr]) in
Instr this_not_null_node
| JBir.Check (JBir.CheckNullPointer expr) when Config.report_runtime_exceptions ->
@ -932,12 +932,12 @@ let rec instruction (context : JContext.t) pc instr : translation =
let not_null_node =
let sil_not_null = Exp.BinOp (Binop.Ne, sil_expr, Exp.null) in
let sil_prune_not_null = Sil.Prune (sil_not_null, loc, true, Sil.Ik_if)
and not_null_kind = Cfg.Node.Prune_node (true, Sil.Ik_if, "Not null") in
and not_null_kind = Procdesc.Node.Prune_node (true, Sil.Ik_if, "Not null") in
create_node not_null_kind (instrs @ [sil_prune_not_null]) in
let throw_npe_node =
let sil_is_null = Exp.BinOp (Binop.Eq, sil_expr, Exp.null) in
let sil_prune_null = Sil.Prune (sil_is_null, loc, true, Sil.Ik_if)
and npe_kind = Cfg.Node.Stmt_node "Throw NPE"
and npe_kind = Procdesc.Node.Stmt_node "Throw NPE"
and npe_cn = JBasics.make_cn JConfig.npe_cl in
let class_type = JTransType.get_class_type program tenv npe_cn
and class_type_np = JTransType.get_class_type_no_pointer program tenv npe_cn in
@ -970,7 +970,7 @@ let rec instruction (context : JContext.t) pc instr : translation =
let in_bound_node =
let in_bound_node_kind =
Cfg.Node.Prune_node (true, Sil.Ik_if, "In bound") in
Procdesc.Node.Prune_node (true, Sil.Ik_if, "In bound") in
let sil_assume_in_bound =
let sil_in_bound =
let sil_positive_index =
@ -983,7 +983,7 @@ let rec instruction (context : JContext.t) pc instr : translation =
and throw_out_of_bound_node =
let out_of_bound_node_kind =
Cfg.Node.Stmt_node "Out of bound" in
Procdesc.Node.Stmt_node "Out of bound" in
let sil_assume_out_of_bound =
let sil_out_of_bound =
let sil_negative_index =
@ -1026,12 +1026,12 @@ let rec instruction (context : JContext.t) pc instr : translation =
let is_instance_node =
let check_is_false = Exp.BinOp (Binop.Ne, res_ex, Exp.zero) in
let asssume_instance_of = Sil.Prune (check_is_false, loc, true, Sil.Ik_if)
and instance_of_kind = Cfg.Node.Prune_node (true, Sil.Ik_if, "Is instance") in
and instance_of_kind = Procdesc.Node.Prune_node (true, Sil.Ik_if, "Is instance") in
create_node instance_of_kind (instrs @ [call; asssume_instance_of])
and throw_cast_exception_node =
let check_is_true = Exp.BinOp (Binop.Ne, res_ex, Exp.one) in
let asssume_not_instance_of = Sil.Prune (check_is_true, loc, true, Sil.Ik_if)
and throw_cast_exception_kind = Cfg.Node.Stmt_node "Class cast exception"
and throw_cast_exception_kind = Procdesc.Node.Stmt_node "Class cast exception"
and cce_cn = JBasics.make_cn JConfig.cce_cl in
let class_type = JTransType.get_class_type program tenv cce_cn
and class_type_np = JTransType.get_class_type_no_pointer program tenv cce_cn in

12
infer/src/java/jTrans.mli
Unescape View File

@ -16,15 +16,15 @@ open Sawja_pack
(** Data structure for storing the results of the translation of an instruction. *)
type translation =
| Skip
| Instr of Cfg.Node.t
| Prune of Cfg.Node.t * Cfg.Node.t
| Loop of Cfg.Node.t * Cfg.Node.t * Cfg.Node.t
| Instr of Procdesc.Node.t
| Prune of Procdesc.Node.t * Procdesc.Node.t
| Loop of Procdesc.Node.t * Procdesc.Node.t * Procdesc.Node.t
val is_java_native : JCode.jcode Javalib.concrete_method -> bool
(** Create the procedure description for an abstract method *)
val create_am_procdesc :
JClasspath.program -> JContext.icfg -> Javalib.abstract_method -> Procname.t -> Cfg.Procdesc.t
JClasspath.program -> JContext.icfg -> Javalib.abstract_method -> Procname.t -> Procdesc.t
(** Create the procedure description for a concrete method *)
val create_native_procdesc :
@ -32,7 +32,7 @@ val create_native_procdesc :
JContext.icfg ->
JCode.jcode Javalib.concrete_method ->
Procname.t ->
Cfg.Procdesc.t
Procdesc.t
(** [create_procdesc source_file program linereader icfg cm proc_name] creates
a procedure description for the concrete method cm and adds it to cfg *)
@ -43,7 +43,7 @@ val create_cm_procdesc :
JContext.icfg ->
JCode.jcode Javalib.concrete_method ->
Procname.t ->
(Cfg.Procdesc.t * JBir.t) option
(Procdesc.t * JBir.t) option
(** translates an instruction into a statement node or prune nodes in the cfg *)
val instruction : JContext.t -> int -> JBir.instr -> translation

22
infer/src/java/jTransExn.ml
Unescape View File

@ -30,9 +30,9 @@ let translate_exceptions (context : JContext.t) exit_nodes get_body_nodes handle
let catch_block_table = Hashtbl.create 1 in
let exn_message = "exception handler" in
let procdesc = context.procdesc in
let create_node loc node_kind instrs = Cfg.Procdesc.create_node procdesc loc node_kind instrs in
let ret_var = Cfg.Procdesc.get_ret_var procdesc in
let ret_type = Cfg.Procdesc.get_ret_type procdesc in
let create_node loc node_kind instrs = Procdesc.create_node procdesc loc node_kind instrs in
let ret_var = Procdesc.get_ret_var procdesc in
let ret_type = Procdesc.get_ret_type procdesc in
let id_ret_val = Ident.create_fresh Ident.knormal in
(* this is removed in the true branches, and in the false branch of the last handler *)
let id_exn_val = Ident.create_fresh Ident.knormal in
@ -46,7 +46,7 @@ let translate_exceptions (context : JContext.t) exit_nodes get_body_nodes handle
CallFlags.default) in
create_node
loc
Cfg.Node.exn_handler_kind
Procdesc.Node.exn_handler_kind
[instr_get_ret_val; instr_deactivate_exn; instr_unwrap_ret_val] in
let create_entry_block handler_list =
try
@ -55,7 +55,7 @@ let translate_exceptions (context : JContext.t) exit_nodes get_body_nodes handle
let collect succ_nodes rethrow_exception handler =
let catch_nodes = get_body_nodes handler.JBir.e_handler in
let loc = match catch_nodes with
| n:: _ -> Cfg.Node.get_loc n
| n:: _ -> Procdesc.Node.get_loc n
| [] -> Location.dummy in
let exn_type =
let class_name =
@ -83,16 +83,16 @@ let translate_exceptions (context : JContext.t) exit_nodes get_body_nodes handle
Sil.Store (Exp.Lvar catch_var, ret_type, Exp.Var id_exn_val, loc) in
let instr_rethrow_exn =
Sil.Store (Exp.Lvar ret_var, ret_type, Exp.Exn (Exp.Var id_exn_val), loc) in
let node_kind_true = Cfg.Node.Prune_node (true, if_kind, exn_message) in
let node_kind_false = Cfg.Node.Prune_node (false, if_kind, exn_message) in
let node_kind_true = Procdesc.Node.Prune_node (true, if_kind, exn_message) in
let node_kind_false = Procdesc.Node.Prune_node (false, if_kind, exn_message) in
let node_true =
let instrs_true = [instr_call_instanceof; instr_prune_true; instr_set_catch_var] in
create_node loc node_kind_true instrs_true in
let node_false =
let instrs_false = [instr_call_instanceof; instr_prune_false] @ (if rethrow_exception then [instr_rethrow_exn] else []) in
create_node loc node_kind_false instrs_false in
Cfg.Procdesc.node_set_succs_exn procdesc node_true catch_nodes exit_nodes;
Cfg.Procdesc.node_set_succs_exn procdesc node_false succ_nodes exit_nodes;
Procdesc.node_set_succs_exn procdesc node_true catch_nodes exit_nodes;
Procdesc.node_set_succs_exn procdesc node_false succ_nodes exit_nodes;
let is_finally = handler.JBir.e_catch_type = None in
if is_finally
then [node_true] (* TODO (#4759480): clean up the translation so prune nodes are not created at all *)
@ -106,10 +106,10 @@ let translate_exceptions (context : JContext.t) exit_nodes get_body_nodes handle
let nodes_first_handler =
IList.fold_left process_handler exit_nodes (IList.rev handler_list) in
let loc = match nodes_first_handler with
| n:: _ -> Cfg.Node.get_loc n
| n:: _ -> Procdesc.Node.get_loc n
| [] -> Location.dummy in
let entry_node = create_entry_node loc in
Cfg.Procdesc.node_set_succs_exn procdesc entry_node nodes_first_handler exit_nodes;
Procdesc.node_set_succs_exn procdesc entry_node nodes_first_handler exit_nodes;
Hashtbl.add catch_block_table handler_list [entry_node] in
Hashtbl.iter (fun _ handler_list -> create_entry_block handler_list) handler_table;
catch_block_table

4
infer/src/java/jTransExn.mli
Unescape View File

@ -13,4 +13,6 @@ open! Utils
open Sawja_pack
val create_exception_handlers : JContext.t -> Cfg.Node.t list -> (int -> Cfg.Node.t list) -> JBir.t -> int -> Cfg.Node.t list
val create_exception_handlers :
JContext.t -> Procdesc.Node.t list -> (int -> Procdesc.Node.t list) ->
JBir.t -> int -> Procdesc.Node.t list

18
infer/src/quandary/TaintAnalysis.ml
Unescape View File

@ -99,7 +99,7 @@ module Make (TaintSpec : TaintSpec.S) = struct
| Some _ as node_opt ->
node_opt
| None when is_rooted_in_environment access_path proc_data.extras ->
let call_site = CallSite.make (Cfg.Procdesc.get_proc_name proc_data.ProcData.pdesc) loc in
let call_site = CallSite.make (Procdesc.get_proc_name proc_data.ProcData.pdesc) loc in
let trace =
TraceDomain.of_source (TraceDomain.Source.make_footprint access_path call_site) in
Some (TaintDomain.make_normal_leaf trace)
@ -173,7 +173,7 @@ module Make (TaintSpec : TaintSpec.S) = struct
trace
| paths ->
let report_error path =
let caller_pname = Cfg.Procdesc.get_proc_name proc_data.pdesc in
let caller_pname = Procdesc.get_proc_name proc_data.pdesc in
let msg = Localise.to_string Localise.quandary_taint_error in
let trace_str = F.asprintf "%a" pp_path_short path in
let exn = Exceptions.Checkers (msg, Localise.verbatim_desc trace_str) in
@ -326,7 +326,7 @@ module Make (TaintSpec : TaintSpec.S) = struct
failwithf
"Assignment to unexpected lhs expression %a in proc %a at loc %a"
Exp.pp lhs_exp
Procname.pp (Cfg.Procdesc.get_proc_name (proc_data.pdesc))
Procname.pp (Procdesc.get_proc_name (proc_data.pdesc))
Location.pp loc in
let astate' =
analyze_assignment
@ -357,7 +357,7 @@ module Make (TaintSpec : TaintSpec.S) = struct
failwithf
"Unexpected cast %a in procedure %a at line %a"
(Sil.pp_instr pe_text) instr
Procname.pp (Cfg.Procdesc.get_proc_name (proc_data.pdesc))
Procname.pp (Procdesc.get_proc_name (proc_data.pdesc))
Location.pp loc
else
astate
@ -516,8 +516,8 @@ module Make (TaintSpec : TaintSpec.S) = struct
let checker { Callbacks.get_proc_desc; proc_name; proc_desc; tenv; } =
let analyze_ondemand _ pdesc =
let make_formal_access_paths pdesc =
let pname = Cfg.Procdesc.get_proc_name pdesc in
let attrs = Cfg.Procdesc.get_attributes pdesc in
let pname = Procdesc.get_proc_name pdesc in
let attrs = Procdesc.get_attributes pdesc in
let formals_with_nums =
IList.mapi
(fun index (name, typ) ->
@ -530,7 +530,7 @@ module Make (TaintSpec : TaintSpec.S) = struct
formals_with_nums in
let has_body pdesc =
let attrs = Cfg.Procdesc.get_attributes pdesc in
let attrs = Procdesc.get_attributes pdesc in
attrs.is_defined && not attrs.is_abstract in
if has_body pdesc
then
@ -541,9 +541,9 @@ module Make (TaintSpec : TaintSpec.S) = struct
match Analyzer.compute_post proc_data with
| Some { access_tree; } ->
let summary = make_summary formals access_tree in
Summary.write_summary (Cfg.Procdesc.get_proc_name pdesc) summary;
Summary.write_summary (Procdesc.get_proc_name pdesc) summary;
| None ->
if Cfg.Node.get_succs (Cfg.Procdesc.get_start_node pdesc) = []
if Procdesc.Node.get_succs (Procdesc.get_start_node pdesc) = []
then ()
else failwith "Couldn't compute post"
end in

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

@ -156,7 +156,7 @@ module StructuredSil = struct
end
module Make
(CFG : ProcCfg.S with type node = Cfg.Node.t)
(CFG : ProcCfg.S with type node = Procdesc.Node.t)
(S : Scheduler.Make)
(T : TransferFunctions.Make) = struct
@ -171,16 +171,16 @@ module Make
let cfg = Cfg.create_cfg () in
let pdesc =
Cfg.create_proc_desc cfg (ProcAttributes.default test_pname !Config.curr_language) in
let pname = Cfg.Procdesc.get_proc_name pdesc in
let pname = Procdesc.get_proc_name pdesc in
let create_node kind cmds =
Cfg.Procdesc.create_node pdesc dummy_loc kind cmds in
Procdesc.create_node pdesc dummy_loc kind cmds in
let set_succs cur_node succs ~exn_handlers=
Cfg.Procdesc.node_set_succs_exn pdesc cur_node succs exn_handlers in
Procdesc.node_set_succs_exn pdesc cur_node succs exn_handlers in
let mk_prune_nodes_for_cond cond_exp if_kind =
let mk_prune_node cond_exp if_kind true_branch =
let prune_instr = Sil.Prune (cond_exp, dummy_loc, true_branch, if_kind) in
create_node (Cfg.Node.Prune_node (true_branch, if_kind, "")) [prune_instr] in
create_node (Procdesc.Node.Prune_node (true_branch, if_kind, "")) [prune_instr] in
let true_prune_node = mk_prune_node cond_exp if_kind true in
let false_prune_node =
let negated_cond_exp = Exp.UnOp (Unop.LNot, cond_exp, None) in
@ -189,7 +189,7 @@ module Make
let rec structured_instr_to_node (last_node, assert_map) exn_handlers = function
| Cmd cmd ->
let node = create_node (Cfg.Node.Stmt_node "") [cmd] in
let node = create_node (Procdesc.Node.Stmt_node "") [cmd] in
set_succs last_node [node] ~exn_handlers;
node, assert_map
| If (exp, then_instrs, else_instrs) ->
@ -199,34 +199,34 @@ module Make
structured_instrs_to_node then_prune_node assert_map exn_handlers then_instrs in
let else_branch_end_node, assert_map'' =
structured_instrs_to_node else_prune_node assert_map' exn_handlers else_instrs in
let join_node = create_node Cfg.Node.Join_node [] in
let join_node = create_node Procdesc.Node.Join_node [] in
set_succs then_branch_end_node [join_node] ~exn_handlers;
set_succs else_branch_end_node [join_node] ~exn_handlers;
join_node, assert_map''
| While (exp, body_instrs) ->
let loop_head_join_node = create_node Cfg.Node.Join_node [] in
let loop_head_join_node = create_node Procdesc.Node.Join_node [] in
set_succs last_node [loop_head_join_node] ~exn_handlers;
let true_prune_node, false_prune_node = mk_prune_nodes_for_cond exp Sil.Ik_while in
set_succs loop_head_join_node [true_prune_node; false_prune_node] ~exn_handlers;
let loop_body_end_node, assert_map' =
structured_instrs_to_node true_prune_node assert_map exn_handlers body_instrs in
let loop_exit_node = create_node (Cfg.Node.Skip_node "") [] in
let loop_exit_node = create_node (Procdesc.Node.Skip_node "") [] in
set_succs loop_body_end_node [loop_head_join_node] ~exn_handlers;
set_succs false_prune_node [loop_exit_node] ~exn_handlers;
loop_exit_node, assert_map'
| Try (try_instrs, catch_instrs, finally_instrs) ->
let catch_start_node = create_node (Cfg.Node.Skip_node "exn_handler") [] in
let catch_start_node = create_node (Procdesc.Node.Skip_node "exn_handler") [] in
(* use [catch_start_node] as the exn handler *)
let try_end_node, assert_map' =
structured_instrs_to_node last_node assert_map [catch_start_node] try_instrs in
let catch_end_node, assert_map'' =
structured_instrs_to_node catch_start_node assert_map' exn_handlers catch_instrs in
let finally_start_node = create_node (Cfg.Node.Skip_node "finally") [] in
let finally_start_node = create_node (Procdesc.Node.Skip_node "finally") [] in
set_succs try_end_node [finally_start_node] ~exn_handlers;
set_succs catch_end_node [finally_start_node] ~exn_handlers;
structured_instrs_to_node finally_start_node assert_map'' exn_handlers finally_instrs
| Invariant (inv_str, inv_label) ->
let node = create_node (Cfg.Node.Stmt_node "Invariant") [] in
let node = create_node (Procdesc.Node.Stmt_node "Invariant") [] in
set_succs last_node [node] ~exn_handlers;
(* add the assertion to be checked after analysis converges *)
node, M.add (CFG.id node) (inv_str, inv_label) assert_map
@ -235,14 +235,14 @@ module Make
(fun acc instr -> structured_instr_to_node acc exn_handlers instr)
(last_node, assert_map)
instrs in
let start_node = create_node (Cfg.Node.Start_node pname) [] in
Cfg.Procdesc.set_start_node pdesc start_node;
let start_node = create_node (Procdesc.Node.Start_node pname) [] in
Procdesc.set_start_node pdesc start_node;
let no_exn_handlers = [] in
let last_node, assert_map =
structured_instrs_to_node start_node M.empty no_exn_handlers program in
let exit_node = create_node (Cfg.Node.Exit_node pname) [] in
let exit_node = create_node (Procdesc.Node.Exit_node pname) [] in
set_succs last_node [exit_node] ~exn_handlers:no_exn_handlers;
Cfg.Procdesc.set_exit_node pdesc exit_node;
Procdesc.set_exit_node pdesc exit_node;
pdesc, assert_map
let create_test test_program extras pp_opt test_pname _ =

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

@ -28,18 +28,18 @@ let tests =
let instrs3 = [dummy_instr4] in
let instrs4 = [] in
let create_node instrs =
Cfg.Procdesc.create_node test_pdesc Location.dummy (Cfg.Node.Stmt_node "") instrs in
Procdesc.create_node test_pdesc Location.dummy (Procdesc.Node.Stmt_node "") instrs in
let n1 = create_node instrs1 in
let n2 = create_node instrs2 in
let n3 = create_node instrs3 in
let n4 = create_node instrs4 in
Cfg.Procdesc.set_start_node test_pdesc n1;
Procdesc.set_start_node test_pdesc n1;
(* let -> represent normal transitions and -*-> represent exceptional transitions *)
(* creating graph n1 -> n2, n1 -*-> n3, n2 -> n4, n2 -*-> n3, n3 -> n4 , n3 -*> n4 *)
Cfg.Procdesc.node_set_succs_exn test_pdesc n1 [n2] [n3];
Cfg.Procdesc.node_set_succs_exn test_pdesc n2 [n4] [n3];
Cfg.Procdesc.node_set_succs_exn test_pdesc n3 [n4] [n4];
Procdesc.node_set_succs_exn test_pdesc n1 [n2] [n3];
Procdesc.node_set_succs_exn test_pdesc n2 [n4] [n3];
Procdesc.node_set_succs_exn test_pdesc n3 [n4] [n4];
let normal_proc_cfg = ProcCfg.Normal.from_pdesc test_pdesc in
let exceptional_proc_cfg = ProcCfg.Exceptional.from_pdesc test_pdesc in
@ -48,11 +48,11 @@ let tests =
let open OUnit2 in
let cmp l1 l2 =
let sort = IList.sort Cfg.Node.compare in
IList.equal Cfg.Node.compare (sort l1) (sort l2) in
let sort = IList.sort Procdesc.Node.compare in
IList.equal Procdesc.Node.compare (sort l1) (sort l2) in
let pp_diff fmt (actual, expected) =
let pp_sep fmt _ = F.pp_print_char fmt ',' in
let pp_node_list fmt l = F.pp_print_list ~pp_sep Cfg.Node.pp fmt l in
let pp_node_list fmt l = F.pp_print_list ~pp_sep Procdesc.Node.pp fmt l in
F.fprintf fmt "Expected output %a but got %a" pp_node_list expected pp_node_list actual in
let create_test input expected _ =
assert_equal ~cmp ~pp_diff input expected in

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

@ -24,7 +24,7 @@ module MockNode = struct
let id n = n
let loc _ = assert false
let underlying_id _ = assert false
let kind _ = Cfg.Node.Stmt_node ""
let kind _ = Procdesc.Node.Stmt_node ""
let id_compare = int_compare
let pp_id fmt i =
F.fprintf fmt "%i" i

Write Preview
Loading…
Cancel
Save