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; 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 */ /** data type for the control flow graph */
type cfg = { type cfg = {proc_desc_table: Procname.Hash.t Procdesc.t /** Map proc name to procdesc */};
mutable proc_desc_id_counter: int /** Counter for identifiers of procdescs */,
proc_desc_table: Procname.Hash.t Procdesc.t /** Map proc name to procdesc */
};
/** create a new empty cfg */ /** 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; 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 */ /** Create a new procdesc */
let create_proc_desc cfg (proc_attributes: ProcAttributes.t) => { let create_proc_desc cfg (proc_attributes: ProcAttributes.t) => {
cfg.proc_desc_id_counter = cfg.proc_desc_id_counter + 1; let pdesc = Procdesc.from_proc_attributes called_from_cfg::true proc_attributes;
let pdesc = {
Procdesc.attributes: proc_attributes,
id: cfg.proc_desc_id_counter,
nodes: [],
nodes_num: 0,
start_node: Node.dummy (),
exit_node: Node.dummy ()
};
add_proc_desc cfg proc_attributes.proc_name pdesc; add_proc_desc cfg proc_attributes.proc_name pdesc;
pdesc pdesc
}; };
@ -545,7 +46,8 @@ let create_proc_desc cfg (proc_attributes: ProcAttributes.t) => {
/** Iterate over all the nodes in the cfg */ /** Iterate over all the nodes in the cfg */
let iter_all_nodes f 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 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 */ /** checks whether a cfg is connected or not */
let check_cfg_connectedness cfg => { let check_cfg_connectedness cfg => {
let is_exit_node n => let is_exit_node n =>
switch (Node.get_kind n) { switch (Procdesc.Node.get_kind n) {
| Node.Exit_node _ => true | Procdesc.Node.Exit_node _ => true
| _ => false | _ => false
}; };
let broken_node n => { let broken_node n => {
let succs = Node.get_succs n; let succs = Procdesc.Node.get_succs n;
let preds = Node.get_preds n; let preds = Procdesc.Node.get_preds n;
switch (Node.get_kind n) { switch (Procdesc.Node.get_kind n) {
| Node.Start_node _ => IList.length succs == 0 || IList.length preds > 0 | Procdesc.Node.Start_node _ => IList.length succs == 0 || IList.length preds > 0
| Node.Exit_node _ => IList.length succs > 0 || IList.length preds == 0 | Procdesc.Node.Exit_node _ => IList.length succs > 0 || IList.length preds == 0
| Node.Stmt_node _ | Procdesc.Node.Stmt_node _
| Node.Prune_node _ | Procdesc.Node.Prune_node _
| Node.Skip_node _ => IList.length succs == 0 || IList.length preds == 0 | Procdesc.Node.Skip_node _ => IList.length succs == 0 || IList.length preds == 0
| Node.Join_node => | Procdesc.Node.Join_node =>
/* Join node has the exception that it may be without predecessors /* Join node has the exception that it may be without predecessors
and pointing to an exit node */ and pointing to an exit node */
/* if the if brances end with a return */ /* if the if brances end with a return */
@ -741,10 +243,10 @@ let proc_inline_synthetic_methods cfg pdesc :unit => {
modified := true; modified := true;
instr' instr'
}; };
let instrs = Node.get_instrs node; let instrs = Procdesc.Node.get_instrs node;
let instrs' = IList.map do_instr instrs; let instrs' = IList.map do_instr instrs;
if !modified { if !modified {
Node.replace_instrs node instrs' Procdesc.Node.replace_instrs node instrs'
} }
}; };
Procdesc.iter_nodes node_inline_synthetic_methods pdesc 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 */ /* map of exp names in pd1 -> exp names in pd2 */
let exp_map = ref Exp.Map.empty; let exp_map = ref Exp.Map.empty;
/* map of node id's in pd1 -> node id's in pd2 */ /* 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 */ /* formals are the same if their types are the same */
let formals_eq formals1 formals2 => let formals_eq formals1 formals2 =>
IList.equal (fun (_, typ1) (_, typ2) => Typ.compare typ1 typ2) formals1 formals2; IList.equal (fun (_, typ1) (_, typ2) => Typ.compare typ1 typ2) formals1 formals2;
let nodes_eq n1s n2s => { let nodes_eq n1s n2s => {
/* nodes are the same if they have the same id, instructions, and succs/preds up to renaming /* nodes are the same if they have the same id, instructions, and succs/preds up to renaming
with [exp_map] and [id_map] */ with [exp_map] and [id_map] */
let node_eq (n1: Node.t) (n2: Node.t) => { let node_eq (n1: Procdesc.Node.t) (n2: Procdesc.Node.t) => {
let id_compare (n1: Node.t) (n2: Node.t) => { let id_compare (n1: Procdesc.Node.t) (n2: Procdesc.Node.t) =>
let (id1, id2) = (n1.id, n2.id);
try { try {
let id1_mapping = IntMap.find id1 !id_map; let n1_mapping = Procdesc.NodeMap.find n1 !node_map;
Pervasives.compare id1_mapping id2 Procdesc.Node.compare n1_mapping n2
} { } {
| Not_found => | Not_found =>
/* assume id's are equal and enforce by adding to [id_map] */ /* 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 0
} };
};
let instrs_eq instrs1 instrs2 => let instrs_eq instrs1 instrs2 =>
IList.equal IList.equal
( (
@ -799,18 +299,20 @@ let mark_unchanged_pdescs cfg_new cfg_old => {
instrs1 instrs1
instrs2; instrs2;
id_compare n1 n2 == 0 && id_compare n1 n2 == 0 &&
IList.equal id_compare n1.succs n2.succs && IList.equal Procdesc.Node.compare (Procdesc.Node.get_succs n1) (Procdesc.Node.get_succs n2) &&
IList.equal id_compare n1.preds n2.preds && instrs_eq n1.instrs n2.instrs 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) { try (IList.for_all2 node_eq n1s n2s) {
| Invalid_argument _ => false | Invalid_argument _ => false
} }
}; };
let att1 = pd1.attributes let att1 = Procdesc.get_attributes pd1
and att2 = pd2.attributes; and att2 = Procdesc.get_attributes pd2;
att1.is_defined == att2.is_defined && att1.is_defined == att2.is_defined &&
Typ.equal att1.ret_type att2.ret_type && 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 old_procs = cfg_old.proc_desc_table;
let new_procs = cfg_new.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 old_pdesc = Procname.Hash.find old_procs pname;
let changed = let changed =
/* in continue_capture mode keep the old changed bit */ /* 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); not (pdescs_eq old_pdesc new_pdesc);
new_pdesc.attributes.changed = changed (Procdesc.get_attributes new_pdesc).changed = changed
} { } {
| Not_found => () | Not_found => ()
}; };
@ -940,14 +442,14 @@ let specialize_types_proc callee_pdesc resolved_pdesc substitutions => {
instrs; instrs;
let convert_node_kind = let convert_node_kind =
fun fun
| Node.Start_node _ => Node.Start_node resolved_pname | Procdesc.Node.Start_node _ => Procdesc.Node.Start_node resolved_pname
| Node.Exit_node _ => Node.Exit_node resolved_pname | Procdesc.Node.Exit_node _ => Procdesc.Node.Exit_node resolved_pname
| node_kind => node_kind; | node_kind => node_kind;
let node_map = ref NodeMap.empty; let node_map = ref Procdesc.NodeMap.empty;
let rec convert_node node => { let rec convert_node node => {
let loc = Node.get_loc node let loc = Procdesc.Node.get_loc node
and kind = convert_node_kind (Node.get_kind node) and kind = convert_node_kind (Procdesc.Node.get_kind node)
and instrs = IList.fold_left convert_instr [] (Node.get_instrs node) |> IList.rev; and instrs = IList.fold_left convert_instr [] (Procdesc.Node.get_instrs node) |> IList.rev;
Procdesc.create_node resolved_pdesc loc kind instrs Procdesc.create_node resolved_pdesc loc kind instrs
} }
and loop callee_nodes => and loop callee_nodes =>
@ -955,16 +457,16 @@ let specialize_types_proc callee_pdesc resolved_pdesc substitutions => {
| [] => [] | [] => []
| [node, ...other_node] => | [node, ...other_node] =>
let converted_node = let converted_node =
try (NodeMap.find node !node_map) { try (Procdesc.NodeMap.find node !node_map) {
| Not_found => | Not_found =>
let new_node = convert_node node let new_node = convert_node node
and successors = Node.get_succs node and successors = Procdesc.Node.get_succs node
and exn_nodes = Node.get_exn node; and exn_nodes = Procdesc.Node.get_exn node;
node_map := NodeMap.add node new_node !node_map; node_map := Procdesc.NodeMap.add node new_node !node_map;
if (Node.equal node callee_start_node) { if (Procdesc.Node.equal node callee_start_node) {
Procdesc.set_start_node resolved_pdesc new_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.set_exit_node resolved_pdesc new_node
}; };
Procdesc.node_set_succs_exn callee_pdesc new_node (loop successors) (loop exn_nodes); 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 */ /** 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 */ /** A control-flow graph */
type cfg; type cfg;
@ -243,18 +28,6 @@ let store_cfg_to_file:
save_sources::bool? => source_file::DB.source_file => DB.filename => cfg => unit; 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} */ /** {2 Functions for manipulating an interprocedural CFG} */
/** create a new empty 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 */ /** 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 */ /** 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 the new prop and the array length *)
(* Return None if it fails to add the array *) (* Return None if it fails to add the array *)
let add_array_to_prop tenv pdesc prop_ lexp typ = 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 let n_lexp, prop = check_arith_norm_exp tenv pname lexp prop_ in
begin begin
try 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 (match add_array_to_prop tenv pdesc prop_ lexp typ with
| None -> [] | None -> []
| Some (_, prop_a) -> (* Invariant: prop_a has an array pointed to by lexp *) | 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_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 n_len, prop = check_arith_norm_exp tenv pname len prop__ in
let hpred, sigma' = IList.partition (function 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; } let execute___print_value { Builtin.tenv; pdesc; prop_; path; args; }
: Builtin.ret_typ = : Builtin.ret_typ =
L.err "__print_value: "; 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 do_arg (lexp, _) =
let n_lexp, _ = check_arith_norm_exp tenv pname lexp prop_ in let n_lexp, _ = check_arith_norm_exp tenv pname lexp prop_ in
L.err "%a " Exp.pp n_lexp 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 = : Builtin.ret_typ =
match args with match args with
| [(lexp, typ)] -> | [(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 n_lexp, prop = check_arith_norm_exp tenv pname lexp prop_ in
let props = create_type tenv n_lexp typ prop in let props = create_type tenv n_lexp typ prop in
let aux prop = let aux prop =
@ -233,7 +233,7 @@ let execute___instanceof_cast ~instof
: Builtin.ret_typ = : Builtin.ret_typ =
match args with match args with
| [(val1_, typ1); (texp2_, _)] -> | [(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 val1, prop__ = check_arith_norm_exp tenv pname val1_ prop_ in
let texp2, prop = check_arith_norm_exp tenv pname texp2_ prop__ in let texp2, prop = check_arith_norm_exp tenv pname texp2_ prop__ in
let is_cast_to_reference = 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 = : Builtin.ret_typ =
match args, ret_id with match args, ret_id with
| [(lexp, _)], _ -> | [(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 n_lexp, prop = check_arith_norm_exp tenv pname lexp prop_ in
set_resource_attribute tenv prop path n_lexp loc PredSymb.Rfile set_resource_attribute tenv prop path n_lexp loc PredSymb.Rfile
| _ -> raise (Exceptions.Wrong_argument_number __POS__) | _ -> 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 = : Builtin.ret_typ =
match args, ret_id with match args, ret_id with
| [(lexp, _)], _ -> | [(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 n_lexp, prop = check_arith_norm_exp tenv pname lexp prop_ in
set_resource_attribute tenv prop path n_lexp loc PredSymb.Rlock set_resource_attribute tenv prop path n_lexp loc PredSymb.Rlock
| _ -> raise (Exceptions.Wrong_argument_number __POS__) | _ -> 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 = : Builtin.ret_typ =
match args, ret_id with match args, ret_id with
| [_ ; (lexp, _)], _ -> | [_ ; (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 n_lexp, prop = check_arith_norm_exp tenv pname lexp prop_ in
set_resource_attribute tenv prop path n_lexp loc PredSymb.Rignore set_resource_attribute tenv prop path n_lexp loc PredSymb.Rignore
| _ -> raise (Exceptions.Wrong_argument_number __POS__) | _ -> 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 = : Builtin.ret_typ =
match args, ret_id with match args, ret_id with
| [(lexp, _)], _ -> | [(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 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) set_resource_attribute tenv prop path n_lexp loc (PredSymb.Rmemory PredSymb.Mnew)
| _ -> raise (Exceptions.Wrong_argument_number __POS__) | _ -> raise (Exceptions.Wrong_argument_number __POS__)
@ -374,7 +374,7 @@ let execute___check_untainted
: Builtin.ret_typ = : Builtin.ret_typ =
match args, ret_id with match args, ret_id with
| [(lexp, _)], _ -> | [(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 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)] [(check_untainted tenv n_lexp PredSymb.Tk_unknown caller_pname callee_pname prop, path)]
| _ -> raise (Exceptions.Wrong_argument_number __POS__) | _ -> 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 = : Builtin.ret_typ =
match args with match args with
| [(lexp, _)] -> | [(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 n_lexp, prop = check_arith_norm_exp tenv pname lexp prop_ in
let ret_val = ref None in let ret_val = ref None in
let return_val p = match !ret_val with 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 = : Builtin.ret_typ =
match args with match args with
| [(lexp1, _); (lexp2, _)] -> | [(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_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_lexp2, prop = check_arith_norm_exp tenv pname lexp2 prop__ in
let foot_var = lazy (Exp.Var (Ident.create_fresh Ident.kfootprint)) 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 = : Builtin.ret_typ =
match args, ret_id with match args, ret_id with
| [(lexp, _)], _ -> | [(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 let prop = return_result tenv lexp prop_ ret_id in
if Config.objc_memory_model_on then if Config.objc_memory_model_on then
let n_lexp, prop = check_arith_norm_exp tenv pname lexp prop in 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 else execute___no_op prop_ path
let set_attr tenv pdesc prop path exp attr = 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 let n_lexp, prop = check_arith_norm_exp tenv pname exp prop in
[(Attribute.add_or_replace tenv prop (Apred (attr, [n_lexp])), path)] [(Attribute.add_or_replace tenv prop (Apred (attr, [n_lexp])), path)]
let delete_attr tenv pdesc prop path exp attr = 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 let n_lexp, prop = check_arith_norm_exp tenv pname exp prop in
[(Attribute.remove tenv prop (Apred (attr, [n_lexp])), path)] [(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 let execute___set_unlocked_attribute
({ Builtin.pdesc; loc; } as builtin_args) ({ Builtin.pdesc; loc; } as builtin_args)
: Builtin.ret_typ = : 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 *) (* ra_kind = Rrelease in following indicates unlocked *)
let ra = { let ra = {
PredSymb.ra_kind = PredSymb.Rrelease; PredSymb.ra_kind = PredSymb.Rrelease;
@ -620,7 +620,7 @@ let execute___set_taint_attribute
: Builtin.ret_typ = : Builtin.ret_typ =
match args with match args with
| (exp, _) :: [(Exp.Const (Const.Cstr taint_kind_str), _)] -> | (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 let taint_kind = match taint_kind_str with
| "UnverifiedSSLSocket" -> PredSymb.Tk_unverified_SSL_socket | "UnverifiedSSLSocket" -> PredSymb.Tk_unverified_SSL_socket
| "SharedPreferenceData" -> PredSymb.Tk_shared_preferences_data | "SharedPreferenceData" -> PredSymb.Tk_shared_preferences_data
@ -636,7 +636,7 @@ let execute___set_untaint_attribute
: Builtin.ret_typ = : Builtin.ret_typ =
match args with match args with
| (exp, _) :: [] -> | (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 *) 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}) 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 = : Builtin.ret_typ =
match args with match args with
| [(val1_, _); (texp2_, _)] -> | [(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 val1, prop__ = check_arith_norm_exp tenv pname val1_ prop_ in
let texp2, prop = check_arith_norm_exp tenv pname texp2_ prop__ in let texp2, prop = check_arith_norm_exp tenv pname texp2_ prop__ in
(try (try
@ -717,7 +717,7 @@ let execute_free mk { Builtin.pdesc; instr; tenv; prop_; path; args; loc; }
match args with match args with
| [(lexp, typ)] -> | [(lexp, typ)] ->
begin 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 n_lexp, prop = check_arith_norm_exp tenv pname lexp prop_ in
let prop_nonzero = (* case n_lexp!=0 *) let prop_nonzero = (* case n_lexp!=0 *)
Propset.to_proplist (prune tenv ~positive:true n_lexp prop) in 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 let execute_alloc mk can_return_null
{ Builtin.pdesc; tenv; prop_; path; ret_id; args; loc; } { Builtin.pdesc; tenv; prop_; path; ret_id; args; loc; }
: Builtin.ret_typ = : 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 let rec evaluate_char_sizeof e = match e with
| Exp.Var _ -> e | Exp.Var _ -> e
| Exp.UnOp (uop, e', typ) -> | 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 (let res = execute_alloc PredSymb.Mnew false { r with args = [type_info_exp] } in
match rest with match rest with
| [(field_exp, _); (lexp, typ)] -> | [(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 n_lexp, prop = check_arith_norm_exp tenv pname lexp prop_ in
let typ = let typ =
try try
@ -861,7 +861,7 @@ let execute__unwrap_exception { Builtin.tenv; pdesc; prop_; path; ret_id; args;
match args with match args with
| [(ret_exn, _)] -> | [(ret_exn, _)] ->
begin 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 let n_ret_exn, prop = check_arith_norm_exp tenv pname ret_exn prop_ in
match n_ret_exn with match n_ret_exn with
| Exp.Exn exp -> | Exp.Exn exp ->
@ -875,7 +875,7 @@ let execute_return_first_argument { Builtin.tenv; pdesc; prop_; path; ret_id; ar
: Builtin.ret_typ = : Builtin.ret_typ =
match args with match args with
| (arg1_, _):: _ -> | (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 arg1, prop = check_arith_norm_exp tenv pname arg1_ prop_ in
let prop' = return_result tenv arg1 prop ret_id in let prop' = return_result tenv arg1 prop ret_id in
[(prop', path)] [(prop', path)]
@ -885,7 +885,7 @@ let execute___split_get_nth { Builtin.tenv; pdesc; prop_; path; ret_id; args; }
: Builtin.ret_typ = : Builtin.ret_typ =
match args with match args with
| [(lexp1, _); (lexp2, _); (lexp3, _)] -> | [(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_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_lexp2, prop___ = check_arith_norm_exp tenv pname lexp2 prop__ in
let n_lexp3, prop = check_arith_norm_exp tenv pname lexp3 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; open! Utils;
let get_name_of_local (curr_f: Cfg.Procdesc.t) (x, _) => let get_name_of_local (curr_f: Procdesc.t) (x, _) => Pvar.mk x (Procdesc.get_proc_name curr_f);
Pvar.mk x (Cfg.Procdesc.get_proc_name curr_f);
/* returns a list of local static variables (ie local variables defined static) in a proposition */ /* 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 get_name_of_objc_static_locals (curr_f: Procdesc.t) p => {
let pname = Procname.to_string (Cfg.Procdesc.get_proc_name curr_f); let pname = Procname.to_string (Procdesc.get_proc_name curr_f);
let local_static e => let local_static e =>
switch e { switch e {
/* is a local static if it's a global and it has a static local name */ /* 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) Prop.normalize tenv (Prop.set p' pi::pi_reach sigma::sigma_reach)
}; };
let remove_locals tenv (curr_f: Cfg.Procdesc.t) p => { let remove_locals tenv (curr_f: Procdesc.t) p => {
let names_of_locals = IList.map (get_name_of_local curr_f) (Cfg.Procdesc.get_locals curr_f); let names_of_locals = IList.map (get_name_of_local curr_f) (Procdesc.get_locals curr_f);
let names_of_locals' = let names_of_locals' =
switch !Config.curr_language { switch !Config.curr_language {
| Config.Clang => | 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 remove_formals tenv (curr_f: Procdesc.t) p => {
let pname = Cfg.Procdesc.get_proc_name curr_f; let pname = Procdesc.get_proc_name curr_f;
let formal_vars = IList.map (fun (n, _) => Pvar.mk n pname) (Cfg.Procdesc.get_formals 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 Attribute.deallocate_stack_vars tenv p formal_vars
}; };
/** remove the return variable from the prop */ /** remove the return variable from the prop */
let remove_ret tenv (curr_f: Cfg.Procdesc.t) (p: Prop.t Prop.normal) => { let remove_ret tenv (curr_f: Procdesc.t) (p: Prop.t Prop.normal) => {
let pname = Cfg.Procdesc.get_proc_name curr_f; let pname = Procdesc.get_proc_name curr_f;
let name_of_ret = Cfg.Procdesc.get_ret_var 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]; let (_, p') = Attribute.deallocate_stack_vars tenv p [Pvar.to_callee pname name_of_ret];
p' p'
}; };
/** remove locals and return variable from the prop */ /** 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 tenv curr_f (remove_ret tenv curr_f p)
); );
/** Remove locals and formal parameters from the prop. /** Remove locals and formal parameters from the prop.
Return the list of stack variables whose address was still present after deallocation. */ 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 (pvars1, p1) = remove_formals tenv curr_f p;
let (pvars2, p2) = remove_locals tenv curr_f p1; let (pvars2, p2) = remove_locals tenv curr_f p1;
(pvars1 @ pvars2, p2) (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 */ /** 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 */ /** 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. /** 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. */ Return the list of stack variables whose address was still present after deallocation. */
let remove_locals_formals: 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 */ /** 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"; if verbose then L.d_strln "in nested loop";
true (* last two loop visits were entering loops *) true (* last two loop visits were entering loops *)
| _ -> false in | _ -> false in
let do_node_caller node = match Cfg.Node.get_kind node with let do_node_caller node = match Procdesc.Node.get_kind node with
| Cfg.Node.Prune_node (b, (Sil.Ik_dowhile | Sil.Ik_for | Sil.Ik_while), _) -> | Procdesc.Node.Prune_node (b, (Sil.Ik_dowhile | Sil.Ik_for | Sil.Ik_while), _) ->
(* if verbose then *) (* if verbose then *)
(* L.d_strln ((if b then "enter" else "exit") ^ " node " *) (* 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 loop_visits_log := b :: !loop_visits_log
| _ -> () in | _ -> () in
let do_any_node _level _node = let do_any_node _level _node =
incr trace_length; incr trace_length;
(* L.d_strln *) (* L.d_strln *)
(* ("level " ^ string_of_int _level ^ *) (* ("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 in
let f level p _ _ = match Paths.Path.curr_node p with let f level p _ _ = match Paths.Path.curr_node p with
| Some node -> | Some node ->
@ -54,11 +54,11 @@ let check_nested_loop path pos_opt =
let check_access access_opt de_opt = let check_access access_opt de_opt =
let find_bucket line_number null_case_flag = let find_bucket line_number null_case_flag =
let find_formal_ids node = (* find ids obtained by a letref on a formal parameter *) 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 let formals = match State.get_prop_tenv_pdesc () with
| None -> [] | None -> []
| Some (_, _, pdesc) -> | Some (_, _, pdesc) ->
Cfg.Procdesc.get_formals pdesc in Procdesc.get_formals pdesc in
let formal_names = IList.map fst formals in let formal_names = IList.map fst formals in
let is_formal pvar = let is_formal pvar =
let name = Pvar.get_name pvar in let name = Pvar.get_name pvar in
@ -97,10 +97,10 @@ let check_access access_opt de_opt =
| Sil.Store (_, _, e, _) -> | Sil.Store (_, _, e, _) ->
exp_is_null e exp_is_null e
| _ -> false in | _ -> 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 local_access_found = ref false in
let do_node node = 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 begin
local_access_found := true local_access_found := true
end in 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 *) (** Module for builtin functions with their symbolic execution handler *)
type args = { type args = {
pdesc : Cfg.Procdesc.t; pdesc : Procdesc.t;
instr : Sil.instr; instr : Sil.instr;
tenv : Tenv.t; tenv : Tenv.t;
prop_ : Prop.normal Prop.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 *) (** Module for builtin functions with their symbolic execution handler *)
type args = { type args = {
pdesc : Cfg.Procdesc.t; pdesc : Procdesc.t;
instr : Sil.instr; instr : Sil.instr;
tenv : Tenv.t; tenv : Tenv.t;
prop_ : Prop.normal Prop.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 *) (** Module to register and invoke callbacks *)
type proc_callback_args = { 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; get_procs_in_file : Procname.t -> Procname.t list;
idenv : Idenv.t; idenv : Idenv.t;
tenv : Tenv.t; tenv : Tenv.t;
proc_name : Procname.t; proc_name : Procname.t;
proc_desc : Cfg.Procdesc.t; proc_desc : Procdesc.t;
} }
type proc_callback_t = proc_callback_args -> unit type proc_callback_t = proc_callback_args -> unit
@ -27,8 +27,8 @@ type proc_callback_t = proc_callback_args -> unit
type cluster_callback_t = type cluster_callback_t =
Exe_env.t -> Exe_env.t ->
Procname.t list -> Procname.t list ->
(Procname.t -> Cfg.Procdesc.t option) -> (Procname.t -> Procdesc.t option) ->
(Idenv.t * Tenv.t * Procname.t * Cfg.Procdesc.t) list -> (Idenv.t * Tenv.t * Procname.t * Procdesc.t) list ->
unit unit
let procedure_callbacks = ref [] let procedure_callbacks = ref []
@ -51,7 +51,7 @@ let get_procedure_definition exe_env proc_name =
Option.map Option.map
(fun proc_desc -> (fun proc_desc ->
let idenv = Idenv.create 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)) (idenv, tenv, proc_name, proc_desc, language))
(Exe_env.get_proc_desc exe_env proc_name) (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 = let get_procs_in_file proc_name =
match Exe_env.get_cfg exe_env proc_name with match Exe_env.get_cfg exe_env proc_name with
| Some cfg-> | Some cfg->
IList.map Cfg.Procdesc.get_proc_name (Cfg.get_defined_procs cfg) IList.map Procdesc.get_proc_name (Cfg.get_defined_procs cfg)
| None -> | None ->
[] in [] in

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

@ -12,12 +12,12 @@ open! Utils
(** Module to register and invoke callbacks *) (** Module to register and invoke callbacks *)
type proc_callback_args = { 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; get_procs_in_file : Procname.t -> Procname.t list;
idenv : Idenv.t; idenv : Idenv.t;
tenv : Tenv.t; tenv : Tenv.t;
proc_name : Procname.t; proc_name : Procname.t;
proc_desc : Cfg.Procdesc.t; proc_desc : Procdesc.t;
} }
(** Type of a procedure callback: (** Type of a procedure callback:
@ -31,8 +31,8 @@ type proc_callback_t = proc_callback_args -> unit
type cluster_callback_t = type cluster_callback_t =
Exe_env.t -> Exe_env.t ->
Procname.t list -> Procname.t list ->
(Procname.t -> Cfg.Procdesc.t option) -> (Procname.t -> Procdesc.t option) ->
(Idenv.t * Tenv.t * Procname.t * Cfg.Procdesc.t) list -> (Idenv.t * Tenv.t * Procname.t * Procdesc.t) list ->
unit unit
(** register a procedure callback *) (** 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 *) (********** Print control flow graph (in dot form) for fundec to *)
(* channel. You have to compute an interprocedural cfg first *) (* channel. You have to compute an interprocedural cfg first *)
let pp_cfgnodename pname fmt (n : Cfg.Node.t) = let pp_cfgnodename pname fmt (n : Procdesc.Node.t) =
F.fprintf fmt "\"%s_%d\"" (Procname.to_filename pname) (Cfg.Node.get_id n :> int) F.fprintf fmt "\"%s_%d\"" (Procname.to_filename pname) (Procdesc.Node.get_id n :> int)
let pp_etlist fmt etl = let pp_etlist fmt etl =
IList.iter (fun (id, ty) -> IList.iter (fun (id, ty) ->
@ -947,60 +947,62 @@ let pp_local_list fmt etl =
IList.iter (fun (id, ty) -> IList.iter (fun (id, ty) ->
Format.fprintf fmt " %a:%a" Mangled.pp id (Typ.pp_full pe_text) ty) etl 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 = let pp_label fmt n =
match Cfg.Node.get_kind n with match Procdesc.Node.get_kind n with
| Cfg.Node.Start_node pname -> | Procdesc.Node.Start_node pname ->
Format.fprintf fmt "Start %s\\nFormals: %a\\nLocals: %a" Format.fprintf fmt "Start %s\\nFormals: %a\\nLocals: %a"
(Procname.to_string pname) (Procname.to_string pname)
pp_etlist (Cfg.Procdesc.get_formals pdesc) pp_etlist (Procdesc.get_formals pdesc)
pp_local_list (Cfg.Procdesc.get_locals pdesc); pp_local_list (Procdesc.get_locals pdesc);
if IList.length (Cfg.Procdesc.get_captured pdesc) <> 0 then if IList.length (Procdesc.get_captured pdesc) <> 0 then
Format.fprintf fmt "\\nCaptured: %a" Format.fprintf fmt "\\nCaptured: %a"
pp_local_list (Cfg.Procdesc.get_captured pdesc) pp_local_list (Procdesc.get_captured pdesc)
| Cfg.Node.Exit_node pname -> | Procdesc.Node.Exit_node pname ->
Format.fprintf fmt "Exit %s" (Procname.to_string pname) Format.fprintf fmt "Exit %s" (Procname.to_string pname)
| Cfg.Node.Join_node -> | Procdesc.Node.Join_node ->
Format.fprintf fmt "+" 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 Format.fprintf fmt "Prune (%b branch)" is_true_branch
| Cfg.Node.Stmt_node s -> Format.fprintf fmt " %s" s | Procdesc.Node.Stmt_node s -> Format.fprintf fmt " %s" s
| Cfg.Node.Skip_node s -> Format.fprintf fmt "Skip %s" s in | Procdesc.Node.Skip_node s -> Format.fprintf fmt "Skip %s" s in
let instr_string i = let instr_string i =
let pp f () = Sil.pp_instr pe_text f i in let pp f () = Sil.pp_instr pe_text f i in
let str = pp_to_string pp () in let str = pp_to_string pp () in
Escape.escape_dotty str in Escape.escape_dotty str in
let pp_instrs fmt instrs = let pp_instrs fmt instrs =
IList.iter (fun i -> F.fprintf fmt " %s\\n " (instr_string i)) instrs in IList.iter (fun i -> F.fprintf fmt " %s\\n " (instr_string i)) instrs in
let instrs = Cfg.Node.get_instrs n in let instrs = Procdesc.Node.get_instrs n in
F.fprintf fmt "%d: %a \\n %a" (Cfg.Node.get_id n :> int) pp_label n pp_instrs instrs F.fprintf fmt "%d: %a \\n %a" (Procdesc.Node.get_id n :> int) pp_label n pp_instrs instrs
let pp_cfgnodeshape fmt (n: Cfg.Node.t) = let pp_cfgnodeshape fmt (n: Procdesc.Node.t) =
match Cfg.Node.get_kind n with match Procdesc.Node.get_kind n with
| Cfg.Node.Start_node _ | Cfg.Node.Exit_node _ -> F.fprintf fmt "color=yellow style=filled" | Procdesc.Node.Start_node _
| Cfg.Node.Prune_node _ -> F.fprintf fmt "shape=\"invhouse\"" | Procdesc.Node.Exit_node _ -> F.fprintf fmt "color=yellow style=filled"
| Cfg.Node.Skip_node _ -> F.fprintf fmt "color=\"gray\"" | Procdesc.Node.Prune_node _ -> F.fprintf fmt "shape=\"invhouse\""
| Cfg.Node.Stmt_node _ -> F.fprintf fmt "shape=\"box\"" | Procdesc.Node.Skip_node _ -> F.fprintf fmt "color=\"gray\""
| Procdesc.Node.Stmt_node _ -> F.fprintf fmt "shape=\"box\""
| _ -> F.fprintf fmt "" | _ -> F.fprintf fmt ""
let pp_cfgnode pdesc fmt (n: Cfg.Node.t) = let pp_cfgnode pdesc fmt (n: Procdesc.Node.t) =
let pname = Cfg.Procdesc.get_proc_name pdesc in let pname = Procdesc.get_proc_name pdesc in
F.fprintf fmt "%a [label=\"%a\" %a]\n\t\n" F.fprintf fmt "%a [label=\"%a\" %a]\n\t\n"
(pp_cfgnodename pname) n (pp_cfgnodename pname) n
(pp_cfgnodelabel pdesc) n (pp_cfgnodelabel pdesc) n
pp_cfgnodeshape n; pp_cfgnodeshape n;
let print_edge n1 n2 is_exn = let print_edge n1 n2 is_exn =
let color = if is_exn then "[color=\"red\" ]" else "" in let color = if is_exn then "[color=\"red\" ]" else "" in
match Cfg.Node.get_kind n2 with match Procdesc.Node.get_kind n2 with
| Cfg.Node.Exit_node _ when is_exn = true -> (* don't print exception edges to the exit node *) | 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;" F.fprintf fmt "\n\t %a -> %a %s;"
(pp_cfgnodename pname) n1 (pp_cfgnodename pname) n1
(pp_cfgnodename pname) n2 (pp_cfgnodename pname) n2
color in color in
IList.iter (fun n' -> print_edge n n' false) (Cfg.Node.get_succs n); IList.iter (fun n' -> print_edge n n' false) (Procdesc.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' true) (Procdesc.Node.get_exn n)
(* * print control flow graph (in dot form) for fundec to channel let *) (* * print control flow graph (in dot form) for fundec to channel let *)
(* print_cfg_channel (chan : out_channel) (fd : fundec) = let pnode (s: *) (* 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 *) (* special node, and call / return edges *)
let print_icfg source fmt cfg = let print_icfg source fmt cfg =
let print_node pdesc node = 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 if (Config.dotty_cfg_libs || DB.source_file_equal loc.Location.file source) then
F.fprintf fmt "%a\n" (pp_cfgnode pdesc) node in F.fprintf fmt "%a\n" (pp_cfgnode pdesc) node in
Cfg.iter_all_nodes print_node cfg 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 verbose = Config.trace_error
let find_in_node_or_preds start_node f_node_instr = 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 = let rec find node =
if Cfg.NodeSet.mem node !visited then None if Procdesc.NodeSet.mem node !visited then None
else else
begin begin
visited := Cfg.NodeSet.add node !visited; visited := Procdesc.NodeSet.add node !visited;
let instrs = Cfg.Node.get_instrs node in let instrs = Procdesc.Node.get_instrs node in
match IList.find_map_opt (f_node_instr node) (IList.rev instrs) with match IList.find_map_opt (f_node_instr node) (IList.rev instrs) with
| Some res -> Some res | 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 end in
find start_node 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 *) (** Check if a nullify instruction exists for the program variable after the given instruction *)
let find_nullify_after_instr node instr pvar : bool = 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 found_instr = ref false in
let find_nullify = function let find_nullify = function
| Sil.Nullify (pv, _) when !found_instr -> Pvar.equal pv pvar | 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 (** Find the other prune node of a conditional
(e.g. the false branch given the true branch of a conditional) *) (e.g. the false branch given the true branch of a conditional) *)
let find_other_prune_node node = let find_other_prune_node node =
match Cfg.Node.get_preds node with match Procdesc.Node.get_preds node with
| [n_pre] -> | [n_pre] ->
(match Cfg.Node.get_succs n_pre with (match Procdesc.Node.get_succs n_pre with
| [n1; n2] -> | [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)
| _ -> None | _ -> None
@ -118,13 +118,13 @@ let id_is_assigned_then_dead node id =
match find_variable_assigment node id with match find_variable_assigment node id with
| Some (Sil.Store (Exp.Lvar pvar, _, _, _) as instr) | Some (Sil.Store (Exp.Lvar pvar, _, _, _) as instr)
when Pvar.is_local pvar || Pvar.is_callee pvar -> when Pvar.is_local pvar || Pvar.is_callee pvar ->
let is_prune = match Cfg.Node.get_kind node with let is_prune = match Procdesc.Node.get_kind node with
| Cfg.Node.Prune_node _ -> true | Procdesc.Node.Prune_node _ -> true
| _ -> false in | _ -> false in
let prune_check = function let prune_check = function
(* if prune node, check that it's also nullified in the other branch *) (* if prune node, check that it's also nullified in the other branch *)
| Some node' -> | Some node' ->
(match Cfg.Node.get_instrs node' with (match Procdesc.Node.get_instrs node' with
| instr':: _ -> find_nullify_after_instr node' instr' pvar | instr':: _ -> find_nullify_after_instr node' instr' pvar
| _ -> false) | _ -> false)
| _ -> false in | _ -> 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], (** Find the function call instruction used to initialize normal variable [id],
and return the function name and arguments *) and return the function name and arguments *)
let find_normal_variable_funcall 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 = (id: Ident.t): (Exp.t * (Exp.t list) * Location.t * CallFlags.t) option =
let find_declaration _ = function let find_declaration _ = function
| Sil.Call (Some (id0, _), fun_exp, args, loc, call_flags) when Ident.equal id id0 -> | 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 " ^ ("find_normal_variable_funcall could not find " ^
Ident.to_string id ^ Ident.to_string id ^
" in node " ^ " in node " ^
string_of_int (Cfg.Node.get_id node :> int)); string_of_int (Procdesc.Node.get_id node :> int));
L.d_ln ()); L.d_ln ());
res res
(** Find a program variable assignment in the current node or predecessors. *) (** 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 let find_instr node = function
| Sil.Store (Exp.Lvar _pvar, _, Exp.Var id, _) | Sil.Store (Exp.Lvar _pvar, _, Exp.Var id, _)
when Pvar.equal pvar _pvar && Ident.is_normal id -> when Pvar.equal pvar _pvar && Ident.is_normal id ->
@ -184,7 +184,7 @@ let find_struct_by_value_assignment node pvar =
else None else None
(** Find a program variable assignment to id in the current node or predecessors. *) (** 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 let find_instr node = function
| Sil.Load (_id, e, _, _) when Ident.equal _id id -> Some (node, e) | Sil.Load (_id, e, _, _) when Ident.equal _id id -> Some (node, e)
| _ -> None in | _ -> 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. (** Find a boolean assignment to a temporary variable holding a boolean condition.
The boolean parameter indicates whether the true or false branch is required. *) 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 find_instr n =
let filter = function let filter = function
| Sil.Store (Exp.Lvar _pvar, _, Exp.Const (Const.Cint i), _) when Pvar.equal pvar _pvar -> | Sil.Store (Exp.Lvar _pvar, _, Exp.Const (Const.Cint i), _) when Pvar.equal pvar _pvar ->
IntLit.iszero i <> true_branch IntLit.iszero i <> true_branch
| _ -> false in | _ -> false in
IList.exists filter (Cfg.Node.get_instrs n) in IList.exists filter (Procdesc.Node.get_instrs n) in
match Cfg.Node.get_preds node with match Procdesc.Node.get_preds node with
| [pred_node] -> find_boolean_assignment pred_node pvar true_branch | [pred_node] -> find_boolean_assignment pred_node pvar true_branch
| [n1; n2] -> | [n1; n2] ->
if find_instr n1 then (Some n1) 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 " ^ ("find_normal_variable_load could not find " ^
Ident.to_string id ^ Ident.to_string id ^
" in node " ^ " in node " ^
string_of_int (Cfg.Node.get_id node :> int)); string_of_int (Procdesc.Node.get_id node :> int));
L.d_ln ()); L.d_ln ());
res res
@ -484,7 +484,7 @@ let explain_leak tenv hpred prop alloc_att_opt bucket =
let instro = State.get_instr () in let instro = State.get_instr () in
let loc = State.get_loc () in let loc = State.get_loc () in
let node = State.get_node () 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 hpred_typ_opt = find_hpred_typ hpred in
let value_str_from_pvars_vpath pvars vpath = let value_str_from_pvars_vpath pvars vpath =
if pvars <> [] then 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 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 *) (** 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 *) (** 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 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], (** Find the function call instruction used to initialize normal variable [id],
and return the function name and arguments *) and return the function name and arguments *)
val find_normal_variable_funcall : 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. *) (** 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. *) (** 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. (** Find a boolean assignment to a temporary variable holding a boolean condition.
The boolean parameter indicates whether the true or false branch is required. *) 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 *) (** 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 *) (** Produce a description of a persistent reference to an Android Context *)
val explain_context_leak : Procname.t -> Typ.t -> Ident.fieldname -> 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 *) (** explain a class cast exception *)
val explain_class_cast_exception : val explain_class_cast_exception :
Tenv.t -> Procname.t option -> Exp.t -> Exp.t -> Exp.t -> 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 *) (** Explain a deallocate stack variable error *)
val explain_deallocate_stack_var : Pvar.t -> PredSymb.res_action -> Localise.error_desc 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 : val explain_dereference_as_caller_expression :
Tenv.t -> ?use_buckets:bool -> Tenv.t -> ?use_buckets:bool ->
Localise.deref_str -> 'a Prop.t -> 'b Prop.t -> Exp.t -> 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 *) (** 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 *) (** explain a return expression required *)
val explain_return_expression_required : Location.t -> Typ.t -> Localise.error_desc 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 *) (** explain a condition which is always true or false *)
val explain_condition_always_true_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 *) (** explain the escape of a stack variable address from its scope *)
val explain_stack_variable_address_escape : val explain_stack_variable_address_escape :
@ -107,7 +108,7 @@ val explain_retain_cycle :
(** explain unary minus applied to unsigned expression *) (** explain unary minus applied to unsigned expression *)
val 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 *) (** Explain a tainted value error *)
val explain_tainted_value_reaching_sensitive_function : 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 *) (** explain a test for NULL of a dereferenced pointer *)
val explain_null_test_after_dereference : 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) *) (** 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 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 val get_cfg : t -> Procname.t -> Cfg.cfg option
(** return the proc desc associated to the procedure *) (** 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] *) (** [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 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 *) (** A node with a number of visits *)
type visitednode = type visitednode =
{ {
node: Cfg.Node.t; node: Procdesc.Node.t;
visits: int; visits: int;
} }
@ -28,11 +28,11 @@ module NodeVisitSet =
type t = visitednode type t = visitednode
let compare_ids n1 n2 = let compare_ids n1 n2 =
(* higher id is better *) (* higher id is better *)
Cfg.Node.compare n2 n1 Procdesc.Node.compare n2 n1
let compare_distance_to_exit { node = n1 } { node = n2 } = let compare_distance_to_exit { node = n1 } { node = n2 } =
(* smaller means higher priority *) (* smaller means higher priority *)
let n = 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 -> | None, None ->
0 0
| None, Some _ -> | None, Some _ ->
@ -59,11 +59,11 @@ module NodeVisitSet =
module Join_table : sig module Join_table : sig
type t 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 create : unit -> t
val find : t -> Cfg.Node.id -> Paths.PathSet.t val find : t -> Procdesc.Node.id -> Paths.PathSet.t
end = struct 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 = let create () : t =
Hashtbl.create 11 Hashtbl.create 11
@ -78,14 +78,13 @@ end
(* =============== START of module Worklist =============== *) (* =============== START of module Worklist =============== *)
module Worklist = struct module Worklist = struct
module NodeMap = Map.Make(Cfg.Node)
type t = { type t = {
join_table : Join_table.t; (** Table of join results *) join_table : Join_table.t; (** Table of join results *)
path_set_todo : (Cfg.Node.id, Paths.PathSet.t) Hashtbl.t; (** Pathset todo *) path_set_todo : (Procdesc.Node.id, Paths.PathSet.t) Hashtbl.t; (** Pathset todo *)
path_set_visited : (Cfg.Node.id, Paths.PathSet.t) Hashtbl.t; (** Pathset visited *) 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 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 () = { let create () = {
@ -93,26 +92,26 @@ module Worklist = struct
path_set_todo = Hashtbl.create 11; path_set_todo = Hashtbl.create 11;
path_set_visited = Hashtbl.create 11; path_set_visited = Hashtbl.create 11;
todo_set = NodeVisitSet.empty; todo_set = NodeVisitSet.empty;
visit_map = NodeMap.empty; visit_map = Procdesc.NodeMap.empty;
} }
let is_empty (wl : t) : bool = let is_empty (wl : t) : bool =
NodeVisitSet.is_empty wl.todo_set 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 *) 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 | Not_found -> 0 in
wl.todo_set <- NodeVisitSet.add { node; visits } wl.todo_set wl.todo_set <- NodeVisitSet.add { node; visits } wl.todo_set
(** remove the minimum element from the worklist, and increase its number of visits *) (** 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 try
let min = NodeVisitSet.min_elt wl.todo_set in let min = NodeVisitSet.min_elt wl.todo_set in
wl.todo_set <- wl.todo_set <-
NodeVisitSet.remove min wl.todo_set; NodeVisitSet.remove min wl.todo_set;
wl.visit_map <- 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 min.node
with Not_found -> begin with Not_found -> begin
L.out "@\n...Work list is empty! Impossible to remove edge...@\n"; L.out "@\n...Work list is empty! Impossible to remove edge...@\n";
@ -124,10 +123,11 @@ end
let path_set_create_worklist pdesc = let path_set_create_worklist pdesc =
State.reset (); State.reset ();
Cfg.Procdesc.compute_distance_to_exit_node pdesc; Procdesc.compute_distance_to_exit_node pdesc;
Worklist.create () 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 = : Paths.PathSet.t =
try try
Hashtbl.find htable key 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 Paths.PathSet.empty
(** Add [d] to the pathset todo at [node] returning true if changed *) (** 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 = let changed =
if Paths.PathSet.is_empty d then false if Paths.PathSet.is_empty d then false
else 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_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 old_visited = htable_retrieve wl.Worklist.path_set_visited node_id in
let d' = Paths.PathSet.diff d old_visited in (* differential fixpoint *) 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 not (Paths.PathSet.equal old_todo todo_new) in
changed 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 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 let todo = Hashtbl.find wl.Worklist.path_set_todo node_id in
Hashtbl.replace wl.Worklist.path_set_todo node_id Paths.PathSet.empty; Hashtbl.replace wl.Worklist.path_set_todo node_id Paths.PathSet.empty;
let visited = Hashtbl.find wl.Worklist.path_set_visited node_id in 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; Hashtbl.replace wl.Worklist.path_set_visited node_id new_visited;
todo todo
with Not_found -> 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 assert false
(* =============== END of the edge_set object =============== *) (* =============== 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 *) (** propagate a set of results to the given node *)
let propagate 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 = let edgeset_todo =
(* prop must be a renamed prop by the invariant preserved by PropSet *) (* prop must be a renamed prop by the invariant preserved by PropSet *)
let f prop path edgeset_curr = let f prop path edgeset_curr =
@ -269,14 +269,14 @@ let propagate
(** propagate a set of results, including exceptions and divergence *) (** propagate a set of results, including exceptions and divergence *)
let propagate_nodes_divergence let propagate_nodes_divergence
tenv (pdesc: Cfg.Procdesc.t) (pset: Paths.PathSet.t) tenv (pdesc: Procdesc.t) (pset: Paths.PathSet.t)
(succ_nodes: Cfg.Node.t list) (exn_nodes: Cfg.Node.t list) (wl : Worklist.t) = (succ_nodes: Procdesc.Node.t list) (exn_nodes: Procdesc.Node.t list) (wl : Worklist.t) =
let pname = Cfg.Procdesc.get_proc_name pdesc in let pname = Procdesc.get_proc_name pdesc in
let pset_exn, pset_ok = Paths.PathSet.partition (Tabulation.prop_is_exn pname) pset 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 if !Config.footprint && not (Paths.PathSet.is_empty (State.get_diverging_states_node ())) then
begin begin
Errdesc.warning_err (State.get_loc ()) "Propagating Divergence@."; 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 diverging_states = State.get_diverging_states_node () in
let prop_incons = let prop_incons =
let mk_incons prop = let mk_incons prop =
@ -297,8 +297,8 @@ let propagate_nodes_divergence
(** Symbolic execution for a Join node *) (** Symbolic execution for a Join node *)
let do_symexec_join pname tenv wl curr_node (edgeset_todo : Paths.PathSet.t) = 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 curr_node_id = Procdesc.Node.get_id curr_node in
let succ_nodes = Cfg.Node.get_succs curr_node in let succ_nodes = Procdesc.Node.get_succs curr_node in
let new_dset = edgeset_todo in let new_dset = edgeset_todo in
let old_dset = Join_table.find wl.Worklist.join_table curr_node_id 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 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 exception RE_EXE_ERROR
let do_before_node pname source session node = 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_node node;
State.set_session session; State.set_session session;
L.reset_delayed_prints (); L.reset_delayed_prints ();
@ -360,10 +360,10 @@ let instrs_get_normal_vars instrs =
(* we exclude function calls: if (g(x,y)) ....*) (* we exclude function calls: if (g(x,y)) ....*)
(* we check that prune nodes have simple guards: a var or its negation*) (* we check that prune nodes have simple guards: a var or its negation*)
let check_assignement_guard pdesc node = 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 verbose = false in
let node_contains_call n = 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 let is_call = function
| Sil.Call _ -> true | Sil.Call _ -> true
| _ -> false in | _ -> false in
@ -385,13 +385,13 @@ let check_assignement_guard pdesc node =
| Exp.Lvar pv -> | Exp.Lvar pv ->
Pvar.is_frontend_tmp pv Pvar.is_frontend_tmp pv
| _ -> false in | _ -> false in
let succs = Cfg.Node.get_succs node in let succs = Procdesc.Node.get_succs node in
let l_node = Cfg.Node.get_last_loc 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: *) (* 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) *) (* n$1=*&e;Prune(n$1) or n$1=*&e;Prune(!n$1) *)
let is_prune_exp e = let is_prune_exp e =
let prune_var n = 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 pi = IList.filter is_prune_instr ins in
let leti = IList.filter is_load_instr ins in let leti = IList.filter is_load_instr ins in
match pi, leti with match pi, leti with
@ -406,10 +406,10 @@ let check_assignement_guard pdesc node =
| _ -> [] in | _ -> [] in
let prune_vars = IList.flatten(IList.map (fun n -> prune_var n) succs) 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 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 () = let succs_are_all_prune_nodes () =
IList.for_all (fun n -> match Cfg.Node.get_kind n with IList.for_all (fun n -> match Procdesc.Node.get_kind n with
| Cfg.Node.Prune_node(_) -> true | Procdesc.Node.Prune_node(_) -> true
| _ -> false) succs in | _ -> false) succs in
let succs_same_loc_as_node () = let succs_same_loc_as_node () =
if verbose then if verbose then
@ -428,13 +428,13 @@ let check_assignement_guard pdesc node =
| Sil.Prune _ -> false | Sil.Prune _ -> false
| _ -> true in | _ -> true in
let check_guard n = 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 IList.for_all check_guard succs in
if !Config.curr_language = Config.Clang && if !Config.curr_language = Config.Clang &&
succs_are_all_prune_nodes () && succs_are_all_prune_nodes () &&
succs_same_loc_as_node () && succs_same_loc_as_node () &&
succs_have_simple_guards () then 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 match succs_loc with
(* at this point all successors are at the same location, so we can take the first*) (* at this point all successors are at the same location, so we can take the first*)
| loc_succ:: _ -> | loc_succ:: _ ->
@ -461,12 +461,12 @@ let check_assignement_guard pdesc node =
(** Perform symbolic execution for a node starting from an initial prop *) (** Perform symbolic execution for a node starting from an initial prop *)
let do_symbolic_execution pdesc handle_exn tenv 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; State.mark_execution_start node;
(* build the const map lazily *) (* build the const map lazily *)
State.set_const_map (ConstantPropagation.build_const_map tenv pdesc); State.set_const_map (ConstantPropagation.build_const_map tenv pdesc);
check_assignement_guard pdesc node; 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 *) (* fresh normal vars must be fresh w.r.t. instructions *)
Ident.update_name_generator (instrs_get_normal_vars instrs); Ident.update_name_generator (instrs_get_normal_vars instrs);
let pset = let pset =
@ -478,7 +478,7 @@ let do_symbolic_execution pdesc handle_exn tenv
pset pset
let mark_visited summary node = 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 let stats = summary.Specs.stats in
if !Config.footprint if !Config.footprint
then then
@ -490,7 +490,7 @@ let add_taint_attrs tenv proc_name proc_desc prop =
match Taint.tainted_params proc_name with match Taint.tainted_params proc_name with
| [] -> prop | [] -> prop
| tainted_param_nums -> | 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' = let formal_params' =
IList.map (fun (p, _) -> Pvar.mk p proc_name) formal_params in IList.map (fun (p, _) -> Pvar.mk p proc_name) formal_params in
Taint.get_params_to_taint tainted_param_nums formal_params' 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 prop
let forward_tabulate tenv pdesc wl source = 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 = let handle_exn_node curr_node exn =
Exceptions.print_exception_html "Failure of symbolic execution: " exn; Exceptions.print_exception_html "Failure of symbolic execution: " exn;
let pre_opt = (* precondition leading to error, if any *) 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 () L.d_strln "Precondition:"; Prop.d_prop pre; L.d_ln ()
| None -> ()); | None -> ());
L.d_strln "SIL INSTR:"; 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; Reporting.log_error pname exn;
State.mark_instr_fail exn in State.mark_instr_fail exn in
@ -533,14 +533,14 @@ let forward_tabulate tenv pdesc wl source =
let timestamp = Specs.get_timestamp summary in let timestamp = Specs.get_timestamp summary in
F.sprintf "[%s:%d] %s" phase_string timestamp (Procname.to_string proc_name) in F.sprintf "[%s:%d] %s" phase_string timestamp (Procname.to_string proc_name) in
L.d_strln ("**** " ^ (log_string pname) ^ " " ^ 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 ^ ", " ^ "Procedure: " ^ Procname.to_string pname ^ ", " ^
"Session: " ^ string_of_int session ^ ", " ^ "Session: " ^ string_of_int session ^ ", " ^
"Todo: " ^ string_of_int (Paths.PathSet.size pathset_todo) ^ " ****"); "Todo: " ^ string_of_int (Paths.PathSet.size pathset_todo) ^ " ****");
L.d_increase_indent 1; L.d_increase_indent 1;
Propset.d Prop.prop_emp (Paths.PathSet.to_propset tenv pathset_todo); Propset.d Prop.prop_emp (Paths.PathSet.to_propset tenv pathset_todo);
L.d_strln ".... Instructions: .... "; 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 L.d_ln (); L.d_ln () in
let do_prop curr_node handle_exn prop_ path cnt num_paths = 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 (); State.reset_diverging_states_node ();
let pset = let pset =
do_symbolic_execution pdesc handle_exn tenv curr_node prop path in do_symbolic_execution pdesc handle_exn tenv curr_node prop path in
let succ_nodes = Cfg.Node.get_succs curr_node in let succ_nodes = Procdesc.Node.get_succs curr_node in
let exn_nodes = Cfg.Node.get_exn curr_node in let exn_nodes = Procdesc.Node.get_exn curr_node in
propagate_nodes_divergence tenv pdesc pset succ_nodes exn_nodes wl; propagate_nodes_divergence tenv pdesc pset succ_nodes exn_nodes wl;
L.d_decrease_indent 1; L.d_ln(); L.d_decrease_indent 1; L.d_ln();
with with
@ -568,14 +568,14 @@ let forward_tabulate tenv pdesc wl source =
check_prop_size pathset_todo; check_prop_size pathset_todo;
print_node_preamble curr_node session pathset_todo; print_node_preamble curr_node session pathset_todo;
match Cfg.Node.get_kind curr_node with match Procdesc.Node.get_kind curr_node with
| Cfg.Node.Join_node -> | Procdesc.Node.Join_node ->
do_symexec_join pname tenv wl curr_node pathset_todo do_symexec_join pname tenv wl curr_node pathset_todo
| Cfg.Node.Stmt_node _ | Procdesc.Node.Stmt_node _
| Cfg.Node.Prune_node _ | Procdesc.Node.Prune_node _
| Cfg.Node.Exit_node _ | Procdesc.Node.Exit_node _
| Cfg.Node.Skip_node _ | Procdesc.Node.Skip_node _
| Cfg.Node.Start_node _ -> | Procdesc.Node.Start_node _ ->
exe_iter (do_prop curr_node handle_exn) pathset_todo in exe_iter (do_prop curr_node handle_exn) pathset_todo in
let do_node_and_handle curr_node session = let do_node_and_handle curr_node session =
@ -690,10 +690,10 @@ let report_context_leaks pname sigma tenv =
(** Remove locals and formals, (** Remove locals and formals,
and check if the address of a stack variable is left in the result *) and check if the address of a stack variable is left in the result *)
let remove_locals_formals_and_check tenv pdesc p = 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 pvars, p' = PropUtil.remove_locals_formals tenv pdesc p in
let check_pvar pvar = 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 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 desc = Errdesc.explain_stack_variable_address_escape loc pvar dexp_opt in
let exn = Exceptions.Stack_variable_address_escape (desc, __POS__) 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. *) (** Collect the analysis results for the exit node. *)
let collect_analysis_result tenv wl pdesc : Paths.PathSet.t = let collect_analysis_result tenv wl pdesc : Paths.PathSet.t =
let exit_node = Cfg.Procdesc.get_exit_node pdesc in let exit_node = Procdesc.get_exit_node pdesc in
let exit_node_id = Cfg.Node.get_id exit_node 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 let pathset = htable_retrieve wl.Worklist.path_set_visited exit_node_id in
Paths.PathSet.map (remove_locals_formals_and_check tenv pdesc) pathset 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 = let vset_ref_add_path vset_ref path =
Paths.Path.iter_all_nodes_nocalls 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 path
let vset_ref_add_pathset vset_ref pathset = 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 compute_visited vset =
let res = ref Specs.Visitedset.empty in let res = ref Specs.Visitedset.empty in
let node_get_all_lines n = let node_get_all_lines n =
let node_loc = Cfg.Node.get_loc n in let node_loc = Procdesc.Node.get_loc n in
let instrs_loc = IList.map Sil.instr_get_loc (Cfg.Node.get_instrs 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 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 IList.remove_duplicates int_compare (IList.sort int_compare lines) in
let do_node n = let do_node n =
res := res :=
Specs.Visitedset.add (Cfg.Node.get_id n, node_get_all_lines n) !res in Specs.Visitedset.add (Procdesc.Node.get_id n, node_get_all_lines n) !res in
Cfg.NodeSet.iter do_node vset; Procdesc.NodeSet.iter do_node vset;
!res !res
(** Extract specs from a pathset *) (** Extract specs from a pathset *)
let extract_specs tenv pdesc pathset : Prop.normal Specs.spec list = 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 sub =
let fav = Sil.fav_new () in let fav = Sil.fav_new () in
Paths.PathSet.iter 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, post = Prop.extract_spec prop'' in
let pre' = Prop.normalize tenv (Prop.prop_sub sub pre) in let pre' = Prop.normalize tenv (Prop.prop_sub sub pre) in
if !Config.curr_language = 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; report_context_leaks pname post.Prop.sigma tenv;
let post' = let post' =
if Prover.check_inconsistency_base tenv prop then None if Prover.check_inconsistency_base tenv prop then None
else Some (Prop.normalize tenv (Prop.prop_sub sub post), path) in else Some (Prop.normalize tenv (Prop.prop_sub sub post), path) in
let visited = 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; vset_ref_add_path vset_ref path;
compute_visited !vset_ref in compute_visited !vset_ref in
(pre', post', visited) in (pre', post', visited) in
@ -794,7 +794,7 @@ let extract_specs tenv pdesc pathset : Prop.normal Specs.spec list =
!specs !specs
let collect_postconditions wl tenv pdesc : Paths.PathSet.t * Specs.Visitedset.t = 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 let pathset = collect_analysis_result tenv wl pdesc in
(* Assuming C++ developers use RAII, remove resources from the constructor posts *) (* 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 = collect_do_abstract_post pname tenv pathset in
let pathset_diverging = State.get_diverging_states_proc () in let pathset_diverging = State.get_diverging_states_proc () in
let visited = 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; vset_ref_add_pathset vset_ref pathset;
(* nodes from diverging states were also visited *) (* nodes from diverging states were also visited *)
vset_ref_add_pathset vset_ref pathset_diverging; 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 (** Construct an initial prop by extending [prop] with locals, and formals if [add_formals] is true
as well as seed variables *) as well as seed variables *)
let initial_prop 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 = : Prop.normal Prop.t =
let construct_decl (x, typ) = 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 = let new_formals =
if add_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 else [] (* no new formals added *) in
let prop1 = let prop1 =
Prop.prop_reset_inst 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. *) (** 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 let execute_filter_prop wl tenv pdesc init_node (precondition : Prop.normal Specs.Jprop.t) source
: Prop.normal Specs.spec option = : 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; do_before_node pname source 0 init_node;
L.d_strln ("#### Start: RE-execution for " ^ Procname.to_string pname ^ " ####"); L.d_strln ("#### Start: RE-execution for " ^ Procname.to_string pname ^ " ####");
L.d_indent 1; 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 pp_intra_stats wl proc_desc fmt _ =
let nstates = ref 0 in let nstates = ref 0 in
let nodes = Cfg.Procdesc.get_nodes proc_desc in let nodes = Procdesc.get_nodes proc_desc in
IList.iter IList.iter
(fun node -> (fun node ->
nstates := nstates :=
!nstates + !nstates +
Paths.PathSet.size 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; nodes;
F.fprintf fmt "(%d nodes containing %d states)" (IList.length nodes) !nstates 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. and [get_results ()] returns the results computed.
This function is architected so that [get_results ()] can be called even after This function is architected so that [get_results ()] can be called even after
[go ()] was interrupted by and exception. *) [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 = : exe_phase =
let summary = Specs.get_summary_unsafe "check_recursion_level" pname in 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 check_recursion_level () =
let recursion_level = Specs.get_timestamp summary in 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; Worklist.add wl start_node;
Config.arc_mode := Config.arc_mode :=
Hashtbl.mem Hashtbl.mem
(Cfg.Procdesc.get_flags pdesc) (Procdesc.get_flags pdesc)
Mleak_buckets.objc_arc_flag; Mleak_buckets.objc_arc_flag;
ignore (path_set_put_todo wl start_node init_edgeset); ignore (path_set_put_todo wl start_node init_edgeset);
forward_tabulate tenv pdesc wl source in 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 () re_execution ()
let set_current_language proc_desc = 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 Config.curr_language := language
(** reset global values before analysing a procedure *) (** 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. *) (** Analyze the procedure and return the resulting summary. *)
let analyze_proc source exe_env proc_desc : Specs.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 init_time = Unix.gettimeofday () in
let tenv = Exe_env.get_tenv exe_env proc_name in let tenv = Exe_env.get_tenv exe_env proc_name in
reset_global_values proc_desc; reset_global_values proc_desc;
@ -1373,7 +1373,7 @@ let perform_transition exe_env tenv proc_name source =
try try
match Exe_env.get_proc_desc exe_env proc_name with match Exe_env.get_proc_desc exe_env proc_name with
| Some pdesc -> | Some pdesc ->
let start_node = Cfg.Procdesc.get_start_node pdesc in let start_node = Procdesc.get_start_node pdesc in
f start_node f start_node
| None -> () | None -> ()
with exn when SymOp.exn_not_failure exn -> () in with exn when SymOp.exn_not_failure exn -> () in
@ -1411,7 +1411,7 @@ let interprocedural_algorithm exe_env : unit =
| Some proc_desc -> | Some proc_desc ->
let reactive_changed = let reactive_changed =
if Config.reactive_mode if Config.reactive_mode
then (Cfg.Procdesc.get_attributes proc_desc).ProcAttributes.changed then (Procdesc.get_attributes proc_desc).ProcAttributes.changed
else true in else true in
if if
reactive_changed && (* in reactive mode, only analyze changed procedures *) reactive_changed && (* in reactive mode, only analyze changed procedures *)
@ -1438,7 +1438,7 @@ let do_analysis exe_env =
let get_calls caller_pdesc = let get_calls caller_pdesc =
let calls = ref [] in let calls = ref [] in
let f (callee_pname, loc) = calls := (callee_pname, loc) :: !calls 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 IList.rev !calls in
let init_proc (pname, dep) = let init_proc (pname, dep) =
let pdesc = match Exe_env.get_proc_desc exe_env pname with let pdesc = match Exe_env.get_proc_desc exe_env pname with
@ -1446,12 +1446,12 @@ let do_analysis exe_env =
pdesc pdesc
| None -> | None ->
assert false in assert false in
let nodes = IList.map (fun n -> Cfg.Node.get_id n) (Cfg.Procdesc.get_nodes pdesc) in let nodes = IList.map (fun n -> Procdesc.Node.get_id n) (Procdesc.get_nodes pdesc) in
let proc_flags = Cfg.Procdesc.get_flags pdesc in let proc_flags = Procdesc.get_flags pdesc in
let static_err_log = Cfg.Procdesc.get_err_log pdesc in (* err log from translation *) let static_err_log = Procdesc.get_err_log pdesc in (* err log from translation *)
let calls = get_calls pdesc in let calls = get_calls pdesc in
let attributes = let attributes =
{ (Cfg.Procdesc.get_attributes pdesc) with { (Procdesc.get_attributes pdesc) with
ProcAttributes.err_log = static_err_log; } in ProcAttributes.err_log = static_err_log; } in
let proc_desc_option = let proc_desc_option =
if Config.dynamic_dispatch = `Lazy if Config.dynamic_dispatch = `Lazy
@ -1479,7 +1479,7 @@ let do_analysis exe_env =
(Specs.get_summary proc_name) (Specs.get_summary proc_name)
| None -> None in | None -> None in
let analyze_ondemand source proc_desc = 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 let tenv = Exe_env.get_tenv exe_env proc_name in
if not (Config.eradicate || Config.checkers) if not (Config.eradicate || Config.checkers)
then then
@ -1507,25 +1507,25 @@ let do_analysis exe_env =
let visited_and_total_nodes ~filter cfg = let visited_and_total_nodes ~filter cfg =
let filter_node pdesc n = let filter_node pdesc n =
Cfg.Procdesc.is_defined pdesc && Procdesc.is_defined pdesc &&
filter pdesc && filter pdesc &&
match Cfg.Node.get_kind n with match Procdesc.Node.get_kind n with
| Cfg.Node.Stmt_node _ | Cfg.Node.Prune_node _ | Procdesc.Node.Stmt_node _ | Procdesc.Node.Prune_node _
| Cfg.Node.Start_node _ | Cfg.Node.Exit_node _ -> true | Procdesc.Node.Start_node _ | Procdesc.Node.Exit_node _ -> true
| Cfg.Node.Skip_node _ | Cfg.Node.Join_node -> false in | Procdesc.Node.Skip_node _ | Procdesc.Node.Join_node -> false in
let counted_nodes, visited_nodes_re = let counted_nodes, visited_nodes_re =
let set = ref Cfg.NodeSet.empty in let set = ref Procdesc.NodeSet.empty in
let set_visited_re = ref Cfg.NodeSet.empty in let set_visited_re = ref Procdesc.NodeSet.empty in
let add pdesc n = let add pdesc n =
if filter_node pdesc n then if filter_node pdesc n then
begin begin
set := Cfg.NodeSet.add n !set; set := Procdesc.NodeSet.add n !set;
if snd (Printer.node_is_visited (Cfg.Procdesc.get_proc_name pdesc) n) if snd (Printer.node_is_visited (Procdesc.get_proc_name pdesc) n)
then set_visited_re := Cfg.NodeSet.add n !set_visited_re then set_visited_re := Procdesc.NodeSet.add n !set_visited_re
end in end in
Cfg.iter_all_nodes add cfg; Cfg.iter_all_nodes add cfg;
!set, !set_visited_re in !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. (** Print the stats for the given cfg.
Consider every defined proc unless a proc with the same name 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 print_stats_cfg proc_shadowed source cfg =
let err_table = Errlog.create_err_table () in let err_table = Errlog.create_err_table () in
let filter pdesc = 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 Specs.summary_exists pname && Specs.get_specs pname != [] in
let nodes_visited, nodes_total = visited_and_total_nodes ~filter cfg in let nodes_visited, nodes_total = visited_and_total_nodes ~filter cfg in
let num_proc = ref 0 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 tot_symops = ref 0 in
let num_timeout = ref 0 in let num_timeout = ref 0 in
let compute_stats_proc proc_desc = 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 || if proc_shadowed proc_desc ||
Specs.get_summary proc_name = None then Specs.get_summary proc_name = None then
L.out "print_stats: ignoring function %a which is also defined in another file@." 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 -> (fun source cfg ->
let proc_shadowed proc_desc = let proc_shadowed proc_desc =
(* return true if a proc with the same name in another module was analyzed instead *) (* 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 Exe_env.get_source exe_env proc_name <> Some source in
print_stats_cfg proc_shadowed source cfg) print_stats_cfg proc_shadowed source cfg)
exe_env exe_env

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

@ -32,9 +32,9 @@ let read_dirs_to_analyze () =
let dirs_to_analyze = let dirs_to_analyze =
lazy (read_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 = 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 run_proc_analysis tenv ~propagate_exceptions analyze_proc curr_pdesc callee_pdesc =
let curr_pname = Cfg.Procdesc.get_proc_name curr_pdesc in let curr_pname = Procdesc.get_proc_name curr_pdesc in
let callee_pname = Cfg.Procdesc.get_proc_name callee_pdesc in let callee_pname = Procdesc.get_proc_name callee_pdesc in
(* Dot means start of a procedure *) (* Dot means start of a procedure *)
L.log_progress_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 analyze_proc_desc tenv ~propagate_exceptions curr_pdesc callee_pdesc =
let callee_pname = Cfg.Procdesc.get_proc_name callee_pdesc in let callee_pname = Procdesc.get_proc_name callee_pdesc in
let proc_attributes = Cfg.Procdesc.get_attributes callee_pdesc in let proc_attributes = Procdesc.get_attributes callee_pdesc in
match !callbacks_ref with match !callbacks_ref with
| Some callbacks | Some callbacks
when should_be_analyzed proc_attributes callee_pname -> 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. *) (** Optional set of source dirs to analyze in on-demand mode. *)
val dirs_to_analyze : StringSet.t option Lazy.t 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 = type callbacks =
{ {
@ -30,12 +30,12 @@ val get_proc_desc : get_proc_desc
(** analyze_proc_desc curr_pdesc callee_pdesc (** analyze_proc_desc curr_pdesc callee_pdesc
performs an on-demand analysis of callee_pdesc performs an on-demand analysis of callee_pdesc
triggered during the analysis of curr_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 (** analyze_proc_name curr_pdesc proc_name
performs an on-demand analysis of proc_name performs an on-demand analysis of proc_name
triggered during the analysis of curr_pdesc. *) 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. *) (** Check if the procedure called needs to be analyzed. *)
val procedure_should_be_analyzed : Procname.t -> bool 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 val create_loc_trace : t -> PredSymb.path_pos option -> Errlog.loc_trace
(** return the current node of the path *) (** 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 *) (** dump a path *)
val d : t -> unit val d : t -> unit
@ -45,13 +45,13 @@ module Path : sig
val d_stats : t -> unit val d_stats : t -> unit
(** extend a path with a new node reached from the given session, with an optional string for exceptions *) (** 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 *) (** extend a path with a new node reached from the given session, with an optional string for exceptions *)
val add_description : t -> string -> t val add_description : t -> string -> t
(** iterate over each node in the path, excluding calls, once *) (** 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 : val iter_shortest_sequence :
(int -> t -> int -> Typename.t option -> unit) -> PredSymb.path_pos option -> t -> unit (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 val pp_stats : Format.formatter -> t -> unit
(** create a new path with given start node *) (** create a new path with given start node *)
val start : Cfg.Node.t -> t val start : Procdesc.Node.t -> t
(* (*
(** equality for paths *) (** equality for paths *)
@ -83,8 +83,8 @@ end = struct
type path = type path =
(* INVARIANT: stats are always set to dummy_stats unless we are in the middle of a traversal *) (* 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 *) (* in particular: a new traversal cannot be initiated during an existing traversal *)
| Pstart of Cfg.Node.t * stats (** start node *) | Pstart of Procdesc.Node.t * stats (** start node *)
| Pnode of Cfg.Node.t * Typename.t option * session * path * stats * string option | 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], (** we got to [node] from last [session] perhaps propagating exception [exn_opt],
and continue with [path]. *) and continue with [path]. *)
| Pjoin of path * path * stats (** join of two paths *) | Pjoin of path * path * stats (** join of two paths *)
@ -133,11 +133,11 @@ end = struct
let rec compare p1 p2 : int = let rec compare p1 p2 : int =
if p1 == p2 then 0 else match p1, p2 with if p1 == p2 then 0 else match p1, p2 with
| Pstart (n1, _), Pstart (n2, _) -> | Pstart (n1, _), Pstart (n2, _) ->
Cfg.Node.compare n1 n2 Procdesc.Node.compare n1 n2
| Pstart _, _ -> - 1 | Pstart _, _ -> - 1
| _, Pstart _ -> 1 | _, Pstart _ -> 1
| Pnode (n1, eo1, s1, p1, _, _), Pnode (n2, eo2, s2, p2, _, _) -> | 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 = 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 let n = int_compare s1 s2 in
if n <> 0 then n else compare p1 p2 if n <> 0 then n else compare p1 p2
@ -154,7 +154,7 @@ end = struct
let start node = Pstart (node, get_dummy_stats ()) 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) Pnode (node, exn_opt, session, path, get_dummy_stats (), None)
let join p1 p2 = let join p1 p2 =
@ -212,7 +212,7 @@ end = struct
satisfying [f] was found. Assumes that the invariant holds beforehand, and ensures that all 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 the stats are computed afterwards. Since this breaks the invariant, it must be followed by
reset_stats. *) 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 let nodes_found stats = stats.max_length > 0 in
function function
| Pstart (node, stats) -> | Pstart (node, stats) ->
@ -268,8 +268,8 @@ end = struct
Invariant.reset_stats path Invariant.reset_stats path
let get_path_pos node = let get_path_pos node =
let pn = Cfg.Node.get_proc_name node in let pn = Procdesc.Node.get_proc_name node in
let n_id = Cfg.Node.get_id node in let n_id = Procdesc.Node.get_id node in
(pn, (n_id :> int)) (pn, (n_id :> int))
let contains_position path pos = let contains_position path pos =
@ -287,7 +287,7 @@ end = struct
pass the exception information to [f] on the previous node *) pass the exception information to [f] on the previous node *)
let iter_shortest_sequence_filter let iter_shortest_sequence_filter
(f : int -> t -> int -> Typename.t option -> unit) (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 let rec doit level session path prev_exn_opt = match path with
| Pstart _ -> f level path session prev_exn_opt | Pstart _ -> f level path session prev_exn_opt
| Pnode (_, exn_opt, session', p, _, _) -> | Pnode (_, exn_opt, session', p, _, _) ->
@ -347,26 +347,26 @@ end = struct
(fun (level, p, session, exn_opt) -> f level p session exn_opt) (fun (level, p, session, exn_opt) -> f level p session exn_opt)
sequence_up_to_last_seen 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 *) (** return the node visited most, and number of visits, in the shortest linear sequence *)
let repetitions path = let repetitions path =
let map = ref NodeMap.empty in let map = ref Procdesc.NodeMap.empty in
let add_node = function let add_node = function
| Some node -> | Some node ->
begin begin
try try
let n = NodeMap.find node !map in let n = Procdesc.NodeMap.find node !map in
map := NodeMap.add node (n + 1) !map map := Procdesc.NodeMap.add node (n + 1) !map
with Not_found -> with Not_found ->
map := NodeMap.add node 1 !map map := Procdesc.NodeMap.add node 1 !map
end end
| None -> | None ->
() in () in
iter_shortest_sequence (fun _ p _ _ -> add_node (curr_node p)) None path; 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 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) (!max_rep_node, !max_rep_num)
let stats_string path = let stats_string path =
@ -376,7 +376,7 @@ end = struct
"linear paths: " ^ string_of_float (Invariant.get_stats path).linear_num ^ "linear paths: " ^ string_of_float (Invariant.get_stats path).linear_num ^
" max length: " ^ string_of_int (Invariant.get_stats path).max_length ^ " max length: " ^ string_of_int (Invariant.get_stats path).max_length ^
" has repetitions: " ^ string_of_int repetitions ^ " 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; Invariant.reset_stats path;
str str
@ -418,9 +418,9 @@ end = struct
with Not_found -> with Not_found ->
match path with match path with
| Pstart (node, _) -> | Pstart (node, _) ->
F.fprintf fmt "n%a" Cfg.Node.pp node F.fprintf fmt "n%a" Procdesc.Node.pp node
| Pnode (node, _, session, path, _, _) -> | 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, _) -> | Pjoin (path1, path2, _) ->
F.fprintf fmt "(%a + %a)" (doit (n - 1)) path1 (doit (n - 1)) path2 F.fprintf fmt "(%a + %a)" (doit (n - 1)) path1 (doit (n - 1)) path2
| Pcall (path1, _, path2, _) -> | Pcall (path1, _, path2, _) ->
@ -454,10 +454,10 @@ end = struct
match curr_node path with match curr_node path with
| Some curr_node -> | Some curr_node ->
begin begin
let curr_loc = Cfg.Node.get_loc curr_node in let curr_loc = Procdesc.Node.get_loc curr_node in
match Cfg.Node.get_kind curr_node with match Procdesc.Node.get_kind curr_node with
| Cfg.Node.Join_node -> () (* omit join nodes from error traces *) | Procdesc.Node.Join_node -> () (* omit join nodes from error traces *)
| Cfg.Node.Start_node pname -> | Procdesc.Node.Start_node pname ->
let name = Procname.to_string pname in let name = Procname.to_string pname in
let name_id = Procname.to_filename pname in let name_id = Procname.to_filename pname in
let descr = "start of procedure " ^ (Procname.to_simplified_string 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, name);
(Io_infer.Xml.tag_name_id, name_id)] in (Io_infer.Xml.tag_name_id, name_id)] in
trace := mk_trace_elem level curr_loc descr node_tags :: !trace 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 let descr = match is_true_branch, if_kind with
| true, Sil.Ik_if -> "Taking true branch" | true, Sil.Ik_if -> "Taking true branch"
| false, Sil.Ik_if -> "Taking false branch" | false, Sil.Ik_if -> "Taking false branch"
@ -482,7 +482,7 @@ end = struct
[(Io_infer.Xml.tag_kind,"condition"); [(Io_infer.Xml.tag_kind,"condition");
(Io_infer.Xml.tag_branch, if is_true_branch then "true" else "false")] in (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 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 descr = "return from a call to " ^ (Procname.to_string pname) in
let name = Procname.to_string pname in let name = Procname.to_string pname in
let name_id = Procname.to_filename 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) *) (** check if the nodes in path p1 are a subset of those in p2 (not trace subset) *)
let path_nodes_subset p1 p2 = let path_nodes_subset p1 p2 =
let get_nodes p = let get_nodes p =
let s = ref Cfg.NodeSet.empty in let s = ref Procdesc.NodeSet.empty in
Path.iter_all_nodes_nocalls (fun n -> s := Cfg.NodeSet.add n !s) p; Path.iter_all_nodes_nocalls (fun n -> s := Procdesc.NodeSet.add n !s) p;
!s in !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 *) (** difference between pathsets for the differential fixpoint *)
let diff (ps1: t) (ps2: t) : t = 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 val create_loc_trace : t -> PredSymb.path_pos option -> Errlog.loc_trace
(** return the current node of the path *) (** 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 *) (** dump a path *)
val d : t -> unit val d : t -> unit
@ -40,12 +40,12 @@ module Path : sig
val d_stats : t -> unit val d_stats : t -> unit
(** extend a path with a new node reached from the given session, with an optional string for exceptions *) (** 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 val add_description : t -> string -> t
(** iterate over each node in the path, excluding calls, once *) (** 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, (** iterate over the shortest sequence belonging to the path,
restricting to those containing the given position if given. restricting to those containing the given position if given.
@ -65,7 +65,7 @@ module Path : sig
val pp_stats : Format.formatter -> t -> unit val pp_stats : Format.formatter -> t -> unit
(** create a new path with given start node *) (** create a new path with given start node *)
val start : Cfg.Node.t -> t val start : Procdesc.Node.t -> t
end end
(** Set of (prop,path) pairs, where the identity is given by prop *) (** 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 -> instr in | 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 if has_dispatch_call instrs then
IList.map replace_dispatch_calls instrs IList.map replace_dispatch_calls instrs
|> Cfg.Node.replace_instrs node in |> Procdesc.Node.replace_instrs node in
let pname = Cfg.Procdesc.get_proc_name pdesc in let pname = Procdesc.get_proc_name pdesc in
if Procname.is_java pname then 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 *) (** add instructions to perform abstraction *)
let add_abstraction_instructions pdesc = 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 *) (* 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 converging_node node =
let is_exit node = match Node.get_kind node with let is_exit node = match Node.get_kind node with
@ -88,7 +88,7 @@ let add_abstraction_instructions pdesc =
let do_node node = let do_node node =
let loc = Node.get_last_loc node in let loc = Node.get_last_loc node in
if node_requires_abstraction node then Node.append_instrs node [Sil.Abstract loc] 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)) 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 let instr_nodes' = IList.filter_changed is_used_store instr_nodes in
if instr_nodes' != instr_nodes if instr_nodes' != instr_nodes
then then
Cfg.Node.replace_instrs node (IList.rev_map fst instr_nodes') in Procdesc.Node.replace_instrs node (IList.rev_map fst instr_nodes') in
Cfg.Procdesc.iter_nodes node_remove_dead_stores pdesc Procdesc.iter_nodes node_remove_dead_stores pdesc
let add_nullify_instrs pdesc tenv liveness_inv_map = let add_nullify_instrs pdesc tenv liveness_inv_map =
let address_taken_vars = 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 *) then AddressTaken.Domain.empty (* can't take the address of a variable in Java *)
else else
match AddressTaken.Analyzer.compute_post (ProcData.make_default pdesc tenv) with 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 not (Pvar.is_return pvar || Pvar.is_global pvar) in
let node_add_nullify_instructions node pvars = 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 = let nullify_instrs =
IList.filter is_local pvars IList.filter is_local pvars
|> IList.map (fun pvar -> Sil.Nullify (pvar, loc)) in |> IList.map (fun pvar -> Sil.Nullify (pvar, loc)) in
if nullify_instrs <> [] 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 = let node_add_removetmps_instructions node ids =
if ids <> [] then if ids <> [] then
let loc = Cfg.Node.get_last_loc node in let loc = Procdesc.Node.get_last_loc node in
Cfg.Node.append_instrs node [Sil.Remove_temps (IList.rev ids, loc)] in Procdesc.Node.append_instrs node [Sil.Remove_temps (IList.rev ids, loc)] in
IList.iter IList.iter
(fun node -> (fun node ->
@ -282,18 +282,18 @@ let do_copy_propagation pdesc tenv =
(fun node -> (fun node ->
let instrs, changed = rev_transform_node_instrs node in let instrs, changed = rev_transform_node_instrs node in
if changed if changed
then Cfg.Node.replace_instrs node (IList.rev instrs)) then Procdesc.Node.replace_instrs node (IList.rev instrs))
(Cfg.Procdesc.get_nodes pdesc) (Procdesc.get_nodes pdesc)
let do_liveness pdesc tenv = let do_liveness pdesc tenv =
let liveness_proc_cfg = BackwardCfg.from_pdesc pdesc in let liveness_proc_cfg = BackwardCfg.from_pdesc pdesc in
LivenessAnalysis.exec_cfg liveness_proc_cfg (ProcData.make_default pdesc tenv) LivenessAnalysis.exec_cfg liveness_proc_cfg (ProcData.make_default pdesc tenv)
let doit ?(handle_dynamic_dispatch= (Config.dynamic_dispatch = `Sound)) pdesc cg 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 then
begin begin
Cfg.Procdesc.signal_did_preanalysis pdesc; Procdesc.signal_did_preanalysis pdesc;
if Config.copy_propagation then do_copy_propagation pdesc tenv; if Config.copy_propagation then do_copy_propagation pdesc tenv;
let liveness_inv_map = do_liveness pdesc tenv in let liveness_inv_map = do_liveness pdesc tenv in
if Config.dynamic_dispatch <> `Lazy && Config.copy_propagation 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 *) (** Preanalysis for eliminating dead local variables *)
(** Perform liveness analysis *) (** 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 -> | Some summary ->
let stats = summary.Specs.stats in let stats = summary.Specs.stats in
let is_visited_fp = 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 = 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 is_visited_fp, is_visited_re
(** Return true if the node was visited during analysis *) (** 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 *) when starting and finishing the processing of a node *)
module NodesHtml : sig module NodesHtml : sig
val start_node : 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 DB.source_file -> bool
val finish_node : Procname.t -> int -> DB.source_file -> unit val finish_node : Procname.t -> int -> DB.source_file -> unit
end = struct end = struct
@ -131,38 +132,38 @@ end = struct
IList.iter (fun node -> IList.iter (fun node ->
Io_infer.Html.pp_node_link Io_infer.Html.pp_node_link
[".."] [".."]
(Cfg.Node.get_proc_name node) (Procdesc.Node.get_proc_name node)
~description:"" ~description:""
~preds:(IList.map Cfg.Node.get_id (Cfg.Node.get_preds node) :> int list) ~preds:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_preds node) :> int list)
~succs:(IList.map Cfg.Node.get_id (Cfg.Node.get_succs node) :> int list) ~succs:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_succs node) :> int list)
~exn:(IList.map Cfg.Node.get_id (Cfg.Node.get_exn node) :> int list) ~exn:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_exn node) :> int list)
~isvisited:(is_visited proc_name node) ~isvisited:(is_visited proc_name node)
~isproof:false ~isproof:false
fmt (Cfg.Node.get_id node :> int)) preds; fmt (Procdesc.Node.get_id node :> int)) preds;
F.fprintf fmt "<br>SUCCS: @\n"; F.fprintf fmt "<br>SUCCS: @\n";
IList.iter (fun node -> IList.iter (fun node ->
Io_infer.Html.pp_node_link Io_infer.Html.pp_node_link
[".."] [".."]
(Cfg.Node.get_proc_name node) (Procdesc.Node.get_proc_name node)
~description:"" ~description:""
~preds:(IList.map Cfg.Node.get_id (Cfg.Node.get_preds node) :> int list) ~preds:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_preds node) :> int list)
~succs:(IList.map Cfg.Node.get_id (Cfg.Node.get_succs node) :> int list) ~succs:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_succs node) :> int list)
~exn:(IList.map Cfg.Node.get_id (Cfg.Node.get_exn node) :> int list) ~exn:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_exn node) :> int list)
~isvisited:(is_visited proc_name node) ~isvisited:(is_visited proc_name node)
~isproof:false ~isproof:false
fmt (Cfg.Node.get_id node :> int)) succs; fmt (Procdesc.Node.get_id node :> int)) succs;
F.fprintf fmt "<br>EXN: @\n"; F.fprintf fmt "<br>EXN: @\n";
IList.iter (fun node -> IList.iter (fun node ->
Io_infer.Html.pp_node_link Io_infer.Html.pp_node_link
[".."] [".."]
(Cfg.Node.get_proc_name node) (Procdesc.Node.get_proc_name node)
~description:"" ~description:""
~preds:(IList.map Cfg.Node.get_id (Cfg.Node.get_preds node) :> int list) ~preds:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_preds node) :> int list)
~succs:(IList.map Cfg.Node.get_id (Cfg.Node.get_succs node) :> int list) ~succs:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_succs node) :> int list)
~exn:(IList.map Cfg.Node.get_id (Cfg.Node.get_exn node) :> int list) ~exn:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_exn node) :> int list)
~isvisited:(is_visited proc_name node) ~isvisited:(is_visited proc_name node)
~isproof:false ~isproof:false
fmt (Cfg.Node.get_id node :> int)) exns; fmt (Procdesc.Node.get_id node :> int)) exns;
F.fprintf fmt "<br>@\n"; F.fprintf fmt "<br>@\n";
F.pp_print_flush fmt (); F.pp_print_flush fmt ();
true true
@ -237,16 +238,16 @@ let force_delayed_print fmt =
let (loc: Location.t) = Obj.obj loc in let (loc: Location.t) = Obj.obj loc in
Location.pp fmt loc Location.pp fmt loc
| (L.PTnode_instrs, b_n) -> | (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 if Config.write_html
then then
F.fprintf fmt "%a%a%a" F.fprintf fmt "%a%a%a"
Io_infer.Html.pp_start_color Green 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 () Io_infer.Html.pp_end_color ()
else else
F.fprintf fmt "%a" 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) -> | (L.PToff, off) ->
let (off: Sil.offset) = Obj.obj off in let (off: Sil.offset) = Obj.obj off in
Sil.pp_offset pe_default fmt off 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 *) (** 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 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 (if NodesHtml.start_node
(node_id :> int) loc proc_name (node_id :> int) loc proc_name
(Cfg.Node.get_preds node) (Procdesc.Node.get_preds node)
(Cfg.Node.get_succs node) (Procdesc.Node.get_succs node)
(Cfg.Node.get_exn node) (Procdesc.Node.get_exn node)
source source
then then
F.fprintf !curr_html_formatter "%a<LISTING>%a</LISTING>%a" F.fprintf !curr_html_formatter "%a<LISTING>%a</LISTING>%a"
Io_infer.Html.pp_start_color Green 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 ()); Io_infer.Html.pp_end_color ());
F.fprintf !curr_html_formatter "%a%a" F.fprintf !curr_html_formatter "%a%a"
Io_infer.Html.pp_hline () Io_infer.Html.pp_hline ()
@ -406,7 +407,10 @@ let node_finish_session node source =
if Config.write_html then begin if Config.write_html then begin
F.fprintf !curr_html_formatter "</LISTING>%a" F.fprintf !curr_html_formatter "</LISTING>%a"
Io_infer.Html.pp_end_color (); 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 end
(** Write html file for the procedure. (** Write html file for the procedure.
@ -414,9 +418,9 @@ let node_finish_session node source =
let write_proc_html source whole_seconds pdesc = let write_proc_html source whole_seconds pdesc =
if Config.write_html then if Config.write_html then
begin begin
let pname = Cfg.Procdesc.get_proc_name pdesc in let pname = Procdesc.get_proc_name pdesc in
let nodes = IList.sort Cfg.Node.compare (Cfg.Procdesc.get_nodes pdesc) in let nodes = IList.sort Procdesc.Node.compare (Procdesc.get_nodes pdesc) in
let linenum = (Cfg.Node.get_loc (IList.hd nodes)).Location.line in let linenum = (Procdesc.Node.get_loc (IList.hd nodes)).Location.line in
let fd, fmt = let fd, fmt =
Io_infer.Html.create Io_infer.Html.create
(DB.Results_dir.Abs_source_dir source) (DB.Results_dir.Abs_source_dir source)
@ -430,14 +434,14 @@ let write_proc_html source whole_seconds pdesc =
(fun n -> (fun n ->
Io_infer.Html.pp_node_link Io_infer.Html.pp_node_link
[] []
(Cfg.Node.get_proc_name n) (Procdesc.Node.get_proc_name n)
~description:(Cfg.Node.get_description (pe_html Black) n) ~description:(Procdesc.Node.get_description (pe_html Black) n)
~preds:(IList.map Cfg.Node.get_id (Cfg.Node.get_preds n) :> int list) ~preds:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_preds n) :> int list)
~succs:(IList.map Cfg.Node.get_id (Cfg.Node.get_succs n) :> int list) ~succs:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_succs n) :> int list)
~exn:(IList.map Cfg.Node.get_id (Cfg.Node.get_exn n) :> int list) ~exn:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_exn n) :> int list)
~isvisited:(is_visited pname n) ~isvisited:(is_visited pname n)
~isproof:false ~isproof:false
fmt (Cfg.Node.get_id n :> int)) fmt (Procdesc.Node.get_id n :> int))
nodes; nodes;
(match Specs.get_summary pname with (match Specs.get_summary pname with
| None -> | None ->
@ -468,24 +472,24 @@ let create_err_message err_string =
"\n<div class=\"msg\" style=\"margin-left:9ex\">" ^ err_string ^ "</div>" "\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 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 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 = let curr_nodes =
try Hashtbl.find table_nodes_at_linenum lnum try Hashtbl.find table_nodes_at_linenum lnum
with Not_found -> [] in with Not_found -> [] in
Hashtbl.replace table_nodes_at_linenum lnum ((n, proc_desc) :: curr_nodes) 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 = let process_proc =
Cfg.Procdesc.is_defined proc_desc && Procdesc.is_defined proc_desc &&
DB.source_file_equal proc_loc.Location.file source && DB.source_file_equal proc_loc.Location.file source &&
match AttributesTable.find_file_capturing_procedure proc_name with match AttributesTable.find_file_capturing_procedure proc_name with
| None -> true | None -> true
| Some (source_captured, _) -> | 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 if process_proc then
begin 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 match Specs.get_summary proc_name with
| None -> | None ->
() ()
@ -539,22 +543,22 @@ let write_html_file linereader filename procs =
IList.iter IList.iter
(fun (n, pdesc) -> (fun (n, pdesc) ->
let isproof = 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 Io_infer.Html.pp_node_link
[fname_encoding] [fname_encoding]
(Cfg.Node.get_proc_name n) (Procdesc.Node.get_proc_name n)
~description:(Cfg.Node.get_description (pe_html Black) n) ~description:(Procdesc.Node.get_description (pe_html Black) n)
~preds:(IList.map Cfg.Node.get_id (Cfg.Node.get_preds n) :> int list) ~preds:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_preds n) :> int list)
~succs:(IList.map Cfg.Node.get_id (Cfg.Node.get_succs n) :> int list) ~succs:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_succs n) :> int list)
~exn:(IList.map Cfg.Node.get_id (Cfg.Node.get_exn n) :> int list) ~exn:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_exn n) :> int list)
~isvisited:(is_visited (Cfg.Procdesc.get_proc_name pdesc) n) ~isvisited:(is_visited (Procdesc.get_proc_name pdesc) n)
~isproof ~isproof
fmt (Cfg.Node.get_id n :> int)) fmt (Procdesc.Node.get_id n :> int))
nodes_at_linenum; nodes_at_linenum;
IList.iter IList.iter
(fun (n, _) -> (fun (n, _) ->
match Cfg.Node.get_kind n with match Procdesc.Node.get_kind n with
| Cfg.Node.Start_node proc_name -> | Procdesc.Node.Start_node proc_name ->
let num_specs = IList.length (Specs.get_specs proc_name) in let num_specs = IList.length (Specs.get_specs proc_name) in
let label = let label =
(Escape.escape_xml (Procname.to_string proc_name)) ^ (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 let files = ref DB.SourceFileSet.empty in
Cfg.iter_proc_desc cfg Cfg.iter_proc_desc cfg
(fun _ proc_desc -> (fun _ proc_desc ->
if Cfg.Procdesc.is_defined proc_desc if Procdesc.is_defined proc_desc
then 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 := DB.SourceFileSet.add file !files);
!files in !files in
DB.SourceFileSet.iter 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 val force_delayed_prints : unit -> unit
(** Finish a session, and perform delayed print actions if required *) (** 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 *) (** 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 *) (** 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. (** Write html file for the procedure.
The boolean indicates whether to print whole seconds only. *) 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. *) (** Create filename.ext.html for each file in the exe_env. *)
val write_all_html_files : Exe_env.t -> unit 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 | None -> false
| Some (_, _, pdesc) -> | Some (_, _, pdesc) ->
let procedure_attr = let procedure_attr =
Cfg.Procdesc.get_attributes pdesc in Procdesc.get_attributes pdesc in
let is_java_this pvar = let is_java_this pvar =
procedure_attr.ProcAttributes.language = Config.Java && Pvar.is_this pvar in procedure_attr.ProcAttributes.language = Config.Java && Pvar.is_this pvar in
let is_objc_instance_self pvar = 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. *) expressing the safety conditions for the access. Complain if these conditions cannot be met. *)
let add_guarded_by_constraints tenv prop lexp pdesc = let add_guarded_by_constraints tenv prop lexp pdesc =
let lookup = Tenv.lookup tenv in 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 = let excluded_guardedby_string str =
(* nothing with a space in it can be a valid Java expression, shouldn't warn *) (* nothing with a space in it can be a valid Java expression, shouldn't warn *)
let is_invalid_exp_str str = 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] *) (* return true if [pdesc] has an annotation that matches [guarded_by_str] *)
let proc_has_matching_annot pdesc guarded_by_str = let proc_has_matching_annot pdesc guarded_by_str =
let proc_signature = 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 let proc_annot, _ = proc_signature.Annotations.ret in
match extract_guarded_by_str proc_annot with match extract_guarded_by_str proc_annot with
| Some proc_guarded_by_str -> | Some proc_guarded_by_str ->
@ -738,7 +738,7 @@ let add_guarded_by_constraints tenv prop lexp pdesc =
| None -> false in | None -> false in
let is_synchronized_on_class guarded_by_str = let is_synchronized_on_class guarded_by_str =
guarded_by_str_is_current_class guarded_by_str pname && 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 warn accessed_fld guarded_by_str =
let loc = State.get_loc () in let loc = State.get_loc () in
let err_desc = let err_desc =
@ -755,9 +755,9 @@ let add_guarded_by_constraints tenv prop lexp pdesc =
let has_lock guarded_by_exp = let has_lock guarded_by_exp =
(* procedure is synchronized and guarded by this *) (* procedure is synchronized and guarded by this *)
(guarded_by_str_is_current_class_this guarded_by_str pname && (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 && (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 *) (* or the prop says we already have the lock *)
IList.exists IList.exists
(function (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 string_is_suffix guarded_by_str (Ident.fieldname_to_string accessed_fld) in
let proc_has_suppress_guarded_by_annot pdesc = let proc_has_suppress_guarded_by_annot pdesc =
let proc_signature = 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 let proc_annot, _ = proc_signature.Annotations.ret in
match extract_suppress_warnings_str proc_annot with match extract_suppress_warnings_str proc_annot with
| Some suppression_str-> | Some suppression_str->
@ -795,9 +795,9 @@ let add_guarded_by_constraints tenv prop lexp pdesc =
flds flds
| _ -> false) | _ -> false)
prop.Prop.sigma in 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 (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 (is_accessible_through_local_ref lexp) &&
not guardedby_is_self_referential && not guardedby_is_self_referential &&
not (proc_has_suppress_guarded_by_annot pdesc) not (proc_has_suppress_guarded_by_annot pdesc)
@ -1214,7 +1214,7 @@ let rec iter_rearrange
res res
let is_weak_captured_var pdesc pvar = 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 match pname with
| Block _ -> | Block _ ->
let is_weak_captured (var, typ) = let is_weak_captured (var, typ) =
@ -1222,7 +1222,7 @@ let is_weak_captured_var pdesc pvar =
| Typ.Tptr (_, Pk_objc_weak) -> | Typ.Tptr (_, Pk_objc_weak) ->
Mangled.equal (Pvar.get_name pvar) var Mangled.equal (Pvar.get_name pvar) var
| _ -> false in | _ -> false in
IList.exists is_weak_captured (Cfg.Procdesc.get_captured pdesc) IList.exists is_weak_captured (Procdesc.get_captured pdesc)
| _ -> false | _ -> false
@ -1363,7 +1363,7 @@ let check_call_to_objc_block_error tenv pdesc prop fun_exp loc =
match get_exp_called () with match get_exp_called () with
| Some (_, Exp.Lvar pvar) -> (* pvar is the block *) | Some (_, Exp.Lvar pvar) -> (* pvar is the block *)
let name = Pvar.get_name pvar in 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 | _ -> false in
let is_field_deref () = (*Called expression is a field *) let is_field_deref () = (*Called expression is a field *)
match get_exp_called () with 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 "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 (); 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 ()); 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' = let prop' =
if Config.csl_analysis && !Config.footprint && Procname.is_java pname && if Config.csl_analysis && !Config.footprint && Procname.is_java pname &&
not (Procname.is_constructor pname || Procname.is_class_initializer 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 *) (** Check for dereference errors: dereferencing 0, a freed value, or an undefined value *)
val check_dereference_error : 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. (** 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 *) It's used to check that we don't call possibly null blocks *)
val check_call_to_objc_block_error : 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]. (** [rearrange lexp prop] rearranges [prop] into the form [prop' * lexp|->strexp:typ].
It returns an iterator with [lexp |-> strexp: typ] as current predicate It returns an iterator with [lexp |-> strexp: typ] as current predicate
and the path (an [offsetlist]) which leads to [lexp] as the iterator state. *) and the path (an [offsetlist]) which leads to [lexp] as the iterator state. *)
val rearrange : 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 -> Typ.t -> Prop.normal Prop.t ->
Location.t -> (Sil.offset list) Prop.prop_iter list 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 = module Visitedset =
Set.Make (struct Set.Make (struct
type t = Cfg.Node.id * int list type t = Procdesc.Node.id * int list
let compare (node_id1, _) (node_id2, _) = Cfg.Node.id_compare node_id1 node_id2 let compare (node_id1, _) (node_id2, _) = Procdesc.Node.id_compare node_id1 node_id2
end) end)
let visited_str vis = let visited_str vis =
@ -331,7 +331,7 @@ type payload =
type 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 *) { 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 *) phase: phase; (** in FOOTPRINT phase or in RE_EXECUTION PHASE *)
payload: payload; (** payload containing the result of some analysis *) payload: payload; (** payload containing the result of some analysis *)
sessions: int ref; (** Session number: how many nodes went trough symbolic execution *) 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 *) status: status; (** ACTIVE when the proc is being analyzed *)
timestamp: int; (** Timestamp of the specs, >= 0, increased every time the specs change *) timestamp: int; (** Timestamp of the specs, >= 0, increased every time the specs change *)
attributes : ProcAttributes.t; (** Attributes of the procedure *) 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 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. *) (** Like proc_resolve_attributes but start from a proc_desc. *)
let pdesc_resolve_attributes 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 match proc_resolve_attributes proc_name with
| Some proc_attributes -> | Some proc_attributes ->
proc_attributes proc_attributes

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

@ -61,7 +61,7 @@ module Jprop : sig
end end
(** set of visited nodes: node id and list of lines of all the instructions *) (** 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 *) (** convert a Visitedset to a string *)
val visited_str : Visitedset.t -> string val visited_str : Visitedset.t -> string
@ -136,7 +136,7 @@ type payload =
(** Procedure summary *) (** Procedure summary *)
type 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 *) { 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 *) phase: phase; (** in FOOTPRINT phase or in RE_EXECUTION PHASE *)
payload: payload; (** payload containing the result of some analysis *) payload: payload; (** payload containing the result of some analysis *)
sessions: int ref; (** Session number: how many nodes went trough symbolic execution *) 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 *) status: status; (** ACTIVE when the proc is being analyzed *)
timestamp: int; (** Timestamp of the specs, >= 0, increased every time the specs change *) timestamp: int; (** Timestamp of the specs, >= 0, increased every time the specs change *)
attributes : ProcAttributes.t; (** Attributes of the procedure *) 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 *) (** 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. *) Do nothing if a summary exists already. *)
val init_summary : val init_summary :
(Procname.t list * (* depend list *) (Procname.t list * (* depend list *)
Cfg.Node.id list * (* nodes *) Procdesc.Node.id list * (* nodes *)
proc_flags * (* procedure flags *) proc_flags * (* procedure flags *)
(Procname.t * Location.t) list * (* calls *) (Procname.t * Location.t) list * (* calls *)
(Cg.in_out_calls option) * (* in and out calls *) (Cg.in_out_calls option) * (* in and out calls *)
ProcAttributes.t * (* attributes of the procedure *) ProcAttributes.t * (* attributes of the procedure *)
Cfg.Procdesc.t option) (* procdesc option *) Procdesc.t option) (* procdesc option *)
-> unit -> unit
(** Reset a summary rebuilding the dependents and preserving the proc attributes if present. *) (** 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 *) (** Load procedure summary from the given file *)
val load_summary : DB.filename -> summary option 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 val pp_summary_text : whole_seconds:bool -> Format.formatter -> summary -> unit
(** Like proc_resolve_attributes but start from a proc_desc. *) (** 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. (** Try to find the attributes for a defined proc.
First look at specs (to get attributes computed by analysis) 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 L = Logging
module F = Format 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 *) (** failure statistics for symbolic execution on a given node *)
type failure_stats = { type failure_stats = {
@ -28,7 +28,7 @@ type failure_stats = {
(* exception at the first failure *) (* exception at the first failure *)
} }
module NodeHash = Cfg.NodeHash module NodeHash = Procdesc.NodeHash
type t = { type t = {
mutable const_map : const_map; mutable const_map : const_map;
@ -43,13 +43,13 @@ type t = {
mutable last_instr : Sil.instr option; mutable last_instr : Sil.instr option;
(** Last instruction seen *) (** Last instruction seen *)
mutable last_node : Cfg.Node.t; mutable last_node : Procdesc.Node.t;
(** Last node seen *) (** Last node seen *)
mutable last_path : (Paths.Path.t * (PredSymb.path_pos option)) option; mutable last_path : (Paths.Path.t * (PredSymb.path_pos option)) option;
(** Last path seen *) (** 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 *) (** Last prop,tenv,pdesc seen *)
mutable last_session : int; mutable last_session : int;
@ -64,7 +64,7 @@ let initial () = {
diverging_states_node = Paths.PathSet.empty; diverging_states_node = Paths.PathSet.empty;
diverging_states_proc = Paths.PathSet.empty; diverging_states_proc = Paths.PathSet.empty;
last_instr = None; last_instr = None;
last_node = Cfg.Node.dummy (); last_node = Procdesc.Node.dummy ();
last_path = None; last_path = None;
last_prop_tenv_pdesc = None; last_prop_tenv_pdesc = None;
last_session = 0; last_session = 0;
@ -112,7 +112,7 @@ let get_instr () =
let get_loc () = match !gs.last_instr with let get_loc () = match !gs.last_instr with
| Some instr -> Sil.instr_get_loc instr | 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 () = let get_node () =
!gs.last_node !gs.last_node
@ -133,13 +133,13 @@ let node_simple_key node =
| Sil.Abstract _ -> add_key 6 | Sil.Abstract _ -> add_key 6
| Sil.Remove_temps _ -> add_key 7 | Sil.Remove_temps _ -> add_key 7
| Sil.Declare_locals _ -> add_key 8 in | 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 Hashtbl.hash !key
(** key for a node: look at the current node, successors and predecessors *) (** key for a node: look at the current node, successors and predecessors *)
let node_key node = let node_key node =
let succs = Cfg.Node.get_succs node in let succs = Procdesc.Node.get_succs node in
let preds = Cfg.Node.get_preds 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 let v = (node_simple_key node, IList.map node_simple_key succs, IList.map node_simple_key preds) in
Hashtbl.hash v Hashtbl.hash v
@ -161,25 +161,25 @@ let instrs_normalize instrs =
(** Create a function to find duplicate nodes. (** Create a function to find duplicate nodes.
A node is a duplicate of another one if they have the same kind and location 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. *) 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) *) let module M = (* map from (loc,kind) *)
Map.Make(struct Map.Make(struct
type t = Location.t * Cfg.Node.nodekind type t = Location.t * Procdesc.Node.nodekind
let compare (loc1, k1) (loc2, k2) = let compare (loc1, k1) (loc2, k2) =
let n = Location.compare loc1 loc2 in 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 end) in
let module S = (* set of nodes with normalized insructions *) let module S = (* set of nodes with normalized insructions *)
Set.Make(struct Set.Make(struct
type t = Cfg.Node.t * Sil.instr list type t = Procdesc.Node.t * Sil.instr list
let compare (n1, _) (n2, _) = let compare (n1, _) (n2, _) =
Cfg.Node.compare n1 n2 Procdesc.Node.compare n1 n2
end) in end) in
let get_key node = (* map key *) let get_key node = (* map key *)
let loc = Cfg.Node.get_loc node in let loc = Procdesc.Node.get_loc node in
let kind = Cfg.Node.get_kind node in let kind = Procdesc.Node.get_kind node in
(loc, kind) in (loc, kind) in
let map = let map =
@ -192,14 +192,14 @@ let mk_find_duplicate_nodes proc_desc : (Cfg.Node.t -> Cfg.NodeSet.t) =
end in end in
let do_node node = 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 key = get_key node in
let s = try M.find key !m with Not_found -> S.empty in let s = try M.find key !m with Not_found -> S.empty in
if S.cardinal s > E.threshold then raise E.Threshold; if S.cardinal s > E.threshold then raise E.Threshold;
let s' = S.add (node, normalized_instrs) s in let s' = S.add (node, normalized_instrs) s in
m := M.add key s' !m 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 try
IList.iter do_node nodes; IList.iter do_node nodes;
!m !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 s = M.find (get_key node) map in
let elements = S.elements s in let elements = S.elements s in
let (_, node_normalized_instrs), _ = 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 match IList.partition filter elements with
| [this], others -> this, others | [this], others -> this, others
| _ -> raise Not_found in | _ -> 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.compare Sil.instr_compare node_normalized_instrs normalized_instrs' = 0 in
IList.filter equal_normalized_instrs elements in IList.filter equal_normalized_instrs elements in
IList.fold_left IList.fold_left
(fun nset (node', _) -> Cfg.NodeSet.add node' nset) (fun nset (node', _) -> Procdesc.NodeSet.add node' nset)
Cfg.NodeSet.empty duplicates Procdesc.NodeSet.empty duplicates
with Not_found -> Cfg.NodeSet.singleton node in with Not_found -> Procdesc.NodeSet.singleton node in
find_duplicate_nodes find_duplicate_nodes
let get_node_id () = let get_node_id () =
Cfg.Node.get_id !gs.last_node Procdesc.Node.get_id !gs.last_node
let get_node_id_key () = 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 get_inst_update pos =
let loc = get_loc () in let loc = get_loc () in
@ -274,7 +274,7 @@ let get_session () =
let get_path_pos () = let get_path_pos () =
let pname = match get_prop_tenv_pdesc () with 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 | None -> Procname.from_string_c_fun "unknown_procedure" in
let nid = get_node_id () in let nid = get_node_id () in
(pname, (nid :> int)) (pname, (nid :> int))
@ -317,7 +317,7 @@ type log_issue =
let process_execution_failures (log_issue : log_issue) pname = let process_execution_failures (log_issue : log_issue) pname =
let do_failure _ fs = 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 match fs.node_ok, fs.first_failure with
| 0, Some (loc, key, _, loc_trace, exn) -> | 0, Some (loc, key, _, loc_trace, exn) ->
let ex_name, _, ml_loc_opt, _, _, _, _ = Exceptions.recognize_exception exn in 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 = let set_prop_tenv_pdesc prop tenv pdesc =
!gs.last_prop_tenv_pdesc <- Some (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_instr <- None;
!gs.last_node <- node !gs.last_node <- node

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

@ -18,7 +18,7 @@ type t
(** Add diverging states *) (** Add diverging states *)
val add_diverging_states : Paths.PathSet.t -> unit 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. *) (** Get the constant map for the current procedure. *)
val get_const_map : unit -> const_map 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 val get_loc_trace : unit -> Errlog.loc_trace
(** Get last node seen in symbolic execution *) (** 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 *) (** 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 *) (** 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 (** return the normalized precondition extracted form the last prop seen, if any
the abstraction function is a parameter to get around module dependencies *) 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 val get_path_pos : unit -> PredSymb.path_pos
(** Get last last prop,tenv,pdesc seen in symbolic execution *) (** 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 *) (** Get last session seen in symbolic execution *)
val get_session : unit -> int val get_session : unit -> int
(** Mark the end of symbolic execution of a node *) (** 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 *) (** 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 *) (** Mark that the execution of the current instruction failed *)
val mark_instr_fail : exn -> unit val mark_instr_fail : exn -> unit
@ -82,7 +82,7 @@ val mark_instr_ok : unit -> unit
(** Create a function to find duplicate nodes. (** Create a function to find duplicate nodes.
A node is a duplicate of another one if they have the same kind and location 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. *) 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 = type log_issue =
Procname.t -> Procname.t ->
@ -115,13 +115,13 @@ val set_const_map : const_map -> unit
val set_instr : Sil.instr -> unit val set_instr : Sil.instr -> unit
(** Set last node seen in symbolic execution *) (** 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 *) (** Get last path seen in symbolic execution *)
val set_path : Paths.Path.t -> PredSymb.path_pos option -> unit val set_path : Paths.Path.t -> PredSymb.path_pos option -> unit
(** Set last prop,tenv,pdesc seen in symbolic execution *) (** 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 *) (** Set last session seen in symbolic execution *)
val set_session : int -> unit 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 get_blocks_nullified node =
let null_blocks = IList.flatten(IList.map (fun i -> match i with let null_blocks = IList.flatten(IList.map (fun i -> match i with
| Sil.Nullify(pvar, _) when Sil.is_block_pvar pvar -> [pvar] | Sil.Nullify(pvar, _) when Sil.is_block_pvar pvar -> [pvar]
| _ -> []) (Cfg.Node.get_instrs node)) in | _ -> []) (Procdesc.Node.get_instrs node)) in
null_blocks null_blocks
(** Given a proposition and an objc block checks whether by existentially quantifying (** 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 let rec apply_offlist
pdesc tenv p fp_root nullify_struct (root_lexp, strexp, typ) offlist pdesc tenv p fp_root nullify_struct (root_lexp, strexp, typ) offlist
(f: Exp.t option -> Exp.t) inst lookup_inst = (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 () = let pp_error () =
L.d_strln ".... Invalid Field ...."; L.d_strln ".... Invalid Field ....";
L.d_str "strexp : "; Sil.d_sexp strexp; L.d_ln (); 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 if Procname.is_infer_undefined callee_pname then prop
else else
let is_rec_call pname = (* TODO: (t7147096) extend this to detect mutual recursion *) 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 = let already_has_abduced_retval p abduced_ret_pv =
IList.exists IList.exists
(fun hpred -> match hpred with (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].*) (** Execute [instr] with a symbolic heap [prop].*)
let rec sym_exec tenv current_pdesc _instr (prop_: Prop.normal Prop.t) path let rec sym_exec tenv current_pdesc _instr (prop_: Prop.normal Prop.t) path
: (Prop.normal Prop.t * Paths.Path.t) list = : (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_instr _instr; (* mark instruction last seen *)
State.set_prop_tenv_pdesc prop_ tenv current_pdesc; (* mark prop,tenv,pdesc last seen *) State.set_prop_tenv_pdesc prop_ tenv current_pdesc; (* mark prop,tenv,pdesc last seen *)
SymOp.pay(); (* pay one symop *) 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 Ondemand.analyze_proc_name
tenv ~propagate_exceptions:true current_pdesc resolved_pname; tenv ~propagate_exceptions:true current_pdesc resolved_pname;
let callee_pdesc_opt = Ondemand.get_proc_desc resolved_pname in 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 = let sentinel_result =
if !Config.curr_language = Config.Clang then if !Config.curr_language = Config.Clang then
check_variadic_sentinel_if_present 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 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 *) (* If it's an ObjC getter or setter, call the builtin rather than skipping *)
let attrs_opt = 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 match attr_opt, resolved_pname with
| Some attrs, Procname.ObjC_Cpp _ -> Some attrs | Some attrs, Procname.ObjC_Cpp _ -> Some attrs
| None, Procname.ObjC_Cpp _ -> AttributesTable.load_attributes resolved_pname | 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 pre_1 in
let pre_3 = add_constraints_on_actuals_by_ref tenv pre_2 actuals_by_ref callee_pname loc 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 add_tainted_pre pre_3 args caller_pname callee_pname in
if is_scan (* if scan function, don't mark anything with undef attributes *) if is_scan (* if scan function, don't mark anything with undef attributes *)
then [(Tabulation.remove_constant_string_class tenv pre_final, path)] 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 | 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, (* 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 *) 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 f_accessor ret_typ tenv ret_id pdesc cur_pname loc args prop
|> IList.map (fun p -> (p, path)) |> IList.map (fun p -> (p, path))
(** Perform symbolic execution for a function call *) (** Perform symbolic execution for a function call *)
and proc_call summary {Builtin.pdesc; tenv; prop_= pre; path; ret_id; args= actual_pars; loc; } = 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 callee_pname = Specs.get_proc_name summary in
let ret_typ = Specs.get_ret_type summary in let ret_typ = Specs.get_ret_type summary in
let check_return_value_ignored () = 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 *) (** 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) and sym_exec_wrapper handle_exn tenv pdesc instr ((prop: Prop.normal Prop.t), path)
: Paths.PathSet.t = : 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 prop_primed_to_normal p = (* Rename primed vars with fresh normal vars, and return them *)
let fav = Prop.prop_fav p in let fav = Prop.prop_fav p in
Sil.fav_filter_ident fav Ident.is_primed; 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 let instr_is_abstraction = function
| Sil.Abstract _ -> true | Sil.Abstract _ -> true
| _ -> false in | _ -> 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 let curr_node = State.get_node () in
match Cfg.Node.get_kind curr_node with match Procdesc.Node.get_kind curr_node with
| Cfg.Node.Prune_node _ when not (node_has_abstraction curr_node) -> | Procdesc.Node.Prune_node _ when not (node_has_abstraction curr_node) ->
(* don't check for leaks in prune nodes, unless there is abstraction anyway,*) (* don't check for leaks in prune nodes, unless there is abstraction anyway,*)
(* but force them into either branch *) (* but force them into either branch *)
p' 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} *) (** {2 Lifted Abstract Transfer Functions} *)
let node handle_exn tenv pdesc node (pset : Paths.PathSet.t) : Paths.PathSet.t = 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 exe_instr_prop instr p tr (pset1: Paths.PathSet.t) =
let pset2 = let pset2 =
if Tabulation.prop_is_exn pname p && not (Sil.instr_is_auxiliary instr) 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, (* skip normal instructions if an exception was thrown,
unless this is an exception handler node *) unless this is an exception handler node *)
then 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 Paths.PathSet.union pset2 pset1 in
let exe_instr_pset pset instr = let exe_instr_pset pset instr =
Paths.PathSet.fold (exe_instr_prop instr) pset Paths.PathSet.empty in 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. *) (** Symbolic execution of the instructions of a node, lifted to sets of propositions. *)
val node : 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. (** Symbolic execution of a sequence of instructions.
If errors occur and [mask_errors] is true, just treat as skip. *) If errors occur and [mask_errors] is true, just treat as skip. *)
val instrs : 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 (Prop.normal Prop.t * Paths.Path.t) list -> (Prop.normal Prop.t * Paths.Path.t) list
(** Symbolic execution of the divergent pure computation. *) (** 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) ret_id (posts: ('a Prop.t * Paths.Path.t) list)
actual_pre path_pre split actual_pre path_pre split
caller_pdesc callee_pname loc = 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 instantiated_post =
let posts' = let posts' =
if !Config.footprint && 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 let exe_spec
tenv ret_id (n, nspecs) caller_pdesc callee_pname callee_attrs loc prop path_pre 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 = (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 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 actual_pre = mk_actual_precondition tenv prop actual_params formal_params in
let spec_pre = 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 *) (** Execute the function call and return the list of results with return value *)
let exe_function_call let exe_function_call
callee_attrs tenv ret_id caller_pdesc callee_pname loc actual_params prop path = 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 = let trace_call res =
match Specs.get_summary caller_pname with match Specs.get_summary caller_pname with
| None -> () | 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 *) (** Execute the function call and return the list of results with return value *)
val exe_function_call: 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 -> Location.t -> (Exp.t * Typ.t) list -> Prop.normal Prop.t -> Paths.Path.t ->
(Prop.normal Prop.t * Paths.Path.t) list (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) end)
type extras_t = { type extras_t = {
get_proc_desc : Procname.t -> Cfg.Procdesc.t option; get_proc_desc : Procname.t -> Procdesc.t option;
stacktraces : Stacktrace.t list; stacktraces : Stacktrace.t list;
} }
let line_range_of_pdesc pdesc = 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 start_line = ploc.Location.line in
let end_line = Cfg.Procdesc.fold_instrs let end_line = Procdesc.fold_instrs
(fun acc _ instr -> (fun acc _ instr ->
let new_loc = Sil.instr_get_loc instr in let new_loc = Sil.instr_get_loc instr in
max acc new_loc.Location.line) max acc new_loc.Location.line)
@ -54,10 +54,10 @@ let line_range_of_pdesc pdesc =
let stacktree_of_pdesc let stacktree_of_pdesc
pdesc pdesc
?(loc=Cfg.Procdesc.get_loc pdesc) ?(loc=Procdesc.get_loc pdesc)
?(callees=[]) ?(callees=[])
location_type = location_type =
let procname = Cfg.Procdesc.get_proc_name pdesc in let procname = Procdesc.get_proc_name pdesc in
let frame_loc = let frame_loc =
Some { Stacktree_j.location_type = location_type; Some { Stacktree_j.location_type = location_type;
file = DB.source_file_to_string loc.Location.file; 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 stacktree_of_pdesc pdesc ~loc ~callees location_type
let output_json_summary tenv pdesc astate loc location_type get_proc_desc = 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 = let stacktree =
stacktree_of_astate tenv pdesc astate loc location_type get_proc_desc in stacktree_of_astate tenv pdesc astate loc location_type get_proc_desc in
let dir = Filename.concat Config.results_dir "crashcontext" 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 get_proc_desc = proc_data.ProcData.extras.get_proc_desc in
let traces = proc_data.ProcData.extras.stacktraces in let traces = proc_data.ProcData.extras.stacktraces in
let tenv = proc_data.ProcData.tenv 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_proc frame =
let matches_class pname = match pname with let matches_class pname = match pname with
| Procname.Java java_proc -> | Procname.Java java_proc ->
@ -186,7 +186,7 @@ let checker { Callbacks.proc_desc; tenv; get_proc_desc; } =
| Some stacktraces -> begin | Some stacktraces -> begin
let extras = { get_proc_desc; stacktraces; } in let extras = { get_proc_desc; stacktraces; } in
SpecSummary.write_summary SpecSummary.write_summary
(Cfg.Procdesc.get_proc_name proc_desc) (Procdesc.get_proc_name proc_desc)
(Some (stacktree_of_pdesc proc_desc "proc_start")); (Some (stacktree_of_pdesc proc_desc "proc_start"));
ignore(Analyzer.exec_pdesc (ProcData.make proc_desc tenv extras)) ignore(Analyzer.exec_pdesc (ProcData.make proc_desc tenv extras))
end 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 input is the previous state, current instruction, current node kind, current procedure and
type environment. 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. (** log errors here.
input is a state, location where the state occurs in the source, and the current procedure. 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 exec_instr astate_set proc_data node instr =
let node_kind = CFG.kind node in 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 Domain.fold
(fun astate acc -> (fun astate acc ->
Domain.add (Spec.exec_instr astate instr node_kind pname proc_data.ProcData.tenv) 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) (TransferFunctions)
let checker { Callbacks.proc_desc; proc_name; tenv; } = 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 do_reporting node_id state =
let astate_set = state.AbstractInterpreter.post in let astate_set = state.AbstractInterpreter.post in
if not (Domain.is_empty astate_set) 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 *) (* should never fail since keys in the invariant map should always be real node id's *)
let node = let node =
IList.find 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 nodes in
Domain.iter Domain.iter
(fun astate -> (fun astate ->

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

@ -13,7 +13,7 @@ sig
val initial : astate val initial : astate
val exec_instr : val exec_instr :
astate -> 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 report : astate -> Location.t -> Procname.t -> unit
val compare : astate -> astate -> int val compare : astate -> astate -> int
end 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 sink_of_global global pname loc =
let site = CallSite.make pname loc in let site = CallSite.make pname loc in
SiofTrace.Sink.make global site 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 let trace = match astate with
| Domain.Bottom -> SiofTrace.initial | Domain.Bottom -> SiofTrace.initial
| Domain.NonBottom t -> t in | Domain.NonBottom t -> t in
@ -134,7 +134,7 @@ let report_siof trace pdesc tenv loc =
unit: %a. %a" unit: %a. %a"
pp_sink final_sink pp_sink final_sink
pp_path_part (IList.rev path) in 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 let exn = Exceptions.Checkers
("STATIC_INITIALIZATION_ORDER_FIASCO", Localise.verbatim_desc description) in ("STATIC_INITIALIZATION_ORDER_FIASCO", Localise.verbatim_desc description) in
Reporting.log_error caller_pname ~loc exn 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 let siof_check pdesc tenv = function
| Some (SiofDomain.NonBottom post) -> | 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 let is_orig_file f = match attrs.ProcAttributes.translation_unit with
| Some orig_file -> | Some orig_file ->
let orig_path = DB.source_file_to_abs_path orig_file in 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 checker ({ Callbacks.tenv; proc_desc } as callback) =
let post = Interprocedural.checker callback ProcData.empty_extras in 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 match pname with
| Procname.C c when Procname.is_globals_initializer c -> | Procname.C c when Procname.is_globals_initializer c ->
siof_check proc_desc tenv post 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 exec_instr ((lockstate,(readstate,writestate)) as astate) { ProcData.pdesc; } _ =
let is_unprotected lockstate = 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 in
function function
| Sil.Call (_, Const (Cfun pn), _, _, _) -> | 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 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*) | Some post -> (* I am printing to commandline and out to cater to javac and buck*)
(L.stdout "\n Procedure: %s@ " (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.stdout "\n POST: %a\n" CombinedDomain.pp post;
(L.out "\n Procedure: %s@ " (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 L.out "\n POST: %a\n" CombinedDomain.pp post
| None -> () | None -> ()
(* a results table is a Map where a key is an a procedure environment, (* 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 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 let compare (_, _, pn1, _) (_,_,pn2,_) = Procname.compare pn1 pn2
end) end)
@ -109,7 +109,7 @@ let should_analyze_proc (_,tenv,proc_name,proc_desc) =
not (Procname.java_is_autogen_method proc_name) && not (Procname.java_is_autogen_method proc_name) &&
not (Procname.is_constructor proc_name) && not (Procname.is_constructor proc_name) &&
not (Procname.is_class_initializer 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 *) (* creates a map from proc_envs to postconditions *)
let make_results_table file_env = let make_results_table file_env =
@ -162,7 +162,7 @@ let report_thread_safety_errors ( _, tenv, pname, pdesc) writestate =
pname pname
pdesc pdesc
"CHECKERS_THREAD_SAFETY_WARNING" "CHECKERS_THREAD_SAFETY_WARNING"
(Cfg.Procdesc.get_loc pdesc) (Procdesc.get_loc pdesc)
description description
in in
IList.iter report_one_error (IList.map snd (PathDomain.elements writestate)) 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 (*Gathers results by analyzing all the methods in a file, then post-processes
the results to check (approximation of) thread safety *) 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 = let file_analysis _ _ _ file_env =
if should_analyze_file file_env then if should_analyze_file file_env then
process_results_table process_results_table

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

@ -135,7 +135,7 @@ module MakeNoCFG
let analyze_ondemand_ _ pdesc = let analyze_ondemand_ _ pdesc =
match compute_post (ProcData.make pdesc tenv extras) with match compute_post (ProcData.make pdesc tenv extras) with
| Some post -> | Some post ->
Summ.write_summary (Cfg.Procdesc.get_proc_name pdesc) post; Summ.write_summary (Procdesc.get_proc_name pdesc) post;
Some post Some post
| None -> | None ->
None in 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 -> when is_unlikely callee_pname ->
Domain.add_tracking_var (Var.of_id id) astate Domain.add_tracking_var (Var.of_id id) astate
| Sil.Call (_, Const (Cfun callee_pname), _, call_loc, _) -> | 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 let call_site = CallSite.make callee_pname call_loc in
begin begin
(* Runs the analysis of callee_pname if not already analyzed *) (* 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 is_modeled_expensive tenv pname || is_expensive tenv pname
let check_and_report ({ Callbacks.proc_desc; proc_name; tenv; } as proc_data) = 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 let expensive = is_expensive tenv proc_name in
(* TODO: generalize so we can check subtyping on arbitrary annotations *) (* TODO: generalize so we can check subtyping on arbitrary annotations *)
let check_expensive_subtyping_rules overridden_pname = 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 !found
let pdesc_has_annot pdesc annot = 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 initializer_ = "Initializer"
let inject = "Inject" 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 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. *) (** Mark the return of the method_annotation with the given annotation. *)
val method_annotation_mark_return : val method_annotation_mark_return :

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

@ -20,25 +20,25 @@ let verbose = false
module State = struct module State = struct
type t = type t =
{ {
visited : Cfg.NodeSet.t; visited : Procdesc.NodeSet.t;
} }
let initial = let initial =
{ {
visited = Cfg.NodeSet.empty; visited = Procdesc.NodeSet.empty;
} }
let equal t1 t2 = let equal t1 t2 =
Cfg.NodeSet.equal t1.visited t2.visited Procdesc.NodeSet.equal t1.visited t2.visited
let join t1 t2 = 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 = let add_visited node t =
{ {
visited = Cfg.NodeSet.add node t.visited; visited = Procdesc.NodeSet.add node t.visited;
} }
let get_visited t = let get_visited t =
@ -46,16 +46,16 @@ module State = struct
let pp fmt t = let pp fmt t =
F.fprintf fmt "visited: %a" 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 = let num_visited t =
Cfg.NodeSet.cardinal t.visited Procdesc.NodeSet.cardinal t.visited
end end
let do_node _ node (s : State.t) : (State.t list) * (State.t list) = let do_node _ node (s : State.t) : (State.t list) * (State.t list) =
let s' = State.add_visited node s in let s' = State.add_visited node s in
if verbose then L.stderr " N:%a (#visited: %a)@." if verbose then L.stderr " N:%a (#visited: %a)@."
Cfg.Node.pp node Procdesc.Node.pp node
State.pp s'; State.pp s';
[s'], [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. *) (** Check the final state at the end of the analysis. *)
let check_final_state tenv proc_name proc_desc final_s = 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_nodes = IList.length proc_nodes in
let tot_visited = State.num_visited final_s 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 verbose then L.stderr "TOT nodes: %d (visited: %n)@." tot_nodes tot_visited;
if tot_nodes <> tot_visited then if tot_nodes <> tot_visited then
begin begin
let not_visited = 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 do_node n =
let loc = Cfg.Node.get_loc n in let loc = Procdesc.Node.get_loc n in
let description = Format.sprintf "Node not visited: %d" (Cfg.Node.get_id n :> int) in let description = Format.sprintf "Node not visited: %d" (Procdesc.Node.get_id n :> int) in
let report = match Cfg.Node.get_kind n with let report = match Procdesc.Node.get_kind n with
| Cfg.Node.Join_node -> false | Procdesc.Node.Join_node -> false
| k when k = Cfg.Node.exn_sink_kind -> false | k when k = Procdesc.Node.exn_sink_kind -> false
| _ -> true in | _ -> true in
if report if report
then report_error tenv description proc_name proc_desc loc in 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 begin
if verbose then L.stderr "@.--@.PROC: %a@." Procname.pp proc_name; if verbose then L.stderr "@.--@.PROC: %a@." Procname.pp proc_name;
let transitions = DFDead.run tenv proc_desc State.initial in 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 match transitions exit_node with
| DFDead.Transition (pre_final_s, _, _) -> | DFDead.Transition (pre_final_s, _, _) ->
let final_s = State.add_visited exit_node pre_final_s in 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 if not (State.is_balanced s) then
begin begin
let description = Printf.sprintf "%d missing end/stop" (Elem.get_int (State.max s)) in 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 report_warning tenv description pn pd loc
end end
@ -303,7 +303,7 @@ end
(** State transformation for a cfg node. *) (** State transformation for a cfg node. *)
let do_node tenv pn pd idenv _ node (s : State.t) : (State.t list) * (State.t list) = 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 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 let state2 = BooleanVars.do_instr pn pd idenv instr state1 in
curr_state := state2 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] [!curr_state], [!curr_state]
(** Check the final state at the end of the analysis. *) (** 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 begin
if verbose then L.stderr "@.--@.PROC: %a@." Procname.pp proc_name; if verbose then L.stderr "@.--@.PROC: %a@." Procname.pp proc_name;
let transitions = DFTrace.run tenv proc_desc State.balanced in 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 match transitions exit_node with
| DFTrace.Transition (final_s, _, _) -> | DFTrace.Transition (final_s, _, _) ->
check_final_state tenv proc_name proc_desc exit_node 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 end
let report_calls_and_accesses tenv callback proc_desc instr = 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 let callee = Procname.to_string proc_name in
match PatternMatch.get_java_field_access_signature instr with match PatternMatch.get_java_field_access_signature instr with
| Some (bt, fn, ft) -> | Some (bt, fn, ft) ->
@ -168,7 +168,7 @@ let report_calls_and_accesses tenv callback proc_desc instr =
proc_name proc_name
proc_desc proc_desc
(callback ^ "_CALLBACK") (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) (Format.sprintf "field access %s.%s:%s in %s@." bt fn ft callee)
| None -> | None ->
match PatternMatch.get_java_method_call_formal_signature instr with 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_name
proc_desc proc_desc
(callback ^ "_CALLBACK") (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) (Format.sprintf "method call %s.%s(%s):%s in %s@." bt fn "..." rt callee)
| None -> () | None -> ()
(** Report all field accesses and method calls of a procedure. *) (** Report all field accesses and method calls of a procedure. *)
let callback_check_access { Callbacks.tenv; proc_desc } = 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) (fun _ instr -> report_calls_and_accesses tenv "PROC" proc_desc instr)
proc_desc 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 match get_proc_desc proc_name with
| Some proc_desc -> | Some proc_desc ->
let tenv = Exe_env.get_tenv exe_env proc_name in 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) (fun _ instr -> report_calls_and_accesses tenv "CLUSTER" proc_desc instr)
proc_desc proc_desc
| _ -> | _ ->
@ -235,7 +235,7 @@ let callback_check_write_to_parcel_java
let check r_desc w_desc = let check r_desc w_desc =
let is_serialization_node node = let is_serialization_node node =
match Cfg.Node.get_callees node with match Procdesc.Node.get_callees node with
| [] -> false | [] -> false
| [Procname.Java pname_java] -> | [Procname.Java pname_java] ->
let class_name = Procname.java_get_class_name pname_java in let class_name = Procname.java_get_class_name pname_java in
@ -261,18 +261,18 @@ let callback_check_write_to_parcel_java
false in false in
let node_to_call_desc node = let node_to_call_desc node =
match Cfg.Node.get_callees node with match Procdesc.Node.get_callees node with
| [desc] -> desc | [desc] -> desc
| _ -> assert false in | _ -> assert false in
let r_call_descs = let r_call_descs =
IList.map node_to_call_desc IList.map node_to_call_desc
(IList.filter is_serialization_node (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 = let w_call_descs =
IList.map node_to_call_desc IList.map node_to_call_desc
(IList.filter is_serialization_node (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 let rec check_match = function
| rc:: rcs, wc:: wcs -> | rc:: rcs, wc:: wcs ->
@ -314,7 +314,7 @@ let callback_check_write_to_parcel_java
if !verbose then L.stdout "Methods not available@." if !verbose then L.stdout "Methods not available@."
end end
| _ -> () in | _ -> () 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 *) (** Looks for writeToParcel methods and checks whether read is in reverse *)
let callback_check_write_to_parcel ({ Callbacks.proc_name } as args) = 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 verbose = ref false in
let class_formal_names = lazy ( 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 class_formals =
let is_class_type (p, typ) = let is_class_type (p, typ) =
match typ with match typ with
@ -375,7 +375,7 @@ let callback_monitor_nullcheck { Callbacks.proc_desc; idenv; proc_name } =
let was_not_found formal_name = let was_not_found formal_name =
not (Exp.Set.exists (fun exp -> equal_formal_param exp formal_name) !checks_to_formals) in 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 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 () = let pp_file_loc fmt () =
F.fprintf fmt "%s:%d" (DB.source_file_to_string loc.Location.file) loc.Location.line in F.fprintf fmt "%s:%d" (DB.source_file_to_string loc.Location.file) loc.Location.line in
L.stdout "Null Checks of Formal Parameters: "; L.stdout "Null Checks of Formal Parameters: ";
@ -401,7 +401,7 @@ let callback_monitor_nullcheck { Callbacks.proc_desc; idenv; proc_name } =
| _ -> | _ ->
()) ())
| _ -> () in | _ -> () in
Cfg.Procdesc.iter_instrs do_instr proc_desc; Procdesc.iter_instrs do_instr proc_desc;
summary_checks_of_formals () summary_checks_of_formals ()
(** Test persistent state. *) (** Test persistent state. *)
@ -412,7 +412,7 @@ let callback_test_state { Callbacks.proc_name } =
let callback_checkVisibleForTesting { Callbacks.proc_desc } = let callback_checkVisibleForTesting { Callbacks.proc_desc } =
if Annotations.pdesc_has_annot proc_desc Annotations.visibleForTesting then if Annotations.pdesc_has_annot proc_desc Annotations.visibleForTesting then
begin begin
let loc = Cfg.Procdesc.get_loc proc_desc in let loc = Procdesc.get_loc proc_desc in
let linereader = Printer.LineReader.create () in let linereader = Printer.LineReader.create () in
L.stdout "%a@." (PP.pp_loc_range linereader 10 10) loc L.stdout "%a@." (PP.pp_loc_range linereader 10 10) loc
end end
@ -426,10 +426,15 @@ let callback_find_deserialization { Callbacks.proc_desc; get_proc_desc; idenv; p
let reverse_find_instr f node = let reverse_find_instr f node =
(* this is not really sound but for the moment a sufficient approximation *) (* this is not really sound but for the moment a sufficient approximation *)
let has_instr node = 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 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 preds =
let instrs = IList.flatten (IList.map (fun n -> IList.rev (Cfg.Node.get_instrs n)) preds) in 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 try
Some (IList.find f instrs) Some (IList.find f instrs)
with Not_found -> None in with Not_found -> None in
@ -442,9 +447,9 @@ let callback_find_deserialization { Callbacks.proc_desc; get_proc_desc; idenv; p
Some proc_desc' -> Some proc_desc' ->
let is_return_instr = function let is_return_instr = function
| Sil.Store (Exp.Lvar p, _, _, _) | 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 | _ -> 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 | Some (Sil.Store (_, _, Exp.Const (Const.Cclass n), _)) -> Ident.name_to_string n
| _ -> "<" ^ (Procname.to_string proc_name') ^ ">") | _ -> "<" ^ (Procname.to_string proc_name') ^ ">")
| None -> "?" in | 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 ST.pname_add proc_name ret_const_key ret_const in
store_return (); store_return ();
Cfg.Procdesc.iter_instrs do_instr proc_desc Procdesc.iter_instrs do_instr proc_desc
(** Check field accesses. *) (** Check field accesses. *)
let callback_check_field_access { Callbacks.proc_desc } = let callback_check_field_access { Callbacks.proc_desc } =
@ -552,7 +557,7 @@ let callback_check_field_access { Callbacks.proc_desc } =
| Sil.Remove_temps _ | Sil.Remove_temps _
| Sil.Declare_locals _ -> | Sil.Declare_locals _ ->
() in () in
Cfg.Procdesc.iter_instrs do_instr proc_desc Procdesc.iter_instrs do_instr proc_desc
(** Print c method calls. *) (** Print c method calls. *)
let callback_print_c_method_calls { Callbacks.tenv; proc_desc; proc_name } = 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 loc
description description
| _ -> () in | _ -> () in
Cfg.Procdesc.iter_instrs do_instr proc_desc Procdesc.iter_instrs do_instr proc_desc
(** Print access to globals. *) (** Print access to globals. *)
let callback_print_access_to_globals { Callbacks.tenv; proc_desc; proc_name } = 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 -> | Sil.Store (e, _, _, loc) when get_global_var e <> None ->
Option.may (fun pvar -> do_pvar false pvar loc) (get_global_var e) Option.may (fun pvar -> do_pvar false pvar loc) (get_global_var e)
| _ -> () in | _ -> () 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: val report_error:
Tenv.t -> Tenv.t ->
Procname.t -> Procname.t ->
Cfg.Procdesc.t -> Procdesc.t ->
string -> string ->
Location.t -> Location.t ->
?advice: string option -> ?advice: string option ->

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

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

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

@ -9,7 +9,7 @@
open! Utils 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. *) (** 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 val join : t -> t -> t
(** Perform a state transition on a node. *) (** 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? *) (** Can proc throw an exception? *)
val proc_throws : Procname.t -> throws val proc_throws : Procname.t -> throws
@ -43,14 +43,14 @@ module type DF = sig
| Transition of state * state list * state list | Transition of state * state list * state list
val join : state list -> state -> state 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 end
(** Determine if the node can throw an exception. *) (** Determine if the node can throw an exception. *)
let node_throws pdesc node (proc_throws : Procname.t -> throws) : throws = let node_throws pdesc node (proc_throws : Procname.t -> throws) : throws =
let instr_throws instr = let instr_throws instr =
let is_return pvar = 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 Pvar.equal pvar ret_pvar in
match instr with match instr with
| Sil.Store (Exp.Lvar pvar, _, Exp.Exn _, _) when is_return pvar -> | 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 | t, DoesNotThrow -> res := t in
let do_instr instr = update_res (instr_throws instr) 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 !res
(** Create an instance of the dataflow algorithm given a state parameter. *) (** Create an instance of the dataflow algorithm given a state parameter. *)
module MakeDF(St: DFStateType) : DF with type state = St.t = struct module MakeDF(St: DFStateType) : DF with type state = St.t = struct
module S = Cfg.NodeSet module S = Procdesc.NodeSet
module H = Cfg.NodeHash module H = Procdesc.NodeHash
module N = Cfg.Node module N = Procdesc.Node
type worklist = S.t type worklist = S.t
type statemap = St.t H.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; pre_states : statemap;
post_states : statelistmap; post_states : statelistmap;
exn_states : statelistmap; exn_states : statelistmap;
proc_desc : Cfg.Procdesc.t proc_desc : Procdesc.t
} }
type state = St.t type state = St.t
type transition = type transition =
@ -118,8 +118,8 @@ module MakeDF(St: DFStateType) : DF with type state = St.t = struct
push_state dest_joined push_state dest_joined
with Not_found -> push_state new_state in with Not_found -> push_state new_state in
let succ_nodes = Cfg.Node.get_succs node in let succ_nodes = Procdesc.Node.get_succs node in
let exn_nodes = Cfg.Node.get_exn node in let exn_nodes = Procdesc.Node.get_exn node in
if throws <> Throws then if throws <> Throws then
IList.iter IList.iter
(fun s -> IList.iter (propagate_to_dest s) succ_nodes) (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 run tenv proc_desc state =
let t = 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_set = S.singleton start_node in
let init_statemap = let init_statemap =
let m = H.create 1 in let m = H.create 1 in
@ -178,7 +178,7 @@ let callback_test_dataflow { Callbacks.proc_desc; tenv } =
let equal = int_equal let equal = int_equal
let join n m = if n = 0 then m else n let join n m = if n = 0 then m else n
let do_node _ n s = 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] [s + 1], [s + 1]
let proc_throws _ = DoesNotThrow let proc_throws _ = DoesNotThrow
end) in end) in
@ -187,4 +187,4 @@ let callback_test_dataflow { Callbacks.proc_desc; tenv } =
match transitions node with match transitions node with
| DFCount.Transition _ -> () | DFCount.Transition _ -> ()
| DFCount.Dead_state -> () in | 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 val join : t -> t -> t
(** Perform a state transition on a node. *) (** 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? *) (** Can proc throw an exception? *)
val proc_throws : Procname.t -> throws 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. (** 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 *) 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 end
(** Functor to create an instance of a dataflow analysis. *) (** 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 retained_view = "CHECKERS_FRAGMENT_RETAINS_VIEW" in
let description = Localise.desc_fragment_retains_view fragment_typ fld fld_typ pname in let description = Localise.desc_fragment_retains_view fragment_typ fld fld_typ pname in
let exn = Exceptions.Checkers (retained_view, description) 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 Reporting.log_error pname ~loc exn
let callback_fragment_retains_view_java 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, _, _) -> | Sil.Load (id, e, _, _) ->
Ident.IdentHash.add map id e Ident.IdentHash.add map id e
| _ -> () in | _ -> () in
Cfg.Procdesc.iter_instrs do_instr proc_desc; Procdesc.iter_instrs do_instr proc_desc;
map map
(* lazy implementation, only create when used *) (* lazy implementation, only create when used *)

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

@ -15,12 +15,12 @@ open! Utils
type t type t
val create : Cfg.Procdesc.t -> t val create : Procdesc.t -> t
val create_from_idenv : t -> Cfg.Procdesc.t -> t val create_from_idenv : t -> Procdesc.t -> t
val lookup : t -> Ident.t -> Exp.t option val lookup : t -> Ident.t -> Exp.t option
val expand_expr : t -> Exp.t -> Exp.t val expand_expr : t -> Exp.t -> Exp.t
val exp_is_temp : t -> Exp.t -> bool val exp_is_temp : t -> Exp.t -> bool
(** Stronger version of expand_expr which also expands a temporary variable. *) (** 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 let get_vararg_type_names tenv
(call_node: Cfg.Node.t) (call_node: Procdesc.Node.t)
(ivar: Pvar.t): string list = (ivar: Pvar.t): string list =
(* Is this the node creating ivar? *) (* Is this the node creating ivar? *)
let rec initializes_array instrs = let rec initializes_array instrs =
@ -167,7 +167,7 @@ let get_vararg_type_names tenv
let rec added_nvar array_nvar instrs = let rec added_nvar array_nvar instrs =
match instrs with match instrs with
| Sil.Store (Exp.Lindex (Exp.Var iv, _), _, Exp.Var nvar, _):: _ | 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, _):: _ | Sil.Store (Exp.Lindex (Exp.Var iv, _), _, Exp.Const c, _):: _
when Ident.equal iv array_nvar -> Some (java_get_const_type_name c) when Ident.equal iv array_nvar -> Some (java_get_const_type_name c)
| _:: is -> added_nvar array_nvar is | _:: is -> added_nvar array_nvar is
@ -179,14 +179,14 @@ let get_vararg_type_names tenv
added_nvar nv instrs added_nvar nv instrs
| _:: is -> array_nvar is | _:: is -> array_nvar is
| _ -> None in | _ -> 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 *) (* Walk nodes backward until definition of ivar, adding type names *)
let rec type_names node = let rec type_names node =
if initializes_array (Cfg.Node.get_instrs node) then if initializes_array (Procdesc.Node.get_instrs node) then
[] []
else else
match (Cfg.Node.get_preds node) with match (Procdesc.Node.get_preds node) with
| [n] -> (match (added_type_name node) with | [n] -> (match (added_type_name node) with
| Some name -> name:: type_names n | Some name -> name:: type_names n
| None -> type_names n) | None -> type_names n)
@ -195,7 +195,7 @@ let get_vararg_type_names tenv
IList.rev (type_names call_node) IList.rev (type_names call_node)
let has_formal_proc_argument_type_names proc_desc argument_type_names = 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 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.length formals = IList.length argument_type_names
&& IList.for_all2 equal_formal_arg formals 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 values := content_exp :: !values
| _ -> () in | _ -> () in
let do_node n = 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 let () = match Errdesc.find_program_variable_assignment node pvar with
| Some (node', _) -> | Some (node', _) ->
Cfg.Procdesc.iter_slope_range do_node node' node Procdesc.iter_slope_range do_node node' node
| None -> () in | None -> () in
!values !values
@ -310,9 +310,9 @@ let proc_calls resolve_attributes pdesc filter : (Procname.t * ProcAttributes.t)
end end
| _ -> () in | _ -> () in
let do_node node = 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 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.iter do_node nodes;
IList.rev !res IList.rev !res
@ -355,7 +355,7 @@ let get_fields_nullified procdesc =
(nullified_flds, Ident.IdentSet.add id this_ids) (nullified_flds, Ident.IdentSet.add id this_ids)
| _ -> (nullified_flds, this_ids) in | _ -> (nullified_flds, this_ids) in
let (nullified_flds, _) = let (nullified_flds, _) =
Cfg.Procdesc.fold_instrs Procdesc.fold_instrs
collect_nullified_flds (Ident.FieldSet.empty, Ident.IdentSet.empty) procdesc in collect_nullified_flds (Ident.FieldSet.empty, Ident.IdentSet.empty) procdesc in
nullified_flds 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 val get_type_name : Typ.t -> string
(** Get the type names of a variable argument *) (** 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 : 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. *) (** Check if the method is one of the known initializer methods. *)
val method_is_initializer : Tenv.t -> ProcAttributes.t -> bool 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 val java_get_const_type_name : Const.t -> string
(** Get the values of a vararg parameter given the pvar used to assign the elements. *) (** 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 val java_proc_name_with_class_method : Procname.java -> string -> string -> bool
(** Return the callees that satisfy [filter]. *) (** Return the callees that satisfy [filter]. *)
val proc_calls : val proc_calls :
(Procname.t -> ProcAttributes.t option) -> (Procname.t -> ProcAttributes.t option) ->
Cfg.Procdesc.t -> Procdesc.t ->
(Procname.t -> ProcAttributes.t -> bool) -> (Procname.t -> ProcAttributes.t -> bool) ->
(Procname.t * ProcAttributes.t) list (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 val type_is_object : Typ.t -> bool
(** return the set of instance fields that are assigned to a null literal in [procdesc] *) (** 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 *) (** [is_exception tenv class_name] checks if class_name is of type java.lang.Exception *)
val is_exception : Tenv.t -> Typename.t -> bool 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 printf_args_name = "CHECKERS_PRINTF_ARGS"
let check_printf_args_ok tenv let check_printf_args_ok tenv
(node: Cfg.Node.t) (node: Procdesc.Node.t)
(instr: Sil.instr) (instr: Sil.instr)
(proc_name: Procname.t) (proc_name: Procname.t)
(proc_desc: Cfg.Procdesc.t): unit = (proc_desc: Procdesc.t): unit =
(* Check if format string lines up with arguments *) (* 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 = 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 -> ( | Some printf -> (
try try
let fmt, fixed_nvars, array_nvar = format_arguments printf args in 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 fixed_nvar_type_names = IList.map (fixed_nvar_type_name instrs) fixed_nvars in
let vararg_ivar_type_names = match array_nvar with let vararg_ivar_type_names = match array_nvar with
| Some nvar -> ( | Some nvar -> (
@ -212,7 +212,7 @@ let check_printf_args_ok tenv
| _ -> () | _ -> ()
let callback_printf_args { Callbacks.tenv; proc_desc; proc_name } : unit = 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 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 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 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 t
type id type id
val kind : t -> Cfg.Node.nodekind val kind : t -> Procdesc.Node.nodekind
val id : t -> id val id : t -> id
val loc : t -> Location.t 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 id_compare : id -> id -> int
val pp_id : F.formatter -> id -> unit val pp_id : F.formatter -> id -> unit
end end
module DefaultNode = struct module DefaultNode = struct
type t = Cfg.Node.t type t = Procdesc.Node.t
type id = Cfg.Node.id type id = Procdesc.Node.id
let kind = Cfg.Node.get_kind let kind = Procdesc.Node.get_kind
let id = Cfg.Node.get_id let id = Procdesc.Node.get_id
let loc = Cfg.Node.get_loc let loc = Procdesc.Node.get_loc
let underlying_id = id let underlying_id = id
let id_compare = Cfg.Node.id_compare let id_compare = Procdesc.Node.id_compare
let pp_id = Cfg.Node.pp_id let pp_id = Procdesc.Node.pp_id
end end
module InstrNode = struct module InstrNode = struct
type t = Cfg.Node.t type t = Procdesc.Node.t
type id = Cfg.Node.id * index 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 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 let index_compare index1 index2 = match index1, index2 with
| Node_index, Node_index -> 0 | Node_index, Node_index -> 0
@ -60,13 +60,13 @@ module InstrNode = struct
| Instr_index _, Node_index -> -1 | Instr_index _, Node_index -> -1
let id_compare (id1, index1) (id2, index2) = 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 if n <> 0 then n
else index_compare index1 index2 else index_compare index1 index2
let pp_id fmt (id, index) = match index with let pp_id fmt (id, index) = match index with
| Node_index -> Cfg.Node.pp_id fmt id | Node_index -> Procdesc.Node.pp_id fmt id
| Instr_index i -> F.fprintf fmt "(%a: %d)" Cfg.Node.pp_id id i | Instr_index i -> F.fprintf fmt "(%a: %d)" Procdesc.Node.pp_id id i
end end
module type S = sig module type S = sig
@ -104,74 +104,74 @@ module type S = sig
val exit_node : t -> node val exit_node : t -> node
val proc_desc : t -> Cfg.Procdesc.t val proc_desc : t -> Procdesc.t
val nodes : t -> node list val nodes : t -> node list
val from_pdesc : Cfg.Procdesc.t -> t val from_pdesc : Procdesc.t -> t
end end
(** Forward CFG with no exceptional control-flow *) (** Forward CFG with no exceptional control-flow *)
module Normal = struct module Normal = struct
type t = Cfg.Procdesc.t type t = Procdesc.t
type node = DefaultNode.t type node = DefaultNode.t
include (DefaultNode : module type of DefaultNode with type t := node) 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 instr_ids n = IList.map (fun i -> i, None) (instrs n)
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
(* prune away exceptional control flow *) (* prune away exceptional control flow *)
let exceptional_succs _ _ = [] let exceptional_succs _ _ = []
let exceptional_preds _ _ = [] let exceptional_preds _ _ = []
let succs = normal_succs let succs = normal_succs
let preds = normal_preds let preds = normal_preds
let start_node = Cfg.Procdesc.get_start_node let start_node = Procdesc.get_start_node
let exit_node = Cfg.Procdesc.get_exit_node let exit_node = Procdesc.get_exit_node
let proc_desc t = t let proc_desc t = t
let nodes = Cfg.Procdesc.get_nodes let nodes = Procdesc.get_nodes
let from_pdesc pdesc = pdesc let from_pdesc pdesc = pdesc
end end
(** Forward CFG with exceptional control-flow *) (** Forward CFG with exceptional control-flow *)
module Exceptional = struct module Exceptional = struct
type node = DefaultNode.t type node = DefaultNode.t
type id_node_map = node list Cfg.IdMap.t type id_node_map = node list Procdesc.IdMap.t
type t = Cfg.Procdesc.t * id_node_map type t = Procdesc.t * id_node_map
include (DefaultNode : module type of DefaultNode with type t := node) include (DefaultNode : module type of DefaultNode with type t := node)
let from_pdesc pdesc = let from_pdesc pdesc =
(* map from a node to its exceptional predecessors *) (* map from a node to its exceptional predecessors *)
let add_exn_preds exn_preds_acc n = let add_exn_preds exn_preds_acc n =
let add_exn_pred exn_preds_acc exn_succ_node = 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 = 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 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 *) 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 else
exn_preds_acc in 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 = 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 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 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 = 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 -> [] with Not_found -> []
(** get all normal and exceptional successors of [n]. *) (** get all normal and exceptional successors of [n]. *)
@ -182,8 +182,8 @@ module Exceptional = struct
normal_succs normal_succs
| exceptional_succs -> | exceptional_succs ->
normal_succs @ exceptional_succs normal_succs @ exceptional_succs
|> IList.sort Cfg.Node.compare |> IList.sort Procdesc.Node.compare
|> IList.remove_duplicates Cfg.Node.compare |> IList.remove_duplicates Procdesc.Node.compare
(** get all normal and exceptional predecessors of [n]. *) (** get all normal and exceptional predecessors of [n]. *)
let preds t n = let preds t n =
@ -193,12 +193,12 @@ module Exceptional = struct
normal_preds normal_preds
| exceptional_preds -> | exceptional_preds ->
normal_preds @ exceptional_preds normal_preds @ exceptional_preds
|> IList.sort Cfg.Node.compare |> IList.sort Procdesc.Node.compare
|> IList.remove_duplicates Cfg.Node.compare |> IList.remove_duplicates Procdesc.Node.compare
let proc_desc (pdesc, _) = pdesc let proc_desc (pdesc, _) = pdesc
let start_node (pdesc, _) = Cfg.Procdesc.get_start_node pdesc let start_node (pdesc, _) = Procdesc.get_start_node pdesc
let exit_node (pdesc, _) = Cfg.Procdesc.get_exit_node pdesc let exit_node (pdesc, _) = Procdesc.get_exit_node pdesc
end end
(** Wrapper that reverses the direction of the CFG *) (** Wrapper that reverses the direction of the CFG *)
@ -217,9 +217,9 @@ module Backward (Base : S) = struct
let exceptional_preds = Base.exceptional_succs let exceptional_preds = Base.exceptional_succs
end end
module OneInstrPerNode (Base : S with type node = Cfg.Node.t module OneInstrPerNode (Base : S with type node = Procdesc.Node.t
and type id = Cfg.Node.id) = struct and type id = Procdesc.Node.id) = struct
include (Base : module type of Base with type id := Cfg.Node.id and type t = Base.t) include (Base : module type of Base with type id := Procdesc.Node.id and type t = Base.t)
type id = Base.id * index type id = Base.id * index
include (InstrNode : module type of InstrNode with type t := node and type id := id) 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 = let instr_ids t =
IList.mapi IList.mapi
(fun i instr -> (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) instr, Some id)
(instrs t) (instrs t)
end end

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

@ -17,10 +17,10 @@ module type Node = sig
type t type t
type id type id
val kind : t -> Cfg.Node.nodekind val kind : t -> Procdesc.Node.nodekind
val id : t -> id val id : t -> id
val loc : t -> Location.t 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 id_compare : id -> id -> int
val pp_id : Format.formatter -> id -> unit val pp_id : Format.formatter -> id -> unit
end end
@ -60,24 +60,24 @@ module type S = sig
val exit_node : t -> node val exit_node : t -> node
val proc_desc : t -> Cfg.Procdesc.t val proc_desc : t -> Procdesc.t
val nodes : t -> node list val nodes : t -> node list
val from_pdesc : Cfg.Procdesc.t -> t val from_pdesc : Procdesc.t -> t
end 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 *) (** 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 node = DefaultNode.t
and type id = DefaultNode.id and type id = DefaultNode.id
(** Forward CFG with exceptional control-flow *) (** 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 node = DefaultNode.t
and type id = DefaultNode.id and type id = DefaultNode.id

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

@ -9,7 +9,7 @@
open! Utils 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 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. * 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 type no_extras
val empty_extras : 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 -> | Sil.Call (_, Exp.Const (Const.Cfun pn), _, loc, _) when proc_is_new pn ->
found := Some loc found := Some loc
| _ -> () in | _ -> () in
IList.iter do_instr (Cfg.Node.get_instrs node); IList.iter do_instr (Procdesc.Node.get_instrs node);
!found in !found in
let module DFAllocCheck = Dataflow.MakeDF(struct let module DFAllocCheck = Dataflow.MakeDF(struct
@ -98,7 +98,7 @@ struct
end) in end) in
let transitions = DFAllocCheck.run tenv pdesc None 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.Transition (loc, _, _) -> loc
| DFAllocCheck.Dead_state -> None | DFAllocCheck.Dead_state -> None
@ -144,7 +144,7 @@ struct
let () = match get_proc_desc callee_pname with let () = match get_proc_desc callee_pname with
| None -> () | None -> ()
| Some proc_desc -> | Some proc_desc ->
if Cfg.Procdesc.is_defined proc_desc if Procdesc.is_defined proc_desc
then report proc_desc in then report proc_desc in
add_call instr_normalized_args extension add_call instr_normalized_args extension
| _ -> 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 try
let const_map = ConstantPropagation.build_const_map tenv proc_desc in let const_map = ConstantPropagation.build_const_map tenv proc_desc in
if verbose then L.stdout "Analyzing %a...\n@." Procname.pp proc_name; 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 _ -> () 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 val write_summary : Procname.t -> summary -> unit
(* read and return the summary for [callee_pname] called from [caller_pdesc]. does the analysis to (* read and return the summary for [callee_pname] called from [caller_pdesc]. does the analysis to
create the summary if needed *) 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 end
module Make (H : Helper) = struct 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 | ContextClsDeclPtr of Clang_ast_t.pointer
| ContextNoCls | ContextNoCls
type str_node_map = (string, Cfg.Node.t) Hashtbl.t type str_node_map = (string, Procdesc.Node.t) Hashtbl.t
type t = type t =
{ {
@ -30,7 +30,7 @@ type t =
tenv : Tenv.t; tenv : Tenv.t;
cg : Cg.t; cg : Cg.t;
cfg : Cfg.cfg; cfg : Cfg.cfg;
procdesc : Cfg.Procdesc.t; procdesc : Procdesc.t;
is_objc_method : bool; is_objc_method : bool;
curr_class: curr_class; curr_class: curr_class;
return_param_typ : Typ.t option; return_param_typ : Typ.t option;
@ -65,7 +65,7 @@ let rec is_objc_instance context =
match context.outer_context with match context.outer_context with
| Some outer_context -> is_objc_instance outer_context | Some outer_context -> is_objc_instance outer_context
| None -> | None ->
let attrs = Cfg.Procdesc.get_attributes context.procdesc in let attrs = Procdesc.get_attributes context.procdesc in
attrs.ProcAttributes.is_objc_instance_method attrs.ProcAttributes.is_objc_instance_method
let rec get_curr_class context = let rec get_curr_class context =
@ -157,4 +157,4 @@ let static_vars_for_block context block_name =
let rec get_outer_procname context = let rec get_outer_procname context =
match context.outer_context with match context.outer_context with
| Some outer_context -> get_outer_procname outer_context | 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 | ContextClsDeclPtr of Clang_ast_t.pointer
| ContextNoCls | ContextNoCls
type str_node_map = (string, Cfg.Node.t) Hashtbl.t type str_node_map = (string, Procdesc.Node.t) Hashtbl.t
type t = type t =
{ {
@ -28,7 +28,7 @@ type t =
tenv : Tenv.t; tenv : Tenv.t;
cg : Cg.t; cg : Cg.t;
cfg : Cfg.cfg; cfg : Cfg.cfg;
procdesc : Cfg.Procdesc.t; procdesc : Procdesc.t;
is_objc_method : bool; is_objc_method : bool;
curr_class: curr_class; curr_class: curr_class;
return_param_typ : Typ.t option; return_param_typ : Typ.t option;
@ -38,7 +38,7 @@ type t =
label_map : str_node_map; label_map : str_node_map;
} }
val get_procdesc : t -> Cfg.Procdesc.t val get_procdesc : t -> Procdesc.t
val get_cfg : t -> Cfg.cfg val get_cfg : t -> Cfg.cfg
@ -61,7 +61,7 @@ val is_objc_method : t -> bool
val get_tenv : t -> Tenv.t val get_tenv : t -> Tenv.t
val create_context : CFrontend_config.translation_unit_context -> Tenv.t -> Cg.t -> Cfg.cfg -> 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 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 try
(match Cfg.find_proc_desc_from_name cfg procname with (match Cfg.find_proc_desc_from_name cfg procname with
| Some procdesc -> | 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 = (let context =
CContext.create_context trans_unit_ctx tenv cg cfg procdesc class_decl_opt CContext.create_context trans_unit_ctx tenv cg cfg procdesc class_decl_opt
has_return_param is_objc_method outer_context_opt in has_return_param is_objc_method outer_context_opt in
let start_node = Cfg.Procdesc.get_start_node procdesc in let start_node = Procdesc.get_start_node procdesc in
let exit_node = Cfg.Procdesc.get_exit_node procdesc in let exit_node = Procdesc.get_exit_node procdesc in
Logging.out_debug Logging.out_debug
"\n\n>>---------- Start translating body of function: '%s' ---------<<\n@." "\n\n>>---------- Start translating body of function: '%s' ---------<<\n@."
(Procname.to_string procname); (Procname.to_string procname);
let meth_body_nodes = T.instructions_trans context body extra_instrs exit_node in let meth_body_nodes = T.instructions_trans context body extra_instrs exit_node in
let proc_attributes = Cfg.Procdesc.get_attributes procdesc in let proc_attributes = Procdesc.get_attributes procdesc in
Cfg.Node.add_locals_ret_declaration Procdesc.Node.add_locals_ret_declaration
start_node proc_attributes (Cfg.Procdesc.get_locals procdesc); start_node proc_attributes (Procdesc.get_locals procdesc);
Cfg.Procdesc.node_set_succs_exn procdesc start_node meth_body_nodes []; 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)) Cg.add_defined_node (CContext.get_cg context) (Procdesc.get_proc_name procdesc))
| None -> ()) | None -> ())
with with
| Not_found -> () | 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 = let should_create_procdesc cfg procname defined =
match Cfg.find_proc_desc_from_name cfg procname with match Cfg.find_proc_desc_from_name cfg procname with
| Some previous_procdesc -> | 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 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) true)
else false else false
| None -> true | 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 Cfg.create_proc_desc cfg proc_attributes in
if defined then if defined then
(if !Config.arc_mode then (if !Config.arc_mode then
Cfg.Procdesc.set_flag procdesc Mleak_buckets.objc_arc_flag "true"; Procdesc.set_flag procdesc Mleak_buckets.objc_arc_flag "true";
let start_kind = Cfg.Node.Start_node proc_name in let start_kind = Procdesc.Node.Start_node proc_name in
let start_node = Cfg.Procdesc.create_node procdesc loc_start start_kind [] in let start_node = Procdesc.create_node procdesc loc_start start_kind [] in
let exit_kind = Cfg.Node.Exit_node proc_name in let exit_kind = Procdesc.Node.Exit_node proc_name in
let exit_node = Cfg.Procdesc.create_node procdesc loc_exit exit_kind [] in let exit_node = Procdesc.create_node procdesc loc_exit exit_kind [] in
Cfg.Procdesc.set_start_node procdesc start_node; Procdesc.set_start_node procdesc start_node;
Cfg.Procdesc.set_exit_node procdesc exit_node) in Procdesc.set_exit_node procdesc exit_node) in
if should_create_procdesc cfg proc_name defined then if should_create_procdesc cfg proc_name defined then
(create_new_procdesc (); true) (create_new_procdesc (); true)
else false 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 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. *) represent the translation of the stmts into sil. *)
val instructions_trans : CContext.t -> Clang_ast_t.stmt -> instr_type list -> 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 end
module type CFrontend = sig 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 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 && if !Config.arc_mode &&
not (CTrans_utils.is_owning_name method_name) && not (CTrans_utils.is_owning_name method_name) &&
ObjcInterface_decl.is_pointer_to_objc_class typ then 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 allocate_block trans_state block_name captured_vars loc =
let tenv = trans_state.context.CContext.tenv in let tenv = trans_state.context.CContext.tenv in
let procdesc = trans_state.context.CContext.procdesc 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 mk_field_from_captured_var (var, typ) =
let vname = Pvar.get_name var in let vname = Pvar.get_name var in
let qual_name = Ast_utils.make_qual_name_decl [block_name] (Mangled.to_string vname) 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 Ident.NameGenerator.set_current ident_state
let mk_temp_sil_var procdesc var_name_suffix = 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 Pvar.mk_tmp var_name_suffix procname
let mk_temp_sil_var_for_expr tenv procdesc var_name_prefix expr_info = 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 procdesc = context.CContext.procdesc in
let (pvar, typ) = mk_temp_sil_var_for_expr context.CContext.tenv procdesc let (pvar, typ) = mk_temp_sil_var_for_expr context.CContext.tenv procdesc
var_name expr_info in 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 Exp.Lvar pvar, typ
let create_call_instr trans_state return_type function_sil params_sil sil_loc 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 procdesc = trans_state.context.CContext.procdesc in
let pvar = mk_temp_sil_var procdesc "__temp_return_" 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 Exp.Lvar pvar in
(* It is very confusing - same expression has two different types in two contexts:*) (* 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 *) (* 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 this_expr_trans trans_state sil_loc class_type_ptr =
let context = trans_state.context in 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 name = CFrontend_config.this in
let pvar = Pvar.mk (Mangled.from_string name) procname in let pvar = Pvar.mk (Mangled.from_string name) procname in
let exp = Exp.Lvar pvar in let exp = Exp.Lvar pvar in
@ -600,7 +600,7 @@ struct
(* create the label root node into the hashtbl *) (* create the label root node into the hashtbl *)
let sil_loc = CLocation.get_sil_location stmt_info context in 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 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 } { 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) = 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) Typ.Tptr (ast_typ, Pk_reference)
else ast_typ else ast_typ
| _ -> ast_typ in | _ -> 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 sil_loc = CLocation.get_sil_location stmt_info context in
let pvar = CVar_decl.sil_var_of_decl_ref context decl_ref procname in let pvar = CVar_decl.sil_var_of_decl_ref context decl_ref procname in
CContext.add_block_static_var context procname (pvar, typ); CContext.add_block_static_var context procname (pvar, typ);
@ -750,7 +750,7 @@ struct
if res_trans_idx.root_nodes <> [] if res_trans_idx.root_nodes <> []
then then
IList.iter 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; res_trans_a.leaf_nodes;
(* Note the order of res_trans_idx.ids @ res_trans_a.ids is important. *) (* 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 context = trans_state.context in
let fn_type_no_ref = CType_decl.get_type_from_expr_info expr_info context.CContext.tenv 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 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 let sil_loc = CLocation.get_sil_location si context in
(* First stmt is the function expr and the rest are params *) (* First stmt is the function expr and the rest are params *)
let fun_exp_stmt, params_stmt = (match stmt_list with 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 = si function_type is_cpp_call_virtual extra_res_trans =
let open CContext in let open CContext in
let context = trans_state_pri.context 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 let sil_loc = CLocation.get_sil_location si context in
(* first for method address, second for 'this' expression *) (* first for method address, second for 'this' expression *)
assert ((IList.length result_trans_callee.exps) = 2); assert ((IList.length result_trans_callee.exps) = 2);
@ -973,9 +973,9 @@ struct
| Some exp_typ -> exp_typ | Some exp_typ -> exp_typ
| None -> | None ->
let procdesc = trans_state.context.CContext.procdesc in 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 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 Exp.Lvar pvar, class_type in
let this_type = Typ.Tptr (class_type, Typ.Pk_pointer) in let this_type = Typ.Tptr (class_type, Typ.Pk_pointer) in
let this_res_trans = { empty_res_trans with let this_res_trans = { empty_res_trans with
@ -1067,7 +1067,7 @@ struct
method_type trans_state_pri sil_loc subexpr_exprs with method_type trans_state_pri sil_loc subexpr_exprs with
| Some res -> res | Some res -> res
| None -> | 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 let callee_name, method_call_type = get_callee_objc_method context obj_c_message_expr_info
subexpr_exprs in subexpr_exprs in
let res_trans_add_self = Self.add_self_parameter_for_super_instance context procname sil_loc 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 = 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@."; 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 pvar = CFrontend_utils.General_utils.get_next_block_pvar procname in
let transformed_stmt, _ = let transformed_stmt, _ =
Ast_expressions.translate_block_enumerate (Pvar.to_string pvar) stmt_info stmt_list ei in 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_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 let prune_nodes' = if branch then prune_nodes_t else prune_nodes_f in
IList.iter 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 prune_nodes' in
(match stmt_list with (match stmt_list with
| [cond; exp1; exp2] -> | [cond; exp1; exp2] ->
@ -1140,10 +1140,10 @@ struct
CType_decl.type_ptr_to_sil_type CType_decl.type_ptr_to_sil_type
context.CContext.tenv expr_info.Clang_ast_t.ei_type_ptr in context.CContext.tenv expr_info.Clang_ast_t.ei_type_ptr in
let var_typ = add_reference_if_glvalue typ expr_info 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 let join_node = create_node (Procdesc.Node.Join_node) [] sil_loc context in
Cfg.Procdesc.node_set_succs_exn context.procdesc join_node succ_nodes []; Procdesc.node_set_succs_exn context.procdesc join_node succ_nodes [];
let pvar = mk_temp_sil_var procdesc "SIL_temp_conditional___" in 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 continuation' = mk_cond_continuation trans_state.continuation in
let trans_state' = { trans_state with continuation = continuation'; succ_nodes = [] } 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 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_t = mk_prune_node true e' instrs' in
let prune_f = mk_prune_node false e' instrs' in let prune_f = mk_prune_node false e' instrs' in
IList.iter 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; res_trans_cond.leaf_nodes;
let rnodes = if (IList.length res_trans_cond.root_nodes) = 0 then let rnodes = if (IList.length res_trans_cond.root_nodes) = 0 then
[prune_t; prune_f] [prune_t; prune_f]
@ -1247,7 +1247,7 @@ struct
| Binop.LOr -> prune_nodes_f, prune_nodes_t | Binop.LOr -> prune_nodes_f, prune_nodes_t
| _ -> assert false) in | _ -> assert false) in
IList.iter 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; prune_to_s2;
let root_nodes_to_parent = let root_nodes_to_parent =
if (IList.length res_trans_s1.root_nodes) = 0 if (IList.length res_trans_s1.root_nodes) = 0
@ -1287,8 +1287,8 @@ struct
let context = trans_state.context in let context = trans_state.context in
let succ_nodes = trans_state.succ_nodes in let succ_nodes = trans_state.succ_nodes in
let sil_loc = CLocation.get_sil_location stmt_info context 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
Cfg.Procdesc.node_set_succs_exn context.procdesc join_node succ_nodes []; Procdesc.node_set_succs_exn context.procdesc join_node succ_nodes [];
let trans_state' = { trans_state with succ_nodes = [join_node] } in let trans_state' = { trans_state with succ_nodes = [join_node] } in
let do_branch branch stmt_branch prune_nodes = let do_branch branch stmt_branch prune_nodes =
(* leaf nodes are ignored here as they will be already attached to join_node *) (* leaf nodes are ignored here as they will be already attached to join_node *)
@ -1296,13 +1296,14 @@ struct
let nodes_branch = let nodes_branch =
(match res_trans_b.root_nodes with (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 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_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 let prune_nodes' = if branch then prune_nodes_t else prune_nodes_f in
IList.iter 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 prune_nodes' in
(match stmt_list with (match stmt_list with
| [_; decl_stmt; cond; stmt1; stmt2] -> | [_; decl_stmt; cond; stmt1; stmt2] ->
@ -1336,11 +1337,11 @@ struct
let trans_state' ={ trans_state_pri with succ_nodes = []} in let trans_state' ={ trans_state_pri with succ_nodes = []} in
let res_trans_cond_tmp = instruction trans_state' cond in let res_trans_cond_tmp = instruction trans_state' cond in
let switch_special_cond_node = 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 create_node node_kind res_trans_cond_tmp.instrs sil_loc context in
IList.iter IList.iter
(fun n' -> (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; res_trans_cond_tmp.leaf_nodes;
let root_nodes = let root_nodes =
if res_trans_cond_tmp.root_nodes <> [] then res_trans_cond_tmp.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 let case_entry_point = connected_instruction (IList.rev case_content) last_nodes in
(* connects between cases, then continuation has priority about breaks *) (* connects between cases, then continuation has priority about breaks *)
let prune_node_t, prune_node_f = create_prune_nodes_for_case case in 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 []; 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_f last_prune_nodes [];
case_entry_point, [prune_node_t; prune_node_f] case_entry_point, [prune_node_t; prune_node_f]
| DefaultStmt(stmt_info, default_content) :: rest -> | DefaultStmt(stmt_info, default_content) :: rest ->
let sil_loc = CLocation.get_sil_location stmt_info context in let sil_loc = CLocation.get_sil_location stmt_info context in
let placeholder_entry_point = 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 = let last_nodes, last_prune_nodes =
translate_and_connect_cases rest next_nodes [placeholder_entry_point] in translate_and_connect_cases rest next_nodes [placeholder_entry_point] in
let default_entry_point = let default_entry_point =
connected_instruction (IList.rev default_content) last_nodes in 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 []; context.procdesc placeholder_entry_point default_entry_point [];
default_entry_point, last_prune_nodes default_entry_point, last_prune_nodes
| _ -> assert false in | _ -> assert false in
let top_entry_point, top_prune_nodes = let top_entry_point, top_prune_nodes =
translate_and_connect_cases list_of_cases succ_nodes succ_nodes in translate_and_connect_cases list_of_cases succ_nodes succ_nodes in
let _ = connected_instruction (IList.rev pre_case_stmts) top_entry_point 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 []; context.procdesc switch_special_cond_node top_prune_nodes [];
let top_nodes = res_trans_decl.root_nodes in let top_nodes = res_trans_decl.root_nodes in
IList.iter 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 *) (* succ_nodes will remove the temps *)
{ empty_res_trans with root_nodes = top_nodes; leaf_nodes = succ_nodes } { empty_res_trans with root_nodes = top_nodes; leaf_nodes = succ_nodes }
| _ -> assert false | _ -> assert false
@ -1480,7 +1482,7 @@ struct
let context = trans_state.context in let context = trans_state.context in
let succ_nodes = trans_state.succ_nodes in let succ_nodes = trans_state.succ_nodes in
let sil_loc = CLocation.get_sil_location stmt_info context 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 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 *) (* set the flat to inform that we are translating a condition of a if *)
let continuation_cond = mk_cond_continuation outer_continuation in let continuation_cond = mk_cond_continuation outer_continuation in
@ -1538,12 +1540,12 @@ struct
match loop_kind with match loop_kind with
| Loops.For _ | Loops.While _ -> res_trans_body.root_nodes | Loops.For _ | Loops.While _ -> res_trans_body.root_nodes
| Loops.DoWhile _ -> [join_node] in | 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 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; prune_nodes_t;
IList.iter 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; prune_nodes_f;
let root_nodes = let root_nodes =
match loop_kind with match loop_kind with
@ -1719,7 +1721,7 @@ struct
let open Clang_ast_t in let open Clang_ast_t in
let context = trans_state.context in let context = trans_state.context in
let procdesc = context.CContext.procdesc 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 do_var_dec (di, var_name, qual_type, vdi) next_node =
let var_decl = VarDecl (di, var_name, qual_type, vdi) in let var_decl = VarDecl (di, var_name, qual_type, vdi) in
let pvar = CVar_decl.sil_var_of_decl context var_decl procname 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 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 trans_state_pri = PriorityNode.try_claim_priority_node trans_state stmt_info in
let mk_ret_node instrs = let mk_ret_node instrs =
let ret_node = create_node (Cfg.Node.Stmt_node "Return Stmt") instrs sil_loc context in let ret_node = create_node (Procdesc.Node.Stmt_node "Return Stmt") instrs sil_loc context in
Cfg.Procdesc.node_set_succs_exn Procdesc.node_set_succs_exn
context.procdesc context.procdesc
ret_node [(Cfg.Procdesc.get_exit_node context.CContext.procdesc)] []; ret_node [(Procdesc.get_exit_node context.CContext.procdesc)] [];
ret_node in ret_node in
let trans_result = (match stmt_list with let trans_result = (match stmt_list with
| [stmt] -> (* return exp; *) | [stmt] -> (* return exp; *)
let procdesc = context.CContext.procdesc in 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 let ret_exp, ret_typ, var_instrs = match context.CContext.return_param_typ with
| Some ret_param_typ -> | Some ret_param_typ ->
let name = CFrontend_config.return_param in 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 pvar = Pvar.mk (Mangled.from_string name) procname in
let id = Ident.create_fresh Ident.knormal in let id = Ident.create_fresh Ident.knormal in
let instr = Sil.Load (id, Exp.Lvar pvar, ret_param_typ, sil_loc) 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 let ret_typ = match ret_param_typ with Typ.Tptr (t, _) -> t | _ -> assert false in
Exp.Var id, ret_typ, [instr] Exp.Var id, ret_typ, [instr]
| None -> | 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 let trans_state' = { trans_state_pri with
succ_nodes = []; succ_nodes = [];
var_exp_typ = Some (ret_exp, ret_typ) } in 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 instrs = var_instrs @ res_trans_stmt.instrs @ ret_instrs @ autorelease_instrs in
let ret_node = mk_ret_node instrs in let ret_node = mk_ret_node instrs in
IList.iter 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; res_trans_stmt.leaf_nodes;
let root_nodes_to_parent = let root_nodes_to_parent =
if IList.length res_trans_stmt.root_nodes >0 if IList.length res_trans_stmt.root_nodes >0
@ -2011,9 +2013,9 @@ struct
Sil.Call Sil.Call
(ret_id, (Exp.Const (Const.Cfun fname)), (ret_id, (Exp.Const (Const.Cfun fname)),
autorelease_pool_vars, sil_loc, CallFlags.default) in 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 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 let trans_state'={ trans_state with continuation = None; succ_nodes =[call_node] } in
instructions trans_state' stmts instructions trans_state' stmts
@ -2029,7 +2031,7 @@ struct
and blockExpr_trans trans_state stmt_info expr_info decl = and blockExpr_trans trans_state stmt_info expr_info decl =
let context = trans_state.context in 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 = let loc =
(match stmt_info.Clang_ast_t.si_source_range with (l1, _) -> (match stmt_info.Clang_ast_t.si_source_range with (l1, _) ->
CLocation.clang_to_sil_location context.CContext.translation_unit_context l1) in 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 type_ptr = expr_info.Clang_ast_t.ei_type_ptr in
let context = trans_state.context in let context = trans_state.context in
call_translation context decl; 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 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 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 *) (* 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 let (pvar, typ) = mk_temp_sil_var_for_expr context.CContext.tenv procdesc
"SIL_materialize_temp__" expr_info in "SIL_materialize_temp__" expr_info in
let temp_exp = match stmt_list with [p] -> p | _ -> assert false 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 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 let res_trans = init_expr_trans trans_state var_exp_typ stmt_info (Some temp_exp) in
{ res_trans with exps = [var_exp_typ] } { 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 = module Nodes =
struct 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 = let is_join_node n =
match Cfg.Node.get_kind n with match Procdesc.Node.get_kind n with
| Cfg.Node.Join_node -> true | Procdesc.Node.Join_node -> true
| _ -> false | _ -> false
let is_prune_node n = let is_prune_node n =
match Cfg.Node.get_kind n with match Procdesc.Node.get_kind n with
| Cfg.Node.Prune_node _ -> true | Procdesc.Node.Prune_node _ -> true
| _ -> false | _ -> false
let is_true_prune_node n = let is_true_prune_node n =
match Cfg.Node.get_kind n with match Procdesc.Node.get_kind n with
| Cfg.Node.Prune_node(true, _, _) -> true | Procdesc.Node.Prune_node(true, _, _) -> true
| _ -> false | _ -> false
let create_node node_kind instrs loc context = let create_node node_kind instrs loc context =
let procdesc = CContext.get_procdesc context in 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 create_prune_node branch e_cond instrs_cond loc ik context =
let (e_cond', _) = extract_exp_from_list e_cond let (e_cond', _) = extract_exp_from_list e_cond
@ -92,14 +92,14 @@ struct
Hashtbl.find context.CContext.label_map label Hashtbl.find context.CContext.label_map label
with Not_found -> with Not_found ->
let node_name = Format.sprintf "GotoLabel_%s" label in 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; Hashtbl.add context.CContext.label_map label new_node;
new_node new_node
end end
type continuation = { type continuation = {
break: Cfg.Node.t list; break: Procdesc.Node.t list;
continue: Cfg.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 *) 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. *) (* it need to carry on the tranlsation. *)
type trans_state = { type trans_state = {
context: CContext.t; (* current context of the translation *) 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 *) continuation: continuation option; (* current continuation *)
priority: priority_node; priority: priority_node;
var_exp_typ: (Exp.t * Typ.t) option; 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. *) (* A translation result. It is returned by the translation function. *)
type trans_result = { type trans_result = {
root_nodes: Cfg.Node.t list; (* Top cfg nodes (root) created by the translation *) root_nodes: Procdesc.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 *) 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*) 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 *) exps: (Exp.t * Typ.t) list; (* SIL expressions resulting from translation of clang stmt *)
initd_exps: Exp.t list; initd_exps: Exp.t list;
@ -171,7 +171,7 @@ let collect_res_trans pdesc l =
else rt.leaf_nodes in else rt.leaf_nodes in
if rt'.root_nodes <> [] then if rt'.root_nodes <> [] then
IList.iter 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; rt.leaf_nodes;
collect l' collect l'
{ root_nodes = root_nodes; { root_nodes = root_nodes;
@ -244,11 +244,11 @@ struct
let create_node = own_priority_node trans_state.priority stmt_info && res_state.instrs <> [] in let create_node = own_priority_node trans_state.priority stmt_info && res_state.instrs <> [] in
if create_node then if create_node then
(* We need to create a node *) (* 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 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 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; res_state.leaf_nodes;
(* Invariant: if root_nodes is empty then the params have not created a node.*) (* 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 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 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 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 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 = and failure_node =
Nodes.create_node (Cfg.Node.Stmt_node "Assertion failure") [call_instr] sil_loc context in Nodes.create_node (Procdesc.Node.Stmt_node "Assertion failure") [call_instr] sil_loc context in
Cfg.Procdesc.node_set_succs_exn context.procdesc failure_node [exit_node] []; Procdesc.node_set_succs_exn context.procdesc failure_node [exit_node] [];
{ empty_res_trans with root_nodes = [failure_node]; } { empty_res_trans with root_nodes = [failure_node]; }
let trans_assume_false sil_loc (context : CContext.t) succ_nodes = 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 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 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] } { empty_res_trans with root_nodes = [prune_node]; leaf_nodes = [prune_node] }
let trans_assertion trans_state sil_loc = 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. *) (** Utility methods to support the translation of clang ast constructs into sil instructions. *)
type continuation = { type continuation = {
break: Cfg.Node.t list; break: Procdesc.Node.t list;
continue: Cfg.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 *) 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 = { type trans_state = {
context: CContext.t; context: CContext.t;
succ_nodes: Cfg.Node.t list; succ_nodes: Procdesc.Node.t list;
continuation: continuation option; continuation: continuation option;
priority: priority_node; priority: priority_node;
var_exp_typ: (Exp.t * Typ.t) option; var_exp_typ: (Exp.t * Typ.t) option;
@ -32,8 +32,8 @@ type trans_state = {
} }
type trans_result = { type trans_result = {
root_nodes: Cfg.Node.t list; root_nodes: Procdesc.Node.t list;
leaf_nodes: Cfg.Node.t list; leaf_nodes: Procdesc.Node.t list;
instrs: Sil.instr list; instrs: Sil.instr list;
exps: (Exp.t * Typ.t) list; exps: (Exp.t * Typ.t) list;
initd_exps: Exp.t list; initd_exps: Exp.t list;
@ -44,7 +44,7 @@ val empty_res_trans: trans_result
val undefined_expression: unit -> Exp.t 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 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 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 : val create_prune_node :
bool -> (Exp.t * Typ.t) list -> Sil.instr list -> Location.t -> Sil.if_kind -> 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 end
@ -175,7 +176,7 @@ end
(** Module for translating goto instructions by keeping a map of labels. *) (** Module for translating goto instructions by keeping a map of labels. *)
module GotoLabel : module GotoLabel :
sig 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 end
(** Module that provides utility functions for translating different types of loops. *) (** 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 match var_decl with
| VarDecl (_, _, _, vdi) -> | VarDecl (_, _, _, vdi) ->
if not vdi.Clang_ast_t.vdi_is_global then 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 | _ -> assert false
let rec compute_autorelease_pool_vars context stmts = 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 match stmts with
| [] -> [] | [] -> []
| Clang_ast_t.DeclRefExpr (_, _, _, drei):: stmts' -> | 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. *) (* Returns a list of captured variables as sil variables. *)
let captured_vars_from_block_info context cvl = 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 = let sil_var_of_captured_var cv vars =
match cv.Clang_ast_t.bcv_variable with match cv.Clang_ast_t.bcv_variable with
| Some dr -> | 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 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 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 let procs = Cfg.get_all_procs cfg in
Logging.do_out "%s" Logging.do_out "%s"
(IList.to_string (fun pdesc -> (IList.to_string (fun pdesc ->
let pname = Cfg.Procdesc.get_proc_name pdesc in let pname = Procdesc.get_proc_name pdesc in
"name> "^ "name> "^
(Procname.to_string pname) ^ (Procname.to_string pname) ^
" defined? " ^ (string_of_bool (Cfg.Procdesc.is_defined pdesc)) ^ "\n") " defined? " ^ (string_of_bool (Procdesc.is_defined pdesc)) ^ "\n")
procs) procs)
let print_nodes nodes = 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 instrs_to_string instrs =
let pp fmt () = Format.fprintf fmt "%a" (Sil.pp_instr_list pe_text) instrs in 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_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 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 = let update_summary proc_name proc_desc final_typestate_opt =
match Specs.get_summary proc_name with match Specs.get_summary proc_name with
| Some old_summ -> | 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 = let method_annotation =
(Specs.pdesc_resolve_attributes proc_desc).ProcAttributes.method_annotation in (Specs.pdesc_resolve_attributes proc_desc).ProcAttributes.method_annotation in
let new_summ = let new_summ =
@ -58,7 +58,7 @@ struct
Specs.attributes = Specs.attributes =
{ {
old_summ.Specs.attributes with old_summ.Specs.attributes with
ProcAttributes.loc = Cfg.Procdesc.get_loc proc_desc; ProcAttributes.loc = Procdesc.get_loc proc_desc;
method_annotation; method_annotation;
}; };
} in } in
@ -82,7 +82,7 @@ struct
(* Check the nullable flag computed for the return value and report inconsistencies. *) (* 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 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 ret_range = TypeState.lookup_pvar ret_pvar final_typestate in
let typ_found_opt = match ret_range with let typ_found_opt = match ret_range with
| Some (typ_found, _, _) -> Some typ_found | Some (typ_found, _, _) -> Some typ_found
@ -106,7 +106,7 @@ struct
(TypeState.pp Extension.ext) initial_typestate in (TypeState.pp Extension.ext) initial_typestate in
let do_after_dataflow find_canonical_duplicate final_typestate = 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 let ia, ret_type = annotated_signature.Annotations.ret in
check_return find_canonical_duplicate exit_node final_typestate ia ret_type proc_loc 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 -> IList.iter (fun typestate_succ ->
L.stdout L.stdout
"Typestate After Node %a@\n%a@." "Typestate After Node %a@\n%a@."
Cfg.Node.pp node Procdesc.Node.pp node
(TypeState.pp Extension.ext) typestate_succ) (TypeState.pp Extension.ext) typestate_succ)
typestates_succ; typestates_succ;
typestates_succ, typestates_exn typestates_succ, typestates_exn
@ -133,7 +133,7 @@ struct
let initial_typestate = get_initial_typestate () in let initial_typestate = get_initial_typestate () in
do_before_dataflow initial_typestate; do_before_dataflow initial_typestate;
let transitions = DFTypeCheck.run tenv curr_pdesc initial_typestate in 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, _, _) -> | DFTypeCheck.Transition (final_typestate, _, _) ->
do_after_dataflow find_canonical_duplicate final_typestate; do_after_dataflow find_canonical_duplicate final_typestate;
!calls_this, Some 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_duplicate_nodes = State.mk_find_duplicate_nodes curr_pdesc in
let find_canonical_duplicate node = let find_canonical_duplicate node =
let duplicate_nodes = find_duplicate_nodes node in 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 | Not_found -> node in
let typecheck_proc do_checks pname pdesc proc_details_opt = let typecheck_proc do_checks pname pdesc proc_details_opt =
@ -164,8 +164,8 @@ struct
(ann_sig, loc, idenv_pn) (ann_sig, loc, idenv_pn)
| None -> | None ->
let ann_sig = let ann_sig =
Models.get_modelled_annotated_signature (Cfg.Procdesc.get_attributes pdesc) in Models.get_modelled_annotated_signature (Procdesc.get_attributes pdesc) in
let loc = Cfg.Procdesc.get_loc pdesc in let loc = Procdesc.get_loc pdesc in
let idenv_pn = Idenv.create_from_idenv idenv pdesc in let idenv_pn = Idenv.create_from_idenv idenv pdesc in
(ann_sig, loc, idenv_pn) in (ann_sig, loc, idenv_pn) in
let checks', calls_this' = let checks', calls_this' =
@ -181,7 +181,7 @@ struct
pname pdesc ann_sig linereader loc in pname pdesc ann_sig linereader loc in
let module Initializers = struct let module Initializers = struct
type init = Procname.t * Cfg.Procdesc.t type init = Procname.t * Procdesc.t
let final_typestates initializers_current_class = let final_typestates initializers_current_class =
(* Get the private methods, from the same class, directly called by the initializers. *) (* 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_final_typestate typestate_opt calls_this =
let do_typestate typestate = 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 *) if not calls_this && (* if 'this(...)' is called, no need to check initialization *)
check_field_initialization && check_field_initialization &&
checks.TypeCheck.eradicate checks.TypeCheck.eradicate
@ -346,7 +346,7 @@ struct
match filter_special_cases () with match filter_special_cases () with
| None -> () | None -> ()
| Some annotated_signature -> | 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 let linereader = Printer.LineReader.create () in
if Config.eradicate_verbose then if Config.eradicate_verbose then
L.stdout "%a@." L.stdout "%a@."
@ -404,7 +404,7 @@ let callback_eradicate
Main.callback checks Main.callback checks
{ callback_args with { callback_args with
Callbacks.idenv = idenv_pname; Callbacks.idenv = idenv_pname;
proc_name = (Cfg.Procdesc.get_proc_name pdesc); proc_name = (Procdesc.get_proc_name pdesc);
proc_desc = pdesc; } in proc_desc = pdesc; } in
{ {
Ondemand.analyze_ondemand; 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 = let contains_instanceof_throwable pdesc node =
(* Check if the current procedure has a catch Throwable. *) (* Check if the current procedure has a catch Throwable. *)
(* That always happens in the bytecode generated by try-with-resources. *) (* 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 throwable_found = ref false in
let typ_is_throwable = function let typ_is_throwable = function
| Typ.Tstruct (TN_csu (Class Java, _) as name) -> | 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 throwable_found := true
| _ -> () in | _ -> () in
let do_node n = let do_node n =
if Location.equal loc (Cfg.Node.get_loc n) if Location.equal loc (Procdesc.Node.get_loc n)
then IList.iter do_instr (Cfg.Node.get_instrs n) in then IList.iter do_instr (Procdesc.Node.get_instrs n) in
Cfg.Procdesc.iter_nodes do_node pdesc; Procdesc.iter_nodes do_node pdesc;
!throwable_found in !throwable_found in
let from_try_with_resources () : bool = 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 let check_field_assignment tenv
find_canonical_duplicate curr_pdesc node instr_ref typestate exp_lhs find_canonical_duplicate curr_pdesc node instr_ref typestate exp_lhs
exp_rhs typ loc fname t_ia_opt typecheck_expr : unit = 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, _) = let (t_lhs, ta_lhs, _) =
typecheck_expr node instr_ref curr_pdesc typestate exp_lhs typecheck_expr node instr_ref curr_pdesc typestate exp_lhs
(typ, TypeAnnotation.const Annotations.Nullable false TypeOrigin.ONone, [loc]) loc in (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; State.set_node start_node;
if Procname.is_constructor curr_pname if Procname.is_constructor curr_pname
then begin 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, _)) -> ( | Some (Tptr (Tstruct name as ts, _)) -> (
match Tenv.lookup tenv name with match Tenv.lookup tenv name with
| Some { fields } -> | Some { fields } ->
@ -332,7 +332,7 @@ let spec_make_return_nullable curr_pname =
let check_return_annotation tenv let check_return_annotation tenv
find_canonical_duplicate curr_pdesc ret_range find_canonical_duplicate curr_pdesc ret_range
ret_ia ret_implicitly_nullable loc : unit = 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_nullable = Annotations.ia_is_nullable ret_ia in
let ret_annotated_present = Annotations.ia_is_present 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 let ret_annotated_nonnull = Annotations.ia_is_nonnull ret_ia in
@ -493,8 +493,8 @@ let check_call_parameters tenv
implemented interfaces *) implemented interfaces *)
let check_overridden_annotations let check_overridden_annotations
find_canonical_duplicate tenv proc_name proc_desc annotated_signature = find_canonical_duplicate tenv proc_name proc_desc annotated_signature =
let start_node = Cfg.Procdesc.get_start_node proc_desc in let start_node = Procdesc.get_start_node proc_desc in
let loc = Cfg.Node.get_loc start_node in let loc = Procdesc.Node.get_loc start_node in
let check_return overriden_proc_name overriden_signature = let check_return overriden_proc_name overriden_signature =
let ret_is_nullable = let ret_is_nullable =

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

@ -142,9 +142,9 @@ module ComplexExpressions = struct
end (* ComplexExpressions *) end (* ComplexExpressions *)
type check_return_type = 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 type get_proc_desc = TypeState.get_proc_desc
@ -157,7 +157,7 @@ type checks =
(** Typecheck an expression. *) (** Typecheck an expression. *)
let rec typecheck_expr 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 typestate e tr_default loc : TypeState.range = match e with
| Exp.Lvar pvar -> | Exp.Lvar pvar ->
(match TypeState.lookup_pvar pvar typestate with (match TypeState.lookup_pvar pvar typestate with
@ -236,11 +236,11 @@ let rec typecheck_expr
(** Typecheck an instruction. *) (** Typecheck an instruction. *)
let typecheck_instr 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 = curr_pdesc find_canonical_duplicate annotated_signature instr_ref linereader typestate instr =
(* let print_current_state () = *) (* let print_current_state () = *)
(* L.stdout "Current Typestate in node %a@\n%a@." *) (* 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; *) (* (TypeState.pp ext) typestate; *)
(* L.stdout " %a@." (Sil.pp_instr pe_text) instr in *) (* L.stdout " %a@." (Sil.pp_instr pe_text) instr in *)
@ -429,7 +429,7 @@ let typecheck_instr
annotated_signature.Annotations.params in annotated_signature.Annotations.params in
let is_return pvar = 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 Pvar.equal pvar ret_pvar in
(* Apply a function to a pvar and its associated content if front-end generated. *) (* Apply a function to a pvar and its associated content if front-end generated. *)
@ -702,7 +702,7 @@ let typecheck_instr
| _ -> () | _ -> ()
end end
| _ -> () in | _ -> () 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 = let handle_optional_isPresent node' e =
match convert_complex_exp_to_pvar node' false e typestate' loc with match convert_complex_exp_to_pvar node' false e typestate' loc with
| Exp.Lvar pvar', _ -> | Exp.Lvar pvar', _ ->
@ -718,7 +718,9 @@ let typecheck_instr
(* In foo(cond1 && cond2), the node that sets the result to false (* In foo(cond1 && cond2), the node that sets the result to false
has all the negated conditions as parents. *) has all the negated conditions as parents. *)
| Some boolean_assignment_node -> | 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 !res_typestate
| None -> | None ->
begin begin
@ -1018,7 +1020,7 @@ let typecheck_instr
(* Handle assigment fron a temp pvar in a condition. (* Handle assigment fron a temp pvar in a condition.
This recognizes the handling of temp variables in ((x = ...) != null) *) This recognizes the handling of temp variables in ((x = ...) != null) *)
let handle_assignment_in_condition pvar = let handle_assignment_in_condition pvar =
match Cfg.Node.get_preds node with match Procdesc.Node.get_preds node with
| [prev_node] -> | [prev_node] ->
let found = ref None in let found = ref None in
let do_instr i = match i with 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') -> when Exp.equal (Exp.Lvar pvar) (Idenv.expand_expr idenv e') ->
found := Some e found := Some e
| _ -> () in | _ -> () in
IList.iter do_instr (Cfg.Node.get_instrs prev_node); IList.iter do_instr (Procdesc.Node.get_instrs prev_node);
!found !found
| _ -> None in | _ -> None in
@ -1060,7 +1062,7 @@ let typecheck_node
tenv ext calls_this checks idenv get_proc_desc curr_pname curr_pdesc tenv ext calls_this checks idenv get_proc_desc curr_pname curr_pdesc
find_canonical_duplicate annotated_signature typestate node linereader = 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 instr_ref_gen = TypeErr.InstrRef.create_generator node in
let typestates_exn = ref [] in let typestates_exn = ref [] in
@ -1077,7 +1079,7 @@ let typecheck_node
typestates_exn := typestate :: !typestates_exn typestates_exn := typestate :: !typestates_exn
| Sil.Store (Exp.Lvar pv, _, _, _) when | Sil.Store (Exp.Lvar pv, _, _, _) when
Pvar.is_return pv && Pvar.is_return pv &&
Cfg.Node.get_kind node = Cfg.Node.throw_kind -> Procdesc.Node.get_kind node = Procdesc.Node.throw_kind ->
(* throw instruction *) (* throw instruction *)
typestates_exn := typestate :: !typestates_exn typestates_exn := typestate :: !typestates_exn
| _ -> () in | _ -> () in
@ -1099,6 +1101,6 @@ let typecheck_node
TypeErr.node_reset_forall canonical_node; TypeErr.node_reset_forall canonical_node;
let typestate_succ = IList.fold_left (do_instruction ext) typestate instrs in 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 *) then [], [] (* don't propagate exceptions to exit node *)
else [typestate_succ], !typestates_exn 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. *) (** Module type for the type checking functions. *)
type check_return_type = 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 type get_proc_desc = TypeState.get_proc_desc
@ -29,6 +29,6 @@ type checks =
val typecheck_node : val typecheck_node :
Tenv.t -> 'a TypeState.ext -> Tenv.t -> 'a TypeState.ext ->
bool ref -> checks -> Idenv.t -> 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 -> 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 sig
type t type t
type generator type generator
val create_generator : Cfg.Node.t -> generator val create_generator : Procdesc.Node.t -> generator
val equal : t -> t -> bool val equal : t -> t -> bool
val gen : generator -> t val gen : generator -> t
val get_node : t -> Cfg.Node.t val get_node : t -> Procdesc.Node.t
val hash : t -> int val hash : t -> int
val replace_node : t -> Cfg.Node.t -> t val replace_node : t -> Procdesc.Node.t -> t
end (* InstrRefT *) end (* InstrRefT *)
(** Per-node instruction reference. *) (** Per-node instruction reference. *)
module InstrRef : InstrRefT = module InstrRef : InstrRefT =
struct struct
type t = Cfg.Node.t * int type t = Procdesc.Node.t * int
type generator = Cfg.Node.t * int ref type generator = Procdesc.Node.t * int ref
let equal (n1, i1) (n2, i2) = let equal (n1, i1) (n2, i2) =
Cfg.Node.equal n1 n2 && i1 = i2 Procdesc.Node.equal n1 n2 && i1 = i2
let hash (n, i) = Hashtbl.hash (Cfg.Node.hash n, i) let hash (n, i) = Hashtbl.hash (Procdesc.Node.hash n, i)
let get_node (n, _) = n let get_node (n, _) = n
let replace_node (_, i) n' = (n', i) let replace_node (_, i) n' = (n', i)
let create_generator n = (n, ref 0) 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 match instr_ref_opt, get_forall err_instance with
| Some instr_ref, is_forall -> | Some instr_ref, is_forall ->
let node' = InstrRef.get_node instr_ref in 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 | None, _ -> () in
H.iter iter err_tbl H.iter iter err_tbl
@ -293,7 +293,7 @@ end (* Strict *)
type st_report_error = type st_report_error =
Procname.t -> Procname.t ->
Cfg.Procdesc.t -> Procdesc.t ->
string -> string ->
Location.t -> Location.t ->
?advice: string option -> ?advice: string option ->
@ -307,7 +307,7 @@ type st_report_error =
(** Report an error right now. *) (** Report an error right now. *)
let report_error_now tenv let report_error_now tenv
(st_report_error : st_report_error) err_instance loc pdesc : unit = (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 demo_mode = true in
let do_print_base ew_string kind_s s = let do_print_base ew_string kind_s s =
let mname = match pname with let mname = match pname with

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

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

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

@ -18,7 +18,7 @@ module P = Printf
(** Parameters of a call. *) (** Parameters of a call. *)
type parameters = (Exp.t * Typ.t) list 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. *) (** Extension to a typestate with values of type 'a. *)
type 'a ext = type 'a ext =
@ -26,7 +26,7 @@ type 'a ext =
empty : 'a; (** empty extension *) empty : 'a; (** empty extension *)
check_instr : check_instr :
Tenv.t -> get_proc_desc -> Procname.t -> 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 *) 'a; (** check the extension for an instruction *)
join : 'a -> 'a -> 'a; (** join two extensions *) join : 'a -> 'a -> 'a; (** join two extensions *)
pp : Format.formatter -> 'a -> unit (** pretty print an extension *) 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. *) (** Parameters of a call. *)
type parameters = (Exp.t * Typ.t) list 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. *) (** Extension to a typestate with values of type 'a. *)
type 'a ext = type 'a ext =
@ -22,7 +22,7 @@ type 'a ext =
empty : 'a; (** empty extension *) empty : 'a; (** empty extension *)
check_instr : check_instr :
Tenv.t -> get_proc_desc -> Procname.t -> 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 *) 'a; (** check the extension for an instruction *)
join : 'a -> 'a -> 'a; (** join two extensions *) join : 'a -> 'a -> 'a; (** join two extensions *)
pp : Format.formatter -> 'a -> unit (** pretty print an extension *) 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 = let formals_from_name cfg pname =
match procdesc_from_name cfg pname with match procdesc_from_name cfg pname with
| Some pdesc -> Cfg.Procdesc.get_formals pdesc | Some pdesc -> Procdesc.get_formals pdesc
| None -> [] | None -> []
(** add an instruction to the env, update tmp_vars, and bump the pc *) (** 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 inhabit_call_with_args procname procdesc args env =
let retval = 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 let is_void = ret_typ = Typ.Tvoid in
if is_void then None else Some (Ident.create_fresh Ident.knormal, ret_typ) in if is_void then None else Some (Ident.create_fresh Ident.knormal, ret_typ) in
let call_instr = let call_instr =
@ -188,7 +188,7 @@ let inhabit_call tenv (procname, receiver) cfg env =
match procdesc_from_name cfg procname with match procdesc_from_name cfg procname with
| Some procdesc -> | Some procdesc ->
(* swap the type of the 'this' formal with the receiver type, if there is one *) (* 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 | ((name, _) :: formals, Some receiver) -> (name, receiver) :: formals
| (formals, None) -> formals | (formals, None) -> formals
| ([], Some _) -> | ([], Some _) ->
@ -230,7 +230,7 @@ let add_harness_to_cg harness_name harness_node cg =
Cg.add_defined_node cg (Procname.Java harness_name); Cg.add_defined_node cg (Procname.Java harness_name);
IList.iter IList.iter
(fun p -> Cg.add_edge cg (Procname.Java harness_name) p) (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 (** create and fill the appropriate nodes and add them to the harness cfg. also add the harness
* proc to the cg *) * proc to the cg *)
@ -248,18 +248,18 @@ let setup_harness_cfg harness_name env cg cfg =
let harness_node = let harness_node =
(* important to reverse the list or there will be scoping issues! *) (* important to reverse the list or there will be scoping issues! *)
let instrs = (IList.rev env.instrs) in let instrs = (IList.rev env.instrs) in
let nodekind = Cfg.Node.Stmt_node "method_body" in let nodekind = Procdesc.Node.Stmt_node "method_body" in
Cfg.Procdesc.create_node procdesc env.pc nodekind instrs in Procdesc.create_node procdesc env.pc nodekind instrs in
let (start_node, exit_node) = let (start_node, exit_node) =
let create_node kind = Cfg.Procdesc.create_node procdesc env.pc kind [] in let create_node kind = Procdesc.create_node procdesc env.pc kind [] in
let start_kind = Cfg.Node.Start_node procname in let start_kind = Procdesc.Node.Start_node procname in
let exit_kind = Cfg.Node.Exit_node procname in let exit_kind = Procdesc.Node.Exit_node procname in
(create_node start_kind, create_node exit_kind) in (create_node start_kind, create_node exit_kind) in
Cfg.Procdesc.set_start_node procdesc start_node; Procdesc.set_start_node procdesc start_node;
Cfg.Procdesc.set_exit_node procdesc exit_node; Procdesc.set_exit_node procdesc exit_node;
Cfg.Node.add_locals_ret_declaration start_node proc_attributes []; Procdesc.Node.add_locals_ret_declaration start_node proc_attributes [];
Cfg.Procdesc.node_set_succs_exn procdesc start_node [harness_node] [exit_node]; 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.node_set_succs_exn procdesc harness_node [exit_node] [exit_node];
add_harness_to_cg harness_name harness_node cg 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 (** 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 Javalib_pack
open Sawja_pack open Sawja_pack
module NodeTbl = Cfg.NodeHash module NodeTbl = Procdesc.NodeHash
type jump_kind = type jump_kind =
| Next | Next
@ -29,7 +29,7 @@ type icfg = {
type t = type t =
{ icfg : icfg; { icfg : icfg;
procdesc : Cfg.Procdesc.t; procdesc : Procdesc.t;
impl : JBir.t; impl : JBir.t;
mutable var_map : (Pvar.t * Typ.t * Typ.t) JBir.VarMap.t; mutable var_map : (Pvar.t * Typ.t * Typ.t) JBir.VarMap.t;
if_jumps : int NodeTbl.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); else set_var_map context (JBir.VarMap.add var (pvar, typ, typ) var_map);
(pvar, typ) (pvar, typ)
with Not_found -> 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 varname = Mangled.from_string (JBir.var_name_g var) in
let pvar = Pvar.mk varname procname in let pvar = Pvar.mk varname procname in
set_var_map context (JBir.VarMap.add var (pvar, typ, typ) var_map); 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 () = let reset_exn_node_table () =
Procname.Hash.clear 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 Procname.Hash.add exn_node_table procname exn_node
let get_exn_node procdesc = let get_exn_node procdesc =
try 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 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 (** Hastable for storing nodes that correspond to if-instructions. These are
used when adding the edges in the contrl flow graph. *) 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 (** data structure for saving the three structures tht contain the intermediate
@ -37,7 +37,7 @@ type icfg = {
(** data structure for storing the context elements. *) (** data structure for storing the context elements. *)
type t = private type t = private
{ icfg : icfg; { icfg : icfg;
procdesc : Cfg.Procdesc.t; procdesc : Procdesc.t;
impl : JBir.t; impl : JBir.t;
mutable var_map : (Pvar.t * Typ.t * Typ.t) JBir.VarMap.t; mutable var_map : (Pvar.t * Typ.t * Typ.t) JBir.VarMap.t;
if_jumps : int NodeTbl.t; if_jumps : int NodeTbl.t;
@ -51,7 +51,7 @@ type t = private
(** cretes a context for a given method. *) (** cretes a context for a given method. *)
val create_context : val create_context :
icfg -> icfg ->
Cfg.Procdesc.t -> Procdesc.t ->
JBir.t -> JBir.t ->
JBasics.class_name -> JBasics.class_name ->
DB.source_file -> DB.source_file ->
@ -68,10 +68,10 @@ val get_cg : t -> Cg.t
val get_cfg : t -> Cfg.cfg val get_cfg : t -> Cfg.cfg
(** adds to the context the line that an if-node will jump to *) (** 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 *) (** 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. *) (** 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 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 val reset_exn_node_table : unit -> unit
(** adds the exception node for a given method *) (** 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 *) (** 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) if super_call then (fun _ -> exit_nodes)
else JTransExn.create_exception_handlers context [exn_node] get_body_nodes impl in else JTransExn.create_exception_handlers context [exn_node] get_body_nodes impl in
let connect node pc = 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 context.procdesc node (get_succ_nodes node pc) (get_exn_nodes pc) in
let connect_nodes pc translated_instruction = let connect_nodes pc translated_instruction =
match translated_instruction with match translated_instruction with
@ -58,7 +58,7 @@ let add_edges
connect node_true pc; connect node_true pc;
connect node_false pc connect node_false pc
| JTrans.Loop (join_node, node_true, node_false) -> | 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_true pc;
connect node_false pc in connect node_false pc in
let first_nodes = let first_nodes =
@ -66,11 +66,11 @@ let add_edges
direct_successors (-1) in direct_successors (-1) in
(* the exceptions edges here are going directly to the exit node *) (* 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 if not super_call then
(* the exceptions node is just before the exit node *) (* 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 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 match JTrans.create_cm_procdesc source_file program linereader icfg cm proc_name with
| None -> () | None -> ()
| Some (procdesc, impl) -> | Some (procdesc, impl) ->
let start_node = Cfg.Procdesc.get_start_node procdesc in let start_node = Procdesc.get_start_node procdesc in
let exit_node = Cfg.Procdesc.get_exit_node procdesc in let exit_node = Procdesc.get_exit_node procdesc in
let exn_node = let exn_node =
match JContext.get_exn_node procdesc with match JContext.get_exn_node procdesc with
| Some node -> node | Some node -> node

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

@ -235,7 +235,7 @@ let trans_access = function
| `Private -> PredSymb.Private | `Private -> PredSymb.Private
| `Protected -> PredSymb.Protected | `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 cfg = icfg.JContext.cfg in
let tenv = icfg.JContext.tenv in let tenv = icfg.JContext.tenv in
let m = Javalib.AbstractMethod am 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; ret_type = JTransType.return_type program tenv ms;
} in } in
Cfg.create_proc_desc cfg proc_attributes in Cfg.create_proc_desc cfg proc_attributes in
let start_kind = Cfg.Node.Start_node proc_name in let start_kind = Procdesc.Node.Start_node proc_name in
let start_node = Cfg.Procdesc.create_node procdesc Location.dummy start_kind [] in let start_node = Procdesc.create_node procdesc Location.dummy start_kind [] in
let exit_kind = (Cfg.Node.Exit_node proc_name) in let exit_kind = (Procdesc.Node.Exit_node proc_name) in
let exit_node = Cfg.Procdesc.create_node procdesc Location.dummy exit_kind [] in let exit_node = Procdesc.create_node procdesc Location.dummy exit_kind [] in
Cfg.Procdesc.node_set_succs_exn procdesc start_node [exit_node] [exit_node]; Procdesc.node_set_succs_exn procdesc start_node [exit_node] [exit_node];
Cfg.Procdesc.set_start_node procdesc start_node; Procdesc.set_start_node procdesc start_node;
Cfg.Procdesc.set_exit_node procdesc exit_node; Procdesc.set_exit_node procdesc exit_node;
procdesc procdesc
let create_native_procdesc program icfg cm proc_name = 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 } in
let procdesc = let procdesc =
Cfg.create_proc_desc cfg proc_attributes in Cfg.create_proc_desc cfg proc_attributes in
let start_kind = Cfg.Node.Start_node proc_name in let start_kind = Procdesc.Node.Start_node proc_name in
let start_node = Cfg.Procdesc.create_node procdesc loc_start start_kind [] in let start_node = Procdesc.create_node procdesc loc_start start_kind [] in
let exit_kind = (Cfg.Node.Exit_node proc_name) in let exit_kind = (Procdesc.Node.Exit_node proc_name) in
let exit_node = Cfg.Procdesc.create_node procdesc loc_exit exit_kind [] in let exit_node = Procdesc.create_node procdesc loc_exit exit_kind [] in
let exn_kind = Cfg.Node.exn_sink_kind in let exn_kind = Procdesc.Node.exn_sink_kind in
let exn_node = Cfg.Procdesc.create_node procdesc loc_exit exn_kind [] in let exn_node = Procdesc.create_node procdesc loc_exit exn_kind [] in
JContext.add_exn_node proc_name exn_node; JContext.add_exn_node proc_name exn_node;
Cfg.Procdesc.set_start_node procdesc start_node; Procdesc.set_start_node procdesc start_node;
Cfg.Procdesc.set_exit_node procdesc exit_node; Procdesc.set_exit_node procdesc exit_node;
Cfg.Node.add_locals_ret_declaration start_node proc_attributes locals; Procdesc.Node.add_locals_ret_declaration start_node proc_attributes locals;
procdesc in procdesc in
Some (procdesc, impl) Some (procdesc, impl)
with JBir.Subroutine -> 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. *) match c with (* We use the constant <field> internally to mean a variable. *)
| `String s when (JBasics.jstr_pp s) = JConfig.field_cst -> | `String s when (JBasics.jstr_pp s) = JConfig.field_cst ->
let varname = JConfig.field_st in 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 let pvar = Pvar.mk varname procname in
trans_var pvar trans_var pvar
| _ -> ([], Exp.Const (get_constant c), type_of_expr) | _ -> ([], Exp.Const (get_constant c), type_of_expr)
@ -616,9 +616,9 @@ let detect_loop entry_pc impl =
type translation = type translation =
| Skip | Skip
| Instr of Cfg.Node.t | Instr of Procdesc.Node.t
| Prune of Cfg.Node.t * Cfg.Node.t | Prune of Procdesc.Node.t * Procdesc.Node.t
| Loop of Cfg.Node.t * Cfg.Node.t * Cfg.Node.t | Loop of Procdesc.Node.t * Procdesc.Node.t * Procdesc.Node.t
(* TODO: unclear if this corresponds to what JControlFlow.resolve_method'*) (* TODO: unclear if this corresponds to what JControlFlow.resolve_method'*)
(* is trying to do. Normally, this implementation below goes deeper into *) (* 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 tenv = JContext.get_tenv context in
let cg = JContext.get_cg context in let cg = JContext.get_cg context in
let program = context.program 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_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 loc = get_location context.source_file context.impl pc in
let file = loc.Location.file in let file = loc.Location.file in
let match_never_null = Inferconfig.never_return_null_matcher in let match_never_null = Inferconfig.never_return_null_matcher in
let create_node node_kind sil_instrs = 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 () = let return_not_null () =
match_never_null loc.Location.file proc_name in match_never_null loc.Location.file proc_name in
let trans_monitor_enter_exit context expr pc loc builtin node_desc = 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 | Typ.Tptr (typ, _) -> typ
| _ -> sil_type in | _ -> sil_type in
let deref_instr = create_sil_deref sil_expr typ_no_ptr loc 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 Instr (create_node node_kind (instrs @ [deref_instr; instr] )) in
try try
match instr with 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 (stml, sil_expr, sil_type) = expression context pc expr in
let pvar = (JContext.set_pvar context var sil_type) 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 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 let node = create_node node_kind (stml @ [sil_instr]) in
Instr node Instr node
| JBir.Return expr_option -> | 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 = let node =
match expr_option with match expr_option with
| None -> | None ->
@ -759,7 +759,7 @@ let rec instruction (context : JContext.t) pc instr : translation =
Sil.Store ( Sil.Store (
Exp.Lindex (sil_expr_array, sil_expr_index), value_typ, sil_expr_value, loc) in 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 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 let node = create_node node_kind final_instrs in
Instr node Instr node
| JBir.AffectField (e_lhs, cn, fs, e_rhs) -> | 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 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 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 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 let node = create_node node_kind (stml1 @ stml2 @ [sil_instr]) in
Instr node Instr node
| JBir.AffectStaticField (cn, fs, e_rhs) -> | 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 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 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 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 let node = create_node node_kind (stml1 @ stml2 @ [sil_instr]) in
Instr node Instr node
| JBir.Goto goto_pc -> | 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_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_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 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_true = Procdesc.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_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]) let prune_node_true = create_node node_kind_true (instrs1 @ instrs2 @ [sil_instrs_true])
and prune_node_false = and prune_node_false =
create_node node_kind_false (instrs1 @ instrs2 @ [sil_instrs_false]) in create_node node_kind_false (instrs1 @ instrs2 @ [sil_instrs_false]) in
JContext.add_if_jump context prune_node_false if_pc; JContext.add_if_jump context prune_node_false if_pc;
if detect_loop pc context.impl then 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 let join_node = create_node join_node_kind [] in
Loop (join_node, prune_node_true, prune_node_false) Loop (join_node, prune_node_true, prune_node_false)
else else
@ -817,7 +817,7 @@ let rec instruction (context : JContext.t) pc instr : translation =
let (instrs, sil_expr, _) = expression context pc expr in let (instrs, sil_expr, _) = expression context pc expr in
let sil_exn = Exp.Exn sil_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 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; JContext.add_goto_jump context pc JContext.Exit;
Instr node Instr node
| JBir.New (var, cn, constr_type_list, constr_arg_list) -> | 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 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 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 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 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; Cg.add_edge cg caller_procname constr_procname;
Instr node Instr node
| JBir.NewArray (var, vt, expr_list) -> | JBir.NewArray (var, vt, expr_list) ->
@ -854,7 +854,7 @@ let rec instruction (context : JContext.t) pc instr : translation =
Sil.Call Sil.Call
(Some (ret_id, array_type), builtin_new_array, call_args, loc, CallFlags.default) in (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 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 let node = create_node node_kind (instrs @ [call_instr; set_instr]) in
Instr node Instr node
| JBir.InvokeStatic (var_opt, cn, ms, args) -> | JBir.InvokeStatic (var_opt, cn, ms, args) ->
@ -868,20 +868,20 @@ let rec instruction (context : JContext.t) pc instr : translation =
| _ -> None, args, [] in | _ -> None, args, [] in
let callee_procname, call_instrs = let callee_procname, call_instrs =
method_invocation context loc pc var_opt cn ms sil_obj_opt args I_Static Procname.Static in 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 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; Cg.add_edge cg caller_procname callee_procname;
Instr call_node Instr call_node
| JBir.InvokeVirtual (var_opt, obj, call_kind, ms, args) -> | 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 (instrs, sil_obj_expr, sil_obj_type) = expression context pc obj in
let create_call_node cn invoke_kind = let create_call_node cn invoke_kind =
let callee_procname, call_instrs = let callee_procname, call_instrs =
let ret_opt = Some (sil_obj_expr, sil_obj_type) in let ret_opt = Some (sil_obj_expr, sil_obj_type) in
method_invocation method_invocation
context loc pc var_opt cn ms ret_opt args invoke_kind Procname.Non_Static in 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 let call_node = create_node node_kind (instrs @ call_instrs) in
Cg.add_edge cg caller_procname callee_procname; Cg.add_edge cg caller_procname callee_procname;
call_node in 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 (instrs, sil_obj_expr, sil_obj_type) = expression context pc obj in
let callee_procname, call_instrs = 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 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 call_node = create_node node_kind (instrs @ call_instrs) in
let procdesc = context.procdesc 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; Cg.add_edge cg caller_procname callee_procname;
Instr call_node 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 (instrs, sil_expr, _) = expression context pc expr in
let this_not_null_node = let this_not_null_node =
create_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 Instr this_not_null_node
| JBir.Check (JBir.CheckNullPointer expr) when Config.report_runtime_exceptions -> | 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 not_null_node =
let sil_not_null = Exp.BinOp (Binop.Ne, sil_expr, Exp.null) in 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) 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 create_node not_null_kind (instrs @ [sil_prune_not_null]) in
let throw_npe_node = let throw_npe_node =
let sil_is_null = Exp.BinOp (Binop.Eq, sil_expr, Exp.null) in 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) 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 and npe_cn = JBasics.make_cn JConfig.npe_cl in
let class_type = JTransType.get_class_type program tenv npe_cn 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 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 =
let in_bound_node_kind = 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_assume_in_bound =
let sil_in_bound = let sil_in_bound =
let sil_positive_index = let sil_positive_index =
@ -983,7 +983,7 @@ let rec instruction (context : JContext.t) pc instr : translation =
and throw_out_of_bound_node = and throw_out_of_bound_node =
let out_of_bound_node_kind = 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_assume_out_of_bound =
let sil_out_of_bound = let sil_out_of_bound =
let sil_negative_index = let sil_negative_index =
@ -1026,12 +1026,12 @@ let rec instruction (context : JContext.t) pc instr : translation =
let is_instance_node = let is_instance_node =
let check_is_false = Exp.BinOp (Binop.Ne, res_ex, Exp.zero) in 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) 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]) create_node instance_of_kind (instrs @ [call; asssume_instance_of])
and throw_cast_exception_node = and throw_cast_exception_node =
let check_is_true = Exp.BinOp (Binop.Ne, res_ex, Exp.one) in 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) 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 and cce_cn = JBasics.make_cn JConfig.cce_cl in
let class_type = JTransType.get_class_type program tenv cce_cn 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 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. *) (** Data structure for storing the results of the translation of an instruction. *)
type translation = type translation =
| Skip | Skip
| Instr of Cfg.Node.t | Instr of Procdesc.Node.t
| Prune of Cfg.Node.t * Cfg.Node.t | Prune of Procdesc.Node.t * Procdesc.Node.t
| Loop of Cfg.Node.t * Cfg.Node.t * Cfg.Node.t | Loop of Procdesc.Node.t * Procdesc.Node.t * Procdesc.Node.t
val is_java_native : JCode.jcode Javalib.concrete_method -> bool val is_java_native : JCode.jcode Javalib.concrete_method -> bool
(** Create the procedure description for an abstract method *) (** Create the procedure description for an abstract method *)
val create_am_procdesc : 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 *) (** Create the procedure description for a concrete method *)
val create_native_procdesc : val create_native_procdesc :
@ -32,7 +32,7 @@ val create_native_procdesc :
JContext.icfg -> JContext.icfg ->
JCode.jcode Javalib.concrete_method -> JCode.jcode Javalib.concrete_method ->
Procname.t -> Procname.t ->
Cfg.Procdesc.t Procdesc.t
(** [create_procdesc source_file program linereader icfg cm proc_name] creates (** [create_procdesc source_file program linereader icfg cm proc_name] creates
a procedure description for the concrete method cm and adds it to cfg *) a procedure description for the concrete method cm and adds it to cfg *)
@ -43,7 +43,7 @@ val create_cm_procdesc :
JContext.icfg -> JContext.icfg ->
JCode.jcode Javalib.concrete_method -> JCode.jcode Javalib.concrete_method ->
Procname.t -> 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 *) (** translates an instruction into a statement node or prune nodes in the cfg *)
val instruction : JContext.t -> int -> JBir.instr -> translation 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 catch_block_table = Hashtbl.create 1 in
let exn_message = "exception handler" in let exn_message = "exception handler" in
let procdesc = context.procdesc in let procdesc = context.procdesc in
let create_node loc node_kind instrs = Cfg.Procdesc.create_node procdesc loc node_kind instrs in let create_node loc node_kind instrs = Procdesc.create_node procdesc loc node_kind instrs in
let ret_var = Cfg.Procdesc.get_ret_var procdesc in let ret_var = Procdesc.get_ret_var procdesc in
let ret_type = Cfg.Procdesc.get_ret_type procdesc in let ret_type = Procdesc.get_ret_type procdesc in
let id_ret_val = Ident.create_fresh Ident.knormal 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 *) (* 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 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 CallFlags.default) in
create_node create_node
loc loc
Cfg.Node.exn_handler_kind Procdesc.Node.exn_handler_kind
[instr_get_ret_val; instr_deactivate_exn; instr_unwrap_ret_val] in [instr_get_ret_val; instr_deactivate_exn; instr_unwrap_ret_val] in
let create_entry_block handler_list = let create_entry_block handler_list =
try 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 collect succ_nodes rethrow_exception handler =
let catch_nodes = get_body_nodes handler.JBir.e_handler in let catch_nodes = get_body_nodes handler.JBir.e_handler in
let loc = match catch_nodes with let loc = match catch_nodes with
| n:: _ -> Cfg.Node.get_loc n | n:: _ -> Procdesc.Node.get_loc n
| [] -> Location.dummy in | [] -> Location.dummy in
let exn_type = let exn_type =
let class_name = 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 Sil.Store (Exp.Lvar catch_var, ret_type, Exp.Var id_exn_val, loc) in
let instr_rethrow_exn = let instr_rethrow_exn =
Sil.Store (Exp.Lvar ret_var, ret_type, Exp.Exn (Exp.Var id_exn_val), loc) in 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_true = Procdesc.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_false = Procdesc.Node.Prune_node (false, if_kind, exn_message) in
let node_true = let node_true =
let instrs_true = [instr_call_instanceof; instr_prune_true; instr_set_catch_var] in let instrs_true = [instr_call_instanceof; instr_prune_true; instr_set_catch_var] in
create_node loc node_kind_true instrs_true in create_node loc node_kind_true instrs_true in
let node_false = let node_false =
let instrs_false = [instr_call_instanceof; instr_prune_false] @ (if rethrow_exception then [instr_rethrow_exn] else []) in 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 create_node loc node_kind_false instrs_false in
Cfg.Procdesc.node_set_succs_exn procdesc node_true catch_nodes exit_nodes; 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_false succ_nodes exit_nodes;
let is_finally = handler.JBir.e_catch_type = None in let is_finally = handler.JBir.e_catch_type = None in
if is_finally if is_finally
then [node_true] (* TODO (#4759480): clean up the translation so prune nodes are not created at all *) 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 = let nodes_first_handler =
IList.fold_left process_handler exit_nodes (IList.rev handler_list) in IList.fold_left process_handler exit_nodes (IList.rev handler_list) in
let loc = match nodes_first_handler with let loc = match nodes_first_handler with
| n:: _ -> Cfg.Node.get_loc n | n:: _ -> Procdesc.Node.get_loc n
| [] -> Location.dummy in | [] -> Location.dummy in
let entry_node = create_entry_node loc 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.add catch_block_table handler_list [entry_node] in
Hashtbl.iter (fun _ handler_list -> create_entry_block handler_list) handler_table; Hashtbl.iter (fun _ handler_list -> create_entry_block handler_list) handler_table;
catch_block_table catch_block_table

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

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

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

@ -156,7 +156,7 @@ module StructuredSil = struct
end end
module Make module Make
(CFG : ProcCfg.S with type node = Cfg.Node.t) (CFG : ProcCfg.S with type node = Procdesc.Node.t)
(S : Scheduler.Make) (S : Scheduler.Make)
(T : TransferFunctions.Make) = struct (T : TransferFunctions.Make) = struct
@ -171,16 +171,16 @@ module Make
let cfg = Cfg.create_cfg () in let cfg = Cfg.create_cfg () in
let pdesc = let pdesc =
Cfg.create_proc_desc cfg (ProcAttributes.default test_pname !Config.curr_language) in 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 = 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= 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_nodes_for_cond cond_exp if_kind =
let mk_prune_node cond_exp if_kind true_branch = let mk_prune_node cond_exp if_kind true_branch =
let prune_instr = Sil.Prune (cond_exp, dummy_loc, true_branch, if_kind) in 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 true_prune_node = mk_prune_node cond_exp if_kind true in
let false_prune_node = let false_prune_node =
let negated_cond_exp = Exp.UnOp (Unop.LNot, cond_exp, None) in 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 let rec structured_instr_to_node (last_node, assert_map) exn_handlers = function
| Cmd cmd -> | 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; set_succs last_node [node] ~exn_handlers;
node, assert_map node, assert_map
| If (exp, then_instrs, else_instrs) -> | 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 structured_instrs_to_node then_prune_node assert_map exn_handlers then_instrs in
let else_branch_end_node, assert_map'' = let else_branch_end_node, assert_map'' =
structured_instrs_to_node else_prune_node assert_map' exn_handlers else_instrs in 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 then_branch_end_node [join_node] ~exn_handlers;
set_succs else_branch_end_node [join_node] ~exn_handlers; set_succs else_branch_end_node [join_node] ~exn_handlers;
join_node, assert_map'' join_node, assert_map''
| While (exp, body_instrs) -> | 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; 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 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; set_succs loop_head_join_node [true_prune_node; false_prune_node] ~exn_handlers;
let loop_body_end_node, assert_map' = let loop_body_end_node, assert_map' =
structured_instrs_to_node true_prune_node assert_map exn_handlers body_instrs in 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 loop_body_end_node [loop_head_join_node] ~exn_handlers;
set_succs false_prune_node [loop_exit_node] ~exn_handlers; set_succs false_prune_node [loop_exit_node] ~exn_handlers;
loop_exit_node, assert_map' loop_exit_node, assert_map'
| Try (try_instrs, catch_instrs, finally_instrs) -> | 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 *) (* use [catch_start_node] as the exn handler *)
let try_end_node, assert_map' = let try_end_node, assert_map' =
structured_instrs_to_node last_node assert_map [catch_start_node] try_instrs in structured_instrs_to_node last_node assert_map [catch_start_node] try_instrs in
let catch_end_node, assert_map'' = let catch_end_node, assert_map'' =
structured_instrs_to_node catch_start_node assert_map' exn_handlers catch_instrs in 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 try_end_node [finally_start_node] ~exn_handlers;
set_succs catch_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 structured_instrs_to_node finally_start_node assert_map'' exn_handlers finally_instrs
| Invariant (inv_str, inv_label) -> | 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; set_succs last_node [node] ~exn_handlers;
(* add the assertion to be checked after analysis converges *) (* add the assertion to be checked after analysis converges *)
node, M.add (CFG.id node) (inv_str, inv_label) assert_map 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) (fun acc instr -> structured_instr_to_node acc exn_handlers instr)
(last_node, assert_map) (last_node, assert_map)
instrs in instrs in
let start_node = create_node (Cfg.Node.Start_node pname) [] in let start_node = create_node (Procdesc.Node.Start_node pname) [] in
Cfg.Procdesc.set_start_node pdesc start_node; Procdesc.set_start_node pdesc start_node;
let no_exn_handlers = [] in let no_exn_handlers = [] in
let last_node, assert_map = let last_node, assert_map =
structured_instrs_to_node start_node M.empty no_exn_handlers program in 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; 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 pdesc, assert_map
let create_test test_program extras pp_opt test_pname _ = 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 instrs3 = [dummy_instr4] in
let instrs4 = [] in let instrs4 = [] in
let create_node instrs = 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 n1 = create_node instrs1 in
let n2 = create_node instrs2 in let n2 = create_node instrs2 in
let n3 = create_node instrs3 in let n3 = create_node instrs3 in
let n4 = create_node instrs4 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 *) (* let -> represent normal transitions and -*-> represent exceptional transitions *)
(* creating graph n1 -> n2, n1 -*-> n3, n2 -> n4, n2 -*-> n3, n3 -> n4 , n3 -*> n4 *) (* 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]; Procdesc.node_set_succs_exn test_pdesc n1 [n2] [n3];
Cfg.Procdesc.node_set_succs_exn test_pdesc n2 [n4] [n3]; 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 n3 [n4] [n4];
let normal_proc_cfg = ProcCfg.Normal.from_pdesc test_pdesc in let normal_proc_cfg = ProcCfg.Normal.from_pdesc test_pdesc in
let exceptional_proc_cfg = ProcCfg.Exceptional.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 open OUnit2 in
let cmp l1 l2 = let cmp l1 l2 =
let sort = IList.sort Cfg.Node.compare in let sort = IList.sort Procdesc.Node.compare in
IList.equal Cfg.Node.compare (sort l1) (sort l2) in IList.equal Procdesc.Node.compare (sort l1) (sort l2) in
let pp_diff fmt (actual, expected) = let pp_diff fmt (actual, expected) =
let pp_sep fmt _ = F.pp_print_char fmt ',' in 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 F.fprintf fmt "Expected output %a but got %a" pp_node_list expected pp_node_list actual in
let create_test input expected _ = let create_test input expected _ =
assert_equal ~cmp ~pp_diff input expected in 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 id n = n
let loc _ = assert false let loc _ = assert false
let underlying_id _ = 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 id_compare = int_compare
let pp_id fmt i = let pp_id fmt i =
F.fprintf fmt "%i" i F.fprintf fmt "%i" i

Write Preview
Loading…
Cancel
Save