From c5159bae1c59ed3dad108e297367a0e22fba6094 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Thu, 10 Nov 2016 04:39:21 -0800 Subject: [PATCH] [IR] Move Procdesc module to a separate file. Reviewed By: jvillard Differential Revision: D4159580 fbshipit-source-id: e83ebd5 --- infer/src/IR/Cfg.re | 590 ++---------------- infer/src/IR/Cfg.rei | 229 +------ infer/src/IR/Procdesc.re | 546 ++++++++++++++++ infer/src/IR/Procdesc.rei | 281 +++++++++ infer/src/backend/BuiltinDefn.ml | 50 +- infer/src/backend/PropUtil.re | 27 +- infer/src/backend/PropUtil.rei | 6 +- infer/src/backend/buckets.ml | 16 +- infer/src/backend/builtin.ml | 2 +- infer/src/backend/builtin.mli | 2 +- infer/src/backend/callbacks.ml | 12 +- infer/src/backend/callbacks.mli | 8 +- infer/src/backend/dotty.ml | 62 +- infer/src/backend/errdesc.ml | 42 +- infer/src/backend/errdesc.mli | 25 +- infer/src/backend/exe_env.mli | 2 +- infer/src/backend/interproc.ml | 208 +++--- infer/src/backend/ondemand.ml | 12 +- infer/src/backend/ondemand.mli | 8 +- infer/src/backend/paths.ml | 66 +- infer/src/backend/paths.mli | 8 +- infer/src/backend/preanal.ml | 34 +- infer/src/backend/preanal.mli | 2 +- infer/src/backend/printer.ml | 112 ++-- infer/src/backend/printer.mli | 11 +- infer/src/backend/prover.ml | 2 +- infer/src/backend/rearrange.ml | 24 +- infer/src/backend/rearrange.mli | 6 +- infer/src/backend/specs.ml | 10 +- infer/src/backend/specs.mli | 14 +- infer/src/backend/state.ml | 54 +- infer/src/backend/state.mli | 20 +- infer/src/backend/symExec.ml | 32 +- infer/src/backend/symExec.mli | 4 +- infer/src/backend/tabulation.ml | 6 +- infer/src/backend/tabulation.mli | 2 +- infer/src/checkers/BoundedCallTree.ml | 16 +- infer/src/checkers/SimpleChecker.ml | 8 +- infer/src/checkers/SimpleChecker.mli | 2 +- infer/src/checkers/Siof.ml | 8 +- infer/src/checkers/ThreadSafety.ml | 16 +- infer/src/checkers/abstractInterpreter.ml | 2 +- infer/src/checkers/annotationReachability.ml | 4 +- infer/src/checkers/annotations.ml | 2 +- infer/src/checkers/annotations.mli | 2 +- infer/src/checkers/checkDeadCode.ml | 34 +- infer/src/checkers/checkTraceCallSequence.ml | 8 +- infer/src/checkers/checkers.ml | 51 +- infer/src/checkers/checkers.mli | 2 +- infer/src/checkers/constantPropagation.ml | 8 +- infer/src/checkers/constantPropagation.mli | 4 +- infer/src/checkers/dataflow.ml | 26 +- infer/src/checkers/dataflow.mli | 4 +- .../checkers/fragmentRetainsViewChecker.ml | 2 +- infer/src/checkers/idenv.ml | 2 +- infer/src/checkers/idenv.mli | 6 +- infer/src/checkers/patternMatch.ml | 22 +- infer/src/checkers/patternMatch.mli | 10 +- infer/src/checkers/printfArgs.ml | 8 +- infer/src/checkers/printfArgs.mli | 3 +- infer/src/checkers/procCfg.ml | 100 +-- infer/src/checkers/procCfg.mli | 16 +- infer/src/checkers/procData.ml | 2 +- infer/src/checkers/procData.mli | 6 +- infer/src/checkers/repeatedCallsChecker.ml | 6 +- infer/src/checkers/sqlChecker.ml | 2 +- infer/src/checkers/summary.ml | 2 +- infer/src/clang/cContext.ml | 8 +- infer/src/clang/cContext.mli | 8 +- infer/src/clang/cFrontend_decl.ml | 16 +- infer/src/clang/cMethod_trans.ml | 18 +- infer/src/clang/cModule_type.ml | 2 +- infer/src/clang/cTrans.ml | 102 +-- infer/src/clang/cTrans_utils.ml | 44 +- infer/src/clang/cTrans_utils.mli | 27 +- infer/src/clang/cVar_decl.ml | 6 +- infer/src/clang/cVar_decl.mli | 2 +- infer/src/clang/printing.ml | 6 +- infer/src/clang/printing.mli | 2 +- infer/src/eradicate/eradicate.ml | 26 +- infer/src/eradicate/eradicateChecks.ml | 18 +- infer/src/eradicate/typeCheck.ml | 28 +- infer/src/eradicate/typeCheck.mli | 8 +- infer/src/eradicate/typeErr.ml | 20 +- infer/src/eradicate/typeErr.mli | 16 +- infer/src/eradicate/typeState.ml | 4 +- infer/src/eradicate/typeState.mli | 4 +- infer/src/harness/inhabit.ml | 28 +- infer/src/java/jContext.ml | 10 +- infer/src/java/jContext.mli | 14 +- infer/src/java/jFrontend.ml | 12 +- infer/src/java/jTrans.ml | 100 +-- infer/src/java/jTrans.mli | 12 +- infer/src/java/jTransExn.ml | 22 +- infer/src/java/jTransExn.mli | 4 +- infer/src/quandary/TaintAnalysis.ml | 18 +- infer/src/unit/analyzerTester.ml | 32 +- infer/src/unit/procCfgTests.ml | 16 +- infer/src/unit/schedulerTests.ml | 2 +- 99 files changed, 1839 insertions(+), 1715 deletions(-) create mode 100644 infer/src/IR/Procdesc.re create mode 100644 infer/src/IR/Procdesc.rei diff --git a/infer/src/IR/Cfg.re b/infer/src/IR/Cfg.re index 80ca1a4c0..6951cbd36 100644 --- a/infer/src/IR/Cfg.re +++ b/infer/src/IR/Cfg.re @@ -16,504 +16,13 @@ let module L = Logging; let module F = Format; -/* =============== START of module Node =============== */ -let module Node = { - type id = int; - type nodekind = - | Start_node Procname.t - | Exit_node Procname.t - | Stmt_node string - | Join_node - | Prune_node bool Sil.if_kind string /** (true/false branch, if_kind, comment) */ - | Skip_node string; - - /** a node */ - type t = { - /** unique id of the node */ - id: id, - /** distance to the exit node */ - mutable dist_exit: option int, - /** exception nodes in the cfg */ - mutable exn: list t, - /** instructions for symbolic execution */ - mutable instrs: list Sil.instr, - /** kind of node */ - kind: nodekind, - /** location in the source code */ - loc: Location.t, - /** predecessor nodes in the cfg */ - mutable preds: list t, - /** name of the procedure the node belongs to */ - pname: option Procname.t, - /** successor nodes in the cfg */ - mutable succs: list t - }; - let exn_handler_kind = Stmt_node "exception handler"; - let exn_sink_kind = Stmt_node "exceptions sink"; - let throw_kind = Stmt_node "throw"; - let dummy () => { - id: 0, - dist_exit: None, - instrs: [], - kind: Skip_node "dummy", - loc: Location.dummy, - pname: None, - succs: [], - preds: [], - exn: [] - }; - let compare node1 node2 => int_compare node1.id node2.id; - let hash node => Hashtbl.hash node.id; - let equal node1 node2 => compare node1 node2 == 0; - - /** Get the unique id of the node */ - let get_id node => node.id; - - /** compare node ids */ - let id_compare = int_compare; - let get_succs node => node.succs; - type node = t; - let module NodeSet = Set.Make { - type t = node; - let compare = compare; - }; - let module IdMap = Map.Make { - type t = id; - let compare = id_compare; - }; - let get_sliced_succs node f => { - let visited = ref NodeSet.empty; - let rec slice_nodes nodes :NodeSet.t => { - let do_node acc n => { - visited := NodeSet.add n !visited; - if (f n) { - NodeSet.singleton n - } else { - NodeSet.union - acc (slice_nodes (IList.filter (fun s => not (NodeSet.mem s !visited)) n.succs)) - } - }; - IList.fold_left do_node NodeSet.empty nodes - }; - NodeSet.elements (slice_nodes node.succs) - }; - let get_sliced_preds node f => { - let visited = ref NodeSet.empty; - let rec slice_nodes nodes :NodeSet.t => { - let do_node acc n => { - visited := NodeSet.add n !visited; - if (f n) { - NodeSet.singleton n - } else { - NodeSet.union - acc (slice_nodes (IList.filter (fun s => not (NodeSet.mem s !visited)) n.preds)) - } - }; - IList.fold_left do_node NodeSet.empty nodes - }; - NodeSet.elements (slice_nodes node.preds) - }; - let get_exn node => node.exn; - - /** Get the name of the procedure the node belongs to */ - let get_proc_name node => - switch node.pname { - | None => - L.out "get_proc_name: at node %d@\n" node.id; - assert false - | Some pname => pname - }; - - /** Get the predecessors of the node */ - let get_preds node => node.preds; - - /** Generates a list of nodes starting at a given node - and recursively adding the results of the generator */ - let get_generated_slope start_node generator => { - let visited = ref NodeSet.empty; - let rec nodes n => { - visited := NodeSet.add n !visited; - let succs = IList.filter (fun n => not (NodeSet.mem n !visited)) (generator n); - switch (IList.length succs) { - | 1 => [n, ...nodes (IList.hd succs)] - | _ => [n] - } - }; - nodes start_node - }; - - /** Get the node kind */ - let get_kind node => node.kind; - - /** Comparison for node kind */ - let kind_compare k1 k2 => - switch (k1, k2) { - | (Start_node pn1, Start_node pn2) => Procname.compare pn1 pn2 - | (Start_node _, _) => (-1) - | (_, Start_node _) => 1 - | (Exit_node pn1, Exit_node pn2) => Procname.compare pn1 pn2 - | (Exit_node _, _) => (-1) - | (_, Exit_node _) => 1 - | (Stmt_node s1, Stmt_node s2) => string_compare s1 s2 - | (Stmt_node _, _) => (-1) - | (_, Stmt_node _) => 1 - | (Join_node, Join_node) => 0 - | (Join_node, _) => (-1) - | (_, Join_node) => 1 - | (Prune_node is_true_branch1 if_kind1 descr1, Prune_node is_true_branch2 if_kind2 descr2) => - let n = bool_compare is_true_branch1 is_true_branch2; - if (n != 0) { - n - } else { - let n = Pervasives.compare if_kind1 if_kind2; - if (n != 0) { - n - } else { - string_compare descr1 descr2 - } - } - | (Prune_node _, _) => (-1) - | (_, Prune_node _) => 1 - | (Skip_node s1, Skip_node s2) => string_compare s1 s2 - }; - - /** Get the instructions to be executed */ - let get_instrs node => node.instrs; - - /** Get the list of callee procnames from the node */ - let get_callees node => { - let collect callees instr => - switch instr { - | Sil.Call _ exp _ _ _ => - switch exp { - | Exp.Const (Const.Cfun procname) => [procname, ...callees] - | _ => callees - } - | _ => callees - }; - IList.fold_left collect [] (get_instrs node) - }; - - /** Get the location of the node */ - let get_loc n => n.loc; - - /** Get the source location of the last instruction in the node */ - let get_last_loc n => - switch (IList.rev (get_instrs n)) { - | [instr, ..._] => Sil.instr_get_loc instr - | [] => n.loc - }; - let pp_id f id => F.fprintf f "%d" id; - let pp f node => pp_id f (get_id node); - let get_distance_to_exit node => node.dist_exit; - - /** Append the instructions to the list of instructions to execute */ - let append_instrs node instrs => node.instrs = node.instrs @ instrs; - - /** Add the instructions at the beginning of the list of instructions to execute */ - let prepend_instrs node instrs => node.instrs = instrs @ node.instrs; - - /** Replace the instructions to be executed. */ - let replace_instrs node instrs => node.instrs = instrs; - - /** Add declarations for local variables and return variable to the node */ - let add_locals_ret_declaration node (proc_attributes: ProcAttributes.t) locals => { - let loc = get_loc node; - let pname = proc_attributes.proc_name; - let ret_var = { - let ret_type = proc_attributes.ret_type; - (Pvar.get_ret_pvar pname, ret_type) - }; - let construct_decl (x, typ) => (Pvar.mk x pname, typ); - let ptl = [ret_var, ...IList.map construct_decl locals]; - let instr = Sil.Declare_locals ptl loc; - prepend_instrs node [instr] - }; - - /** Print extended instructions for the node, - highlighting the given subinstruction if present */ - let pp_instrs pe0 sub_instrs::sub_instrs instro fmt node => { - let pe = - switch instro { - | None => pe0 - | Some instr => pe_extend_colormap pe0 (Obj.repr instr) Red - }; - let instrs = get_instrs node; - let pp_loc fmt () => F.fprintf fmt " %a " Location.pp (get_loc node); - let print_sub_instrs () => F.fprintf fmt "%a" (Sil.pp_instr_list pe) instrs; - switch (get_kind node) { - | Stmt_node s => - if sub_instrs { - print_sub_instrs () - } else { - F.fprintf fmt "statements (%s) %a" s pp_loc () - } - | Prune_node _ _ descr => - if sub_instrs { - print_sub_instrs () - } else { - F.fprintf fmt "assume %s %a" descr pp_loc () - } - | Exit_node _ => - if sub_instrs { - print_sub_instrs () - } else { - F.fprintf fmt "exit %a" pp_loc () - } - | Skip_node s => - if sub_instrs { - print_sub_instrs () - } else { - F.fprintf fmt "skip (%s) %a" s pp_loc () - } - | Start_node _ => - if sub_instrs { - print_sub_instrs () - } else { - F.fprintf fmt "start %a" pp_loc () - } - | Join_node => - if sub_instrs { - print_sub_instrs () - } else { - F.fprintf fmt "join %a" pp_loc () - } - } - }; - - /** Dump extended instructions for the node */ - let d_instrs sub_instrs::(sub_instrs: bool) (curr_instr: option Sil.instr) (node: t) => L.add_print_action ( - L.PTnode_instrs, - Obj.repr (sub_instrs, curr_instr, node) - ); - - /** Return a description of the cfg node */ - let get_description pe node => { - let str = - switch (get_kind node) { - | Stmt_node _ => "Instructions" - | Prune_node _ _ descr => "Conditional" ^ " " ^ descr - | Exit_node _ => "Exit" - | Skip_node _ => "Skip" - | Start_node _ => "Start" - | Join_node => "Join" - }; - let pp fmt () => F.fprintf fmt "%s\n%a@?" str (pp_instrs pe None sub_instrs::true) node; - pp_to_string pp () - }; -}; - -/* =============== END of module Node =============== */ - -/** Map over nodes */ -let module NodeMap = Map.Make Node; - - -/** Hash table with nodes as keys. */ -let module NodeHash = Hashtbl.Make Node; - - -/** Set of nodes. */ -let module NodeSet = Node.NodeSet; - - -/** Map with node id keys. */ -let module IdMap = Node.IdMap; - -/* =============== START of module Procdesc =============== */ -let module Procdesc = { - - /** procedure description */ - type t = { - attributes: ProcAttributes.t, /** attributes of the procedure */ - id: int, /** unique proc_desc identifier */ - mutable nodes: list Node.t, /** list of nodes of this procedure */ - mutable nodes_num: int, /** number of nodes */ - mutable start_node: Node.t, /** start node of this procedure */ - mutable exit_node: Node.t /** exit node of ths procedure */ - }; - - /** Compute the distance of each node to the exit node, if not computed already */ - let compute_distance_to_exit_node pdesc => { - let exit_node = pdesc.exit_node; - let rec mark_distance dist nodes => { - let next_nodes = ref []; - let do_node (node: Node.t) => - switch node.dist_exit { - | Some _ => () - | None => - node.dist_exit = Some dist; - next_nodes := node.preds @ !next_nodes - }; - IList.iter do_node nodes; - if (!next_nodes !== []) { - mark_distance (dist + 1) !next_nodes - } - }; - mark_distance 0 [exit_node] - }; - - /** check or indicate if we have performed preanalysis on the CFG */ - let did_preanalysis pdesc => pdesc.attributes.did_preanalysis; - let signal_did_preanalysis pdesc => pdesc.attributes.did_preanalysis = true; - let get_attributes pdesc => pdesc.attributes; - let get_err_log pdesc => pdesc.attributes.err_log; - let get_exit_node pdesc => pdesc.exit_node; - - /** Get flags for the proc desc */ - let get_flags pdesc => pdesc.attributes.proc_flags; - - /** Return name and type of formal parameters */ - let get_formals pdesc => pdesc.attributes.formals; - let get_loc pdesc => pdesc.attributes.loc; - - /** Return name and type of local variables */ - let get_locals pdesc => pdesc.attributes.locals; - - /** Return name and type of captured variables */ - let get_captured pdesc => pdesc.attributes.captured; - - /** Return the visibility attribute */ - let get_access pdesc => pdesc.attributes.access; - let get_nodes pdesc => pdesc.nodes; - let get_proc_name pdesc => pdesc.attributes.proc_name; - - /** Return the return type of the procedure */ - let get_ret_type pdesc => pdesc.attributes.ret_type; - let get_ret_var pdesc => Pvar.mk Ident.name_return (get_proc_name pdesc); - let get_start_node pdesc => pdesc.start_node; - - /** List of nodes in the procedure sliced by a predicate up to the first branching */ - let get_sliced_slope pdesc f => - Node.get_generated_slope (get_start_node pdesc) (fun n => Node.get_sliced_succs n f); - - /** List of nodes in the procedure up to the first branching */ - let get_slope pdesc => Node.get_generated_slope (get_start_node pdesc) Node.get_succs; - - /** Return [true] iff the procedure is defined, and not just declared */ - let is_defined pdesc => pdesc.attributes.is_defined; - let is_java_synchronized pdesc => pdesc.attributes.is_java_synchronized_method; - let iter_nodes f pdesc => IList.iter f (IList.rev (get_nodes pdesc)); - let fold_calls f acc pdesc => { - let do_node a node => - IList.fold_left - (fun b callee_pname => f b (callee_pname, Node.get_loc node)) a (Node.get_callees node); - IList.fold_left do_node acc (get_nodes pdesc) - }; - - /** iterate over the calls from the procedure: (callee,location) pairs */ - let iter_calls f pdesc => fold_calls (fun _ call => f call) () pdesc; - let iter_instrs f pdesc => { - let do_node node => IList.iter (fun i => f node i) (Node.get_instrs node); - iter_nodes do_node pdesc - }; - let fold_nodes f acc pdesc => IList.fold_left f acc (IList.rev (get_nodes pdesc)); - let fold_instrs f acc pdesc => { - let fold_node acc node => - IList.fold_left (fun acc instr => f acc node instr) acc (Node.get_instrs node); - fold_nodes fold_node acc pdesc - }; - let iter_slope f pdesc => { - let visited = ref NodeSet.empty; - let rec do_node node => { - visited := NodeSet.add node !visited; - f node; - switch (Node.get_succs node) { - | [n] => - if (not (NodeSet.mem n !visited)) { - do_node n - } - | _ => () - } - }; - do_node (get_start_node pdesc) - }; - let iter_slope_calls f pdesc => { - let do_node node => IList.iter (fun callee_pname => f callee_pname) (Node.get_callees node); - iter_slope do_node pdesc - }; - - /** iterate between two nodes or until we reach a branching structure */ - let iter_slope_range f src_node dst_node => { - let visited = ref NodeSet.empty; - let rec do_node node => { - visited := NodeSet.add node !visited; - f node; - switch (Node.get_succs node) { - | [n] => - if (not (NodeSet.mem n !visited) && not (Node.equal node dst_node)) { - do_node n - } - | _ => () - } - }; - do_node src_node - }; - - /** Set the exit node of the proc desc */ - let set_exit_node pdesc node => pdesc.exit_node = node; - - /** Set a flag for the proc desc */ - let set_flag pdesc key value => proc_flags_add pdesc.attributes.proc_flags key value; - - /** Set the start node of the proc desc */ - let set_start_node pdesc node => pdesc.start_node = node; - - /** Append the locals to the list of local variables */ - let append_locals pdesc new_locals => - pdesc.attributes.locals = pdesc.attributes.locals @ new_locals; - - /** Set the successor nodes and exception nodes, and build predecessor links */ - let set_succs_exn_base (node: Node.t) succs exn => { - node.succs = succs; - node.exn = exn; - IList.iter (fun (n: Node.t) => n.preds = [node, ...n.preds]) succs - }; - - /** Create a new cfg node */ - let create_node pdesc loc kind instrs => { - pdesc.nodes_num = pdesc.nodes_num + 1; - let node_id = pdesc.nodes_num; - let node = { - Node.id: node_id, - dist_exit: None, - instrs, - kind, - loc, - preds: [], - pname: Some pdesc.attributes.proc_name, - succs: [], - exn: [] - }; - pdesc.nodes = [node, ...pdesc.nodes]; - node - }; - - /** Set the successor and exception nodes. - If this is a join node right before the exit node, add an extra node in the middle, - otherwise nullify and abstract instructions cannot be added after a conditional. */ - let node_set_succs_exn pdesc (node: Node.t) succs exn => - switch (node.kind, succs) { - | (Join_node, [{Node.kind: Exit_node _} as exit_node]) => - let kind = Node.Stmt_node "between_join_and_exit"; - let node' = create_node pdesc node.loc kind node.instrs; - set_succs_exn_base node [node'] exn; - set_succs_exn_base node' [exit_node] exn - | _ => set_succs_exn_base node succs exn - }; -}; - -/* =============== END of module Procdesc =============== */ /** data type for the control flow graph */ -type cfg = { - mutable proc_desc_id_counter: int /** Counter for identifiers of procdescs */, - proc_desc_table: Procname.Hash.t Procdesc.t /** Map proc name to procdesc */ -}; +type cfg = {proc_desc_table: Procname.Hash.t Procdesc.t /** Map proc name to procdesc */}; /** create a new empty cfg */ -let create_cfg () => {proc_desc_id_counter: 0, proc_desc_table: Procname.Hash.create 16}; +let create_cfg () => {proc_desc_table: Procname.Hash.create 16}; let add_proc_desc cfg pname pdesc => Procname.Hash.add cfg.proc_desc_table pname pdesc; @@ -529,15 +38,7 @@ let find_proc_desc_from_name cfg pname => /** Create a new procdesc */ let create_proc_desc cfg (proc_attributes: ProcAttributes.t) => { - cfg.proc_desc_id_counter = cfg.proc_desc_id_counter + 1; - let pdesc = { - Procdesc.attributes: proc_attributes, - id: cfg.proc_desc_id_counter, - nodes: [], - nodes_num: 0, - start_node: Node.dummy (), - exit_node: Node.dummy () - }; + let pdesc = Procdesc.from_proc_attributes called_from_cfg::true proc_attributes; add_proc_desc cfg proc_attributes.proc_name pdesc; pdesc }; @@ -545,7 +46,8 @@ let create_proc_desc cfg (proc_attributes: ProcAttributes.t) => { /** Iterate over all the nodes in the cfg */ let iter_all_nodes f cfg => { - let do_proc_desc _ (pdesc: Procdesc.t) => IList.iter (fun node => f pdesc node) pdesc.nodes; + let do_proc_desc _ (pdesc: Procdesc.t) => + IList.iter (fun node => f pdesc node) (Procdesc.get_nodes pdesc); iter_proc_desc cfg do_proc_desc }; @@ -566,20 +68,20 @@ let get_defined_procs cfg => IList.filter Procdesc.is_defined (get_all_procs cfg /** checks whether a cfg is connected or not */ let check_cfg_connectedness cfg => { let is_exit_node n => - switch (Node.get_kind n) { - | Node.Exit_node _ => true + switch (Procdesc.Node.get_kind n) { + | Procdesc.Node.Exit_node _ => true | _ => false }; let broken_node n => { - let succs = Node.get_succs n; - let preds = Node.get_preds n; - switch (Node.get_kind n) { - | Node.Start_node _ => IList.length succs == 0 || IList.length preds > 0 - | Node.Exit_node _ => IList.length succs > 0 || IList.length preds == 0 - | Node.Stmt_node _ - | Node.Prune_node _ - | Node.Skip_node _ => IList.length succs == 0 || IList.length preds == 0 - | Node.Join_node => + let succs = Procdesc.Node.get_succs n; + let preds = Procdesc.Node.get_preds n; + switch (Procdesc.Node.get_kind n) { + | Procdesc.Node.Start_node _ => IList.length succs == 0 || IList.length preds > 0 + | Procdesc.Node.Exit_node _ => IList.length succs > 0 || IList.length preds == 0 + | Procdesc.Node.Stmt_node _ + | Procdesc.Node.Prune_node _ + | Procdesc.Node.Skip_node _ => IList.length succs == 0 || IList.length preds == 0 + | Procdesc.Node.Join_node => /* Join node has the exception that it may be without predecessors and pointing to an exit node */ /* if the if brances end with a return */ @@ -741,10 +243,10 @@ let proc_inline_synthetic_methods cfg pdesc :unit => { modified := true; instr' }; - let instrs = Node.get_instrs node; + let instrs = Procdesc.Node.get_instrs node; let instrs' = IList.map do_instr instrs; if !modified { - Node.replace_instrs node instrs' + Procdesc.Node.replace_instrs node instrs' } }; Procdesc.iter_nodes node_inline_synthetic_methods pdesc @@ -767,26 +269,24 @@ let mark_unchanged_pdescs cfg_new cfg_old => { /* map of exp names in pd1 -> exp names in pd2 */ let exp_map = ref Exp.Map.empty; /* map of node id's in pd1 -> node id's in pd2 */ - let id_map = ref IntMap.empty; + let node_map = ref Procdesc.NodeMap.empty; /* formals are the same if their types are the same */ let formals_eq formals1 formals2 => IList.equal (fun (_, typ1) (_, typ2) => Typ.compare typ1 typ2) formals1 formals2; let nodes_eq n1s n2s => { /* nodes are the same if they have the same id, instructions, and succs/preds up to renaming with [exp_map] and [id_map] */ - let node_eq (n1: Node.t) (n2: Node.t) => { - let id_compare (n1: Node.t) (n2: Node.t) => { - let (id1, id2) = (n1.id, n2.id); + let node_eq (n1: Procdesc.Node.t) (n2: Procdesc.Node.t) => { + let id_compare (n1: Procdesc.Node.t) (n2: Procdesc.Node.t) => try { - let id1_mapping = IntMap.find id1 !id_map; - Pervasives.compare id1_mapping id2 + let n1_mapping = Procdesc.NodeMap.find n1 !node_map; + Procdesc.Node.compare n1_mapping n2 } { | Not_found => /* assume id's are equal and enforce by adding to [id_map] */ - id_map := IntMap.add id1 id2 !id_map; + node_map := Procdesc.NodeMap.add n1 n2 !node_map; 0 - } - }; + }; let instrs_eq instrs1 instrs2 => IList.equal ( @@ -799,18 +299,20 @@ let mark_unchanged_pdescs cfg_new cfg_old => { instrs1 instrs2; id_compare n1 n2 == 0 && - IList.equal id_compare n1.succs n2.succs && - IList.equal id_compare n1.preds n2.preds && instrs_eq n1.instrs n2.instrs + IList.equal Procdesc.Node.compare (Procdesc.Node.get_succs n1) (Procdesc.Node.get_succs n2) && + IList.equal Procdesc.Node.compare (Procdesc.Node.get_preds n1) (Procdesc.Node.get_preds n2) && + instrs_eq (Procdesc.Node.get_instrs n1) (Procdesc.Node.get_instrs n2) }; try (IList.for_all2 node_eq n1s n2s) { | Invalid_argument _ => false } }; - let att1 = pd1.attributes - and att2 = pd2.attributes; + let att1 = Procdesc.get_attributes pd1 + and att2 = Procdesc.get_attributes pd2; att1.is_defined == att2.is_defined && Typ.equal att1.ret_type att2.ret_type && - formals_eq att1.formals att2.formals && nodes_eq pd1.nodes pd2.nodes + formals_eq att1.formals att2.formals && + nodes_eq (Procdesc.get_nodes pd1) (Procdesc.get_nodes pd2) }; let old_procs = cfg_old.proc_desc_table; let new_procs = cfg_new.proc_desc_table; @@ -819,9 +321,9 @@ let mark_unchanged_pdescs cfg_new cfg_old => { let old_pdesc = Procname.Hash.find old_procs pname; let changed = /* in continue_capture mode keep the old changed bit */ - Config.continue_capture && old_pdesc.attributes.changed || + Config.continue_capture && (Procdesc.get_attributes old_pdesc).changed || not (pdescs_eq old_pdesc new_pdesc); - new_pdesc.attributes.changed = changed + (Procdesc.get_attributes new_pdesc).changed = changed } { | Not_found => () }; @@ -940,14 +442,14 @@ let specialize_types_proc callee_pdesc resolved_pdesc substitutions => { instrs; let convert_node_kind = fun - | Node.Start_node _ => Node.Start_node resolved_pname - | Node.Exit_node _ => Node.Exit_node resolved_pname + | Procdesc.Node.Start_node _ => Procdesc.Node.Start_node resolved_pname + | Procdesc.Node.Exit_node _ => Procdesc.Node.Exit_node resolved_pname | node_kind => node_kind; - let node_map = ref NodeMap.empty; + let node_map = ref Procdesc.NodeMap.empty; let rec convert_node node => { - let loc = Node.get_loc node - and kind = convert_node_kind (Node.get_kind node) - and instrs = IList.fold_left convert_instr [] (Node.get_instrs node) |> IList.rev; + let loc = Procdesc.Node.get_loc node + and kind = convert_node_kind (Procdesc.Node.get_kind node) + and instrs = IList.fold_left convert_instr [] (Procdesc.Node.get_instrs node) |> IList.rev; Procdesc.create_node resolved_pdesc loc kind instrs } and loop callee_nodes => @@ -955,16 +457,16 @@ let specialize_types_proc callee_pdesc resolved_pdesc substitutions => { | [] => [] | [node, ...other_node] => let converted_node = - try (NodeMap.find node !node_map) { + try (Procdesc.NodeMap.find node !node_map) { | Not_found => let new_node = convert_node node - and successors = Node.get_succs node - and exn_nodes = Node.get_exn node; - node_map := NodeMap.add node new_node !node_map; - if (Node.equal node callee_start_node) { + and successors = Procdesc.Node.get_succs node + and exn_nodes = Procdesc.Node.get_exn node; + node_map := Procdesc.NodeMap.add node new_node !node_map; + if (Procdesc.Node.equal node callee_start_node) { Procdesc.set_start_node resolved_pdesc new_node }; - if (Node.equal node callee_exit_node) { + if (Procdesc.Node.equal node callee_exit_node) { Procdesc.set_exit_node resolved_pdesc new_node }; Procdesc.node_set_succs_exn callee_pdesc new_node (loop successors) (loop exn_nodes); diff --git a/infer/src/IR/Cfg.rei b/infer/src/IR/Cfg.rei index 1a081e689..98484308f 100644 --- a/infer/src/IR/Cfg.rei +++ b/infer/src/IR/Cfg.rei @@ -15,221 +15,6 @@ open! Utils; /** Control Flow Graph for Interprocedural Analysis */ -/** node of the control flow graph */ -let module Node: { - - /** type of nodes */ - type t; - - /** node id */ - type id = private int; - - /** kind of cfg node */ - type nodekind = - | Start_node Procname.t - | Exit_node Procname.t - | Stmt_node string - | Join_node - | Prune_node bool Sil.if_kind string /** (true/false branch, if_kind, comment) */ - | Skip_node string; - - /** kind of Stmt_node for an exception handler. */ - let exn_handler_kind: nodekind; - - /** kind of Stmt_node for an exceptions sink. */ - let exn_sink_kind: nodekind; - - /** kind of Stmt_node for a throw instruction. */ - let throw_kind: nodekind; - - /** Add declarations for local variables and return variable to the node */ - let add_locals_ret_declaration: t => ProcAttributes.t => list (Mangled.t, Typ.t) => unit; - - /** Append the instructions to the list of instructions to execute */ - let append_instrs: t => list Sil.instr => unit; - - /** Compare two nodes */ - let compare: t => t => int; - - /** Dump extended instructions for the node */ - let d_instrs: sub_instrs::bool => option Sil.instr => t => unit; - - /** Create a dummy node */ - let dummy: unit => t; - - /** Check if two nodes are equal */ - let equal: t => t => bool; - - /** Get the list of callee procnames from the node */ - let get_callees: t => list Procname.t; - - /** Return a description of the node */ - let get_description: printenv => t => string; - - /** Get the distance to the exit node, if it has been computed */ - let get_distance_to_exit: t => option int; - - /** Get the exception nodes from the current node */ - let get_exn: t => list t; - - /** Get a list of unique nodes until the first branch starting - from a node with subsequent applications of a generator function */ - let get_generated_slope: t => (t => list t) => list t; - - /** Get the unique id of the node */ - let get_id: t => id; - - /** Get the instructions to be executed */ - let get_instrs: t => list Sil.instr; - - /** Get the kind of the current node */ - let get_kind: t => nodekind; - - /** Get the source location of the last instruction in the node */ - let get_last_loc: t => Location.t; - - /** Get the source location of the node */ - let get_loc: t => Location.t; - - /** Get the predecessor nodes of the current node */ - let get_preds: t => list t; - - /** Get the name of the procedure the node belongs to */ - let get_proc_name: t => Procname.t; - - /** Get the predecessor nodes of a node where the given predicate evaluates to true */ - let get_sliced_preds: t => (t => bool) => list t; - - /** Get the successor nodes of a node where the given predicate evaluates to true */ - let get_sliced_succs: t => (t => bool) => list t; - - /** Get the successor nodes of the current node */ - let get_succs: t => list t; - - /** Hash function for nodes */ - let hash: t => int; - - /** compare node ids */ - let id_compare: id => id => int; - - /** Comparison for node kind */ - let kind_compare: nodekind => nodekind => int; - - /** Pretty print the node */ - let pp: Format.formatter => t => unit; - - /** Pretty print a node id */ - let pp_id: Format.formatter => id => unit; - - /** Print extended instructions for the node, - highlighting the given subinstruction if present */ - let pp_instrs: printenv => sub_instrs::bool => option Sil.instr => Format.formatter => t => unit; - - /** Replace the instructions to be executed. */ - let replace_instrs: t => list Sil.instr => unit; -}; - - -/** procedure description */ -let module Procdesc: { - - /** proc description */ - type t; - - /** append a list of new local variables to the existing list of local variables */ - let append_locals: t => list (Mangled.t, Typ.t) => unit; - - /** Compute the distance of each node to the exit node, if not computed already */ - let compute_distance_to_exit_node: t => unit; - - /** Create a new cfg node with the given location, kind, list of instructions, - and add it to the procdesc. */ - let create_node: t => Location.t => Node.nodekind => list Sil.instr => Node.t; - - /** true if we ran the preanalysis on the CFG associated with [t] */ - let did_preanalysis: t => bool; - - /** fold over the calls from the procedure: (callee, location) pairs */ - let fold_calls: ('a => (Procname.t, Location.t) => 'a) => 'a => t => 'a; - - /** fold over all nodes and their instructions */ - let fold_instrs: ('a => Node.t => Sil.instr => 'a) => 'a => t => 'a; - - /** Return the visibility attribute */ - let get_access: t => PredSymb.access; - - /** Get the attributes of the procedure. */ - let get_attributes: t => ProcAttributes.t; - - /** Return name and type of block's captured variables */ - let get_captured: t => list (Mangled.t, Typ.t); - let get_err_log: t => Errlog.t; - let get_exit_node: t => Node.t; - - /** Get flags for the proc desc */ - let get_flags: t => proc_flags; - - /** Return name and type of formal parameters */ - let get_formals: t => list (Mangled.t, Typ.t); - - /** Return loc information for the procedure */ - let get_loc: t => Location.t; - - /** Return name and type of local variables */ - let get_locals: t => list (Mangled.t, Typ.t); - let get_nodes: t => list Node.t; - let get_proc_name: t => Procname.t; - - /** Return the return type of the procedure and type string */ - let get_ret_type: t => Typ.t; - let get_ret_var: t => Pvar.t; - - /** Get the sliced procedure's nodes up until the first branching */ - let get_sliced_slope: t => (Node.t => bool) => list Node.t; - - /** Get the procedure's nodes up until the first branching */ - let get_slope: t => list Node.t; - let get_start_node: t => Node.t; - - /** Return [true] iff the procedure is defined, and not just declared */ - let is_defined: t => bool; - - /** Return [true] if the procedure signature has the Java synchronized keyword */ - let is_java_synchronized: t => bool; - - /** iterate over the calls from the procedure: (callee, location) pairs */ - let iter_calls: ((Procname.t, Location.t) => unit) => t => unit; - - /** iterate over all nodes and their instructions */ - let iter_instrs: (Node.t => Sil.instr => unit) => t => unit; - - /** iterate over all the nodes of a procedure */ - let iter_nodes: (Node.t => unit) => t => unit; - - /** iterate over all nodes until we reach a branching structure */ - let iter_slope: (Node.t => unit) => t => unit; - - /** iterate over all calls until we reach a branching structure */ - let iter_slope_calls: (Procname.t => unit) => t => unit; - - /** iterate between two nodes or until we reach a branching structure */ - let iter_slope_range: (Node.t => unit) => Node.t => Node.t => unit; - - /** Set the successor nodes and exception nodes, and build predecessor links */ - let node_set_succs_exn: t => Node.t => list Node.t => list Node.t => unit; - - /** Set the exit node of the procedure */ - let set_exit_node: t => Node.t => unit; - - /** Set a flag for the proc desc */ - let set_flag: t => string => string => unit; - let set_start_node: t => Node.t => unit; - - /** indicate that we have performed preanalysis on the CFG assoociated with [t] */ - let signal_did_preanalysis: t => unit; -}; - - /** A control-flow graph */ type cfg; @@ -243,18 +28,6 @@ let store_cfg_to_file: save_sources::bool? => source_file::DB.source_file => DB.filename => cfg => unit; -/** Hash table with nodes as keys. */ -let module NodeHash: Hashtbl.S with type key = Node.t; - - -/** Set of nodes. */ -let module NodeSet: Set.S with type elt = Node.t; - - -/** Map with node id keys. */ -let module IdMap: Map.S with type key = Node.id; - - /** {2 Functions for manipulating an interprocedural CFG} */ /** create a new empty cfg */ @@ -282,7 +55,7 @@ let get_defined_procs: cfg => list Procdesc.t; /** Iterate over all the nodes in the cfg */ -let iter_all_nodes: (Procdesc.t => Node.t => unit) => cfg => unit; +let iter_all_nodes: (Procdesc.t => Procdesc.Node.t => unit) => cfg => unit; /** checks whether a cfg is connected or not */ diff --git a/infer/src/IR/Procdesc.re b/infer/src/IR/Procdesc.re new file mode 100644 index 000000000..64edb1749 --- /dev/null +++ b/infer/src/IR/Procdesc.re @@ -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 + }; diff --git a/infer/src/IR/Procdesc.rei b/infer/src/IR/Procdesc.rei new file mode 100644 index 000000000..7fd72425b --- /dev/null +++ b/infer/src/IR/Procdesc.rei @@ -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; diff --git a/infer/src/backend/BuiltinDefn.ml b/infer/src/backend/BuiltinDefn.ml index 7c888cf70..6d013fac5 100644 --- a/infer/src/backend/BuiltinDefn.ml +++ b/infer/src/backend/BuiltinDefn.ml @@ -60,7 +60,7 @@ let return_result tenv e prop ret_id = (* Return the new prop and the array length *) (* Return None if it fails to add the array *) let add_array_to_prop tenv pdesc prop_ lexp typ = - let pname = Cfg.Procdesc.get_proc_name pdesc in + let pname = Procdesc.get_proc_name pdesc in let n_lexp, prop = check_arith_norm_exp tenv pname lexp prop_ in begin try @@ -112,7 +112,7 @@ let execute___set_array_length { Builtin.tenv; pdesc; prop_; path; ret_id; args; (match add_array_to_prop tenv pdesc prop_ lexp typ with | None -> [] | Some (_, prop_a) -> (* Invariant: prop_a has an array pointed to by lexp *) - let pname = Cfg.Procdesc.get_proc_name pdesc in + let pname = Procdesc.get_proc_name pdesc in let n_lexp, prop__ = check_arith_norm_exp tenv pname lexp prop_a in let n_len, prop = check_arith_norm_exp tenv pname len prop__ in let hpred, sigma' = IList.partition (function @@ -129,7 +129,7 @@ let execute___set_array_length { Builtin.tenv; pdesc; prop_; path; ret_id; args; let execute___print_value { Builtin.tenv; pdesc; prop_; path; args; } : Builtin.ret_typ = L.err "__print_value: "; - let pname = Cfg.Procdesc.get_proc_name pdesc in + let pname = Procdesc.get_proc_name pdesc in let do_arg (lexp, _) = let n_lexp, _ = check_arith_norm_exp tenv pname lexp prop_ in L.err "%a " Exp.pp n_lexp in @@ -194,7 +194,7 @@ let execute___get_type_of { Builtin.pdesc; tenv; prop_; path; ret_id; args; } : Builtin.ret_typ = match args with | [(lexp, typ)] -> - let pname = Cfg.Procdesc.get_proc_name pdesc in + let pname = Procdesc.get_proc_name pdesc in let n_lexp, prop = check_arith_norm_exp tenv pname lexp prop_ in let props = create_type tenv n_lexp typ prop in let aux prop = @@ -233,7 +233,7 @@ let execute___instanceof_cast ~instof : Builtin.ret_typ = match args with | [(val1_, typ1); (texp2_, _)] -> - let pname = Cfg.Procdesc.get_proc_name pdesc in + let pname = Procdesc.get_proc_name pdesc in let val1, prop__ = check_arith_norm_exp tenv pname val1_ prop_ in let texp2, prop = check_arith_norm_exp tenv pname texp2_ prop__ in let is_cast_to_reference = @@ -332,7 +332,7 @@ let execute___set_file_attribute { Builtin.tenv; pdesc; prop_; path; ret_id; arg : Builtin.ret_typ = match args, ret_id with | [(lexp, _)], _ -> - let pname = Cfg.Procdesc.get_proc_name pdesc in + let pname = Procdesc.get_proc_name pdesc in let n_lexp, prop = check_arith_norm_exp tenv pname lexp prop_ in set_resource_attribute tenv prop path n_lexp loc PredSymb.Rfile | _ -> raise (Exceptions.Wrong_argument_number __POS__) @@ -342,7 +342,7 @@ let execute___set_lock_attribute { Builtin.tenv; pdesc; prop_; path; ret_id; arg : Builtin.ret_typ = match args, ret_id with | [(lexp, _)], _ -> - let pname = Cfg.Procdesc.get_proc_name pdesc in + let pname = Procdesc.get_proc_name pdesc in let n_lexp, prop = check_arith_norm_exp tenv pname lexp prop_ in set_resource_attribute tenv prop path n_lexp loc PredSymb.Rlock | _ -> raise (Exceptions.Wrong_argument_number __POS__) @@ -353,7 +353,7 @@ let execute___method_set_ignore_attribute { Builtin.tenv; pdesc; prop_; path; re : Builtin.ret_typ = match args, ret_id with | [_ ; (lexp, _)], _ -> - let pname = Cfg.Procdesc.get_proc_name pdesc in + let pname = Procdesc.get_proc_name pdesc in let n_lexp, prop = check_arith_norm_exp tenv pname lexp prop_ in set_resource_attribute tenv prop path n_lexp loc PredSymb.Rignore | _ -> raise (Exceptions.Wrong_argument_number __POS__) @@ -363,7 +363,7 @@ let execute___set_mem_attribute { Builtin.tenv; pdesc; prop_; path; ret_id; args : Builtin.ret_typ = match args, ret_id with | [(lexp, _)], _ -> - let pname = Cfg.Procdesc.get_proc_name pdesc in + let pname = Procdesc.get_proc_name pdesc in let n_lexp, prop = check_arith_norm_exp tenv pname lexp prop_ in set_resource_attribute tenv prop path n_lexp loc (PredSymb.Rmemory PredSymb.Mnew) | _ -> raise (Exceptions.Wrong_argument_number __POS__) @@ -374,7 +374,7 @@ let execute___check_untainted : Builtin.ret_typ = match args, ret_id with | [(lexp, _)], _ -> - let caller_pname = Cfg.Procdesc.get_proc_name pdesc in + let caller_pname = Procdesc.get_proc_name pdesc in let n_lexp, prop = check_arith_norm_exp tenv caller_pname lexp prop_ in [(check_untainted tenv n_lexp PredSymb.Tk_unknown caller_pname callee_pname prop, path)] | _ -> raise (Exceptions.Wrong_argument_number __POS__) @@ -384,7 +384,7 @@ let execute___get_hidden_field { Builtin.tenv; pdesc; prop_; path; ret_id; args; : Builtin.ret_typ = match args with | [(lexp, _)] -> - let pname = Cfg.Procdesc.get_proc_name pdesc in + let pname = Procdesc.get_proc_name pdesc in let n_lexp, prop = check_arith_norm_exp tenv pname lexp prop_ in let ret_val = ref None in let return_val p = match !ret_val with @@ -423,7 +423,7 @@ let execute___set_hidden_field { Builtin.tenv; pdesc; prop_; path; args; } : Builtin.ret_typ = match args with | [(lexp1, _); (lexp2, _)] -> - let pname = Cfg.Procdesc.get_proc_name pdesc in + let pname = Procdesc.get_proc_name pdesc in let n_lexp1, prop__ = check_arith_norm_exp tenv pname lexp1 prop_ in let n_lexp2, prop = check_arith_norm_exp tenv pname lexp2 prop__ in let foot_var = lazy (Exp.Var (Ident.create_fresh Ident.kfootprint)) in @@ -531,7 +531,7 @@ let execute___set_autorelease_attribute : Builtin.ret_typ = match args, ret_id with | [(lexp, _)], _ -> - let pname = Cfg.Procdesc.get_proc_name pdesc in + let pname = Procdesc.get_proc_name pdesc in let prop = return_result tenv lexp prop_ ret_id in if Config.objc_memory_model_on then let n_lexp, prop = check_arith_norm_exp tenv pname lexp prop in @@ -570,12 +570,12 @@ let execute___release_autorelease_pool else execute___no_op prop_ path let set_attr tenv pdesc prop path exp attr = - let pname = Cfg.Procdesc.get_proc_name pdesc in + let pname = Procdesc.get_proc_name pdesc in let n_lexp, prop = check_arith_norm_exp tenv pname exp prop in [(Attribute.add_or_replace tenv prop (Apred (attr, [n_lexp])), path)] let delete_attr tenv pdesc prop path exp attr = - let pname = Cfg.Procdesc.get_proc_name pdesc in + let pname = Procdesc.get_proc_name pdesc in let n_lexp, prop = check_arith_norm_exp tenv pname exp prop in [(Attribute.remove tenv prop (Apred (attr, [n_lexp])), path)] @@ -604,7 +604,7 @@ let execute___set_locked_attribute builtin_args let execute___set_unlocked_attribute ({ Builtin.pdesc; loc; } as builtin_args) : Builtin.ret_typ = - let pname = Cfg.Procdesc.get_proc_name pdesc in + let pname = Procdesc.get_proc_name pdesc in (* ra_kind = Rrelease in following indicates unlocked *) let ra = { PredSymb.ra_kind = PredSymb.Rrelease; @@ -620,7 +620,7 @@ let execute___set_taint_attribute : Builtin.ret_typ = match args with | (exp, _) :: [(Exp.Const (Const.Cstr taint_kind_str), _)] -> - let taint_source = Cfg.Procdesc.get_proc_name pdesc in + let taint_source = Procdesc.get_proc_name pdesc in let taint_kind = match taint_kind_str with | "UnverifiedSSLSocket" -> PredSymb.Tk_unverified_SSL_socket | "SharedPreferenceData" -> PredSymb.Tk_shared_preferences_data @@ -636,7 +636,7 @@ let execute___set_untaint_attribute : Builtin.ret_typ = match args with | (exp, _) :: [] -> - let taint_source = Cfg.Procdesc.get_proc_name pdesc in + let taint_source = Procdesc.get_proc_name pdesc in let taint_kind = PredSymb.Tk_unknown in (* TODO: change builtin to specify taint kind *) set_attr tenv pdesc prop_ path exp (PredSymb.Auntaint { PredSymb.taint_source; taint_kind}) | _ -> @@ -646,7 +646,7 @@ let execute___objc_cast { Builtin.tenv; pdesc; prop_; path; ret_id; args; } : Builtin.ret_typ = match args with | [(val1_, _); (texp2_, _)] -> - let pname = Cfg.Procdesc.get_proc_name pdesc in + let pname = Procdesc.get_proc_name pdesc in let val1, prop__ = check_arith_norm_exp tenv pname val1_ prop_ in let texp2, prop = check_arith_norm_exp tenv pname texp2_ prop__ in (try @@ -717,7 +717,7 @@ let execute_free mk { Builtin.pdesc; instr; tenv; prop_; path; args; loc; } match args with | [(lexp, typ)] -> begin - let pname = Cfg.Procdesc.get_proc_name pdesc in + let pname = Procdesc.get_proc_name pdesc in let n_lexp, prop = check_arith_norm_exp tenv pname lexp prop_ in let prop_nonzero = (* case n_lexp!=0 *) Propset.to_proplist (prune tenv ~positive:true n_lexp prop) in @@ -735,7 +735,7 @@ let execute_free mk { Builtin.pdesc; instr; tenv; prop_; path; args; loc; } let execute_alloc mk can_return_null { Builtin.pdesc; tenv; prop_; path; ret_id; args; loc; } : Builtin.ret_typ = - let pname = Cfg.Procdesc.get_proc_name pdesc in + let pname = Procdesc.get_proc_name pdesc in let rec evaluate_char_sizeof e = match e with | Exp.Var _ -> e | Exp.UnOp (uop, e', typ) -> @@ -798,7 +798,7 @@ let execute___cxx_typeid ({ Builtin.pdesc; tenv; prop_; args; loc} as r) (let res = execute_alloc PredSymb.Mnew false { r with args = [type_info_exp] } in match rest with | [(field_exp, _); (lexp, typ)] -> - let pname = Cfg.Procdesc.get_proc_name pdesc in + let pname = Procdesc.get_proc_name pdesc in let n_lexp, prop = check_arith_norm_exp tenv pname lexp prop_ in let typ = try @@ -861,7 +861,7 @@ let execute__unwrap_exception { Builtin.tenv; pdesc; prop_; path; ret_id; args; match args with | [(ret_exn, _)] -> begin - let pname = Cfg.Procdesc.get_proc_name pdesc in + let pname = Procdesc.get_proc_name pdesc in let n_ret_exn, prop = check_arith_norm_exp tenv pname ret_exn prop_ in match n_ret_exn with | Exp.Exn exp -> @@ -875,7 +875,7 @@ let execute_return_first_argument { Builtin.tenv; pdesc; prop_; path; ret_id; ar : Builtin.ret_typ = match args with | (arg1_, _):: _ -> - let pname = Cfg.Procdesc.get_proc_name pdesc in + let pname = Procdesc.get_proc_name pdesc in let arg1, prop = check_arith_norm_exp tenv pname arg1_ prop_ in let prop' = return_result tenv arg1 prop ret_id in [(prop', path)] @@ -885,7 +885,7 @@ let execute___split_get_nth { Builtin.tenv; pdesc; prop_; path; ret_id; args; } : Builtin.ret_typ = match args with | [(lexp1, _); (lexp2, _); (lexp3, _)] -> - let pname = Cfg.Procdesc.get_proc_name pdesc in + let pname = Procdesc.get_proc_name pdesc in let n_lexp1, prop__ = check_arith_norm_exp tenv pname lexp1 prop_ in let n_lexp2, prop___ = check_arith_norm_exp tenv pname lexp2 prop__ in let n_lexp3, prop = check_arith_norm_exp tenv pname lexp3 prop___ in diff --git a/infer/src/backend/PropUtil.re b/infer/src/backend/PropUtil.re index 2c400728b..733738808 100644 --- a/infer/src/backend/PropUtil.re +++ b/infer/src/backend/PropUtil.re @@ -8,12 +8,11 @@ */ open! Utils; -let get_name_of_local (curr_f: Cfg.Procdesc.t) (x, _) => - Pvar.mk x (Cfg.Procdesc.get_proc_name curr_f); +let get_name_of_local (curr_f: Procdesc.t) (x, _) => Pvar.mk x (Procdesc.get_proc_name curr_f); /* returns a list of local static variables (ie local variables defined static) in a proposition */ -let get_name_of_objc_static_locals (curr_f: Cfg.Procdesc.t) p => { - let pname = Procname.to_string (Cfg.Procdesc.get_proc_name curr_f); +let get_name_of_objc_static_locals (curr_f: Procdesc.t) p => { + let pname = Procname.to_string (Procdesc.get_proc_name curr_f); let local_static e => switch e { /* is a local static if it's a global and it has a static local name */ @@ -143,8 +142,8 @@ let remove_abduced_retvars tenv p => { Prop.normalize tenv (Prop.set p' pi::pi_reach sigma::sigma_reach) }; -let remove_locals tenv (curr_f: Cfg.Procdesc.t) p => { - let names_of_locals = IList.map (get_name_of_local curr_f) (Cfg.Procdesc.get_locals curr_f); +let remove_locals tenv (curr_f: Procdesc.t) p => { + let names_of_locals = IList.map (get_name_of_local curr_f) (Procdesc.get_locals curr_f); let names_of_locals' = switch !Config.curr_language { | Config.Clang => @@ -165,31 +164,31 @@ let remove_locals tenv (curr_f: Cfg.Procdesc.t) p => { ) }; -let remove_formals tenv (curr_f: Cfg.Procdesc.t) p => { - let pname = Cfg.Procdesc.get_proc_name curr_f; - let formal_vars = IList.map (fun (n, _) => Pvar.mk n pname) (Cfg.Procdesc.get_formals curr_f); +let remove_formals tenv (curr_f: Procdesc.t) p => { + let pname = Procdesc.get_proc_name curr_f; + let formal_vars = IList.map (fun (n, _) => Pvar.mk n pname) (Procdesc.get_formals curr_f); Attribute.deallocate_stack_vars tenv p formal_vars }; /** remove the return variable from the prop */ -let remove_ret tenv (curr_f: Cfg.Procdesc.t) (p: Prop.t Prop.normal) => { - let pname = Cfg.Procdesc.get_proc_name curr_f; - let name_of_ret = Cfg.Procdesc.get_ret_var curr_f; +let remove_ret tenv (curr_f: Procdesc.t) (p: Prop.t Prop.normal) => { + let pname = Procdesc.get_proc_name curr_f; + let name_of_ret = Procdesc.get_ret_var curr_f; let (_, p') = Attribute.deallocate_stack_vars tenv p [Pvar.to_callee pname name_of_ret]; p' }; /** remove locals and return variable from the prop */ -let remove_locals_ret tenv (curr_f: Cfg.Procdesc.t) p => snd ( +let remove_locals_ret tenv (curr_f: Procdesc.t) p => snd ( remove_locals tenv curr_f (remove_ret tenv curr_f p) ); /** Remove locals and formal parameters from the prop. Return the list of stack variables whose address was still present after deallocation. */ -let remove_locals_formals tenv (curr_f: Cfg.Procdesc.t) p => { +let remove_locals_formals tenv (curr_f: Procdesc.t) p => { let (pvars1, p1) = remove_formals tenv curr_f p; let (pvars2, p2) = remove_locals tenv curr_f p1; (pvars1 @ pvars2, p2) diff --git a/infer/src/backend/PropUtil.rei b/infer/src/backend/PropUtil.rei index 305538b93..9ffc0bf27 100644 --- a/infer/src/backend/PropUtil.rei +++ b/infer/src/backend/PropUtil.rei @@ -10,17 +10,17 @@ open! Utils; /** remove the return variable from the prop */ -let remove_ret: Tenv.t => Cfg.Procdesc.t => Prop.t Prop.normal => Prop.t Prop.normal; +let remove_ret: Tenv.t => Procdesc.t => Prop.t Prop.normal => Prop.t Prop.normal; /** remove locals and return variable from the prop */ -let remove_locals_ret: Tenv.t => Cfg.Procdesc.t => Prop.t Prop.normal => Prop.t Prop.normal; +let remove_locals_ret: Tenv.t => Procdesc.t => Prop.t Prop.normal => Prop.t Prop.normal; /** Deallocate the stack variables in [pvars], and replace them by normal variables. Return the list of stack variables whose address was still present after deallocation. */ let remove_locals_formals: - Tenv.t => Cfg.Procdesc.t => Prop.t Prop.normal => (list Pvar.t, Prop.t Prop.normal); + Tenv.t => Procdesc.t => Prop.t Prop.normal => (list Pvar.t, Prop.t Prop.normal); /** remove seed vars from a prop */ diff --git a/infer/src/backend/buckets.ml b/infer/src/backend/buckets.ml index 7ab20ce2a..80c830d35 100644 --- a/infer/src/backend/buckets.ml +++ b/infer/src/backend/buckets.ml @@ -27,18 +27,18 @@ let check_nested_loop path pos_opt = if verbose then L.d_strln "in nested loop"; true (* last two loop visits were entering loops *) | _ -> false in - let do_node_caller node = match Cfg.Node.get_kind node with - | Cfg.Node.Prune_node (b, (Sil.Ik_dowhile | Sil.Ik_for | Sil.Ik_while), _) -> + let do_node_caller node = match Procdesc.Node.get_kind node with + | Procdesc.Node.Prune_node (b, (Sil.Ik_dowhile | Sil.Ik_for | Sil.Ik_while), _) -> (* if verbose then *) (* L.d_strln ((if b then "enter" else "exit") ^ " node " *) - (* ^ (string_of_int (Cfg.Node.get_id node))); *) + (* ^ (string_of_int (Procdesc.Node.get_id node))); *) loop_visits_log := b :: !loop_visits_log | _ -> () in let do_any_node _level _node = incr trace_length; (* L.d_strln *) (* ("level " ^ string_of_int _level ^ *) - (* " (Cfg.Node.get_id node) " ^ string_of_int (Cfg.Node.get_id _node)) *) + (* " (Procdesc.Node.get_id node) " ^ string_of_int (Procdesc.Node.get_id _node)) *) in let f level p _ _ = match Paths.Path.curr_node p with | Some node -> @@ -54,11 +54,11 @@ let check_nested_loop path pos_opt = let check_access access_opt de_opt = let find_bucket line_number null_case_flag = let find_formal_ids node = (* find ids obtained by a letref on a formal parameter *) - let node_instrs = Cfg.Node.get_instrs node in + let node_instrs = Procdesc.Node.get_instrs node in let formals = match State.get_prop_tenv_pdesc () with | None -> [] | Some (_, _, pdesc) -> - Cfg.Procdesc.get_formals pdesc in + Procdesc.get_formals pdesc in let formal_names = IList.map fst formals in let is_formal pvar = let name = Pvar.get_name pvar in @@ -97,10 +97,10 @@ let check_access access_opt de_opt = | Sil.Store (_, _, e, _) -> exp_is_null e | _ -> false in - IList.exists filter (Cfg.Node.get_instrs node) in + IList.exists filter (Procdesc.Node.get_instrs node) in let local_access_found = ref false in let do_node node = - if (Cfg.Node.get_loc node).Location.line = line_number && has_call_or_sets_null node then + if (Procdesc.Node.get_loc node).Location.line = line_number && has_call_or_sets_null node then begin local_access_found := true end in diff --git a/infer/src/backend/builtin.ml b/infer/src/backend/builtin.ml index 34eef23ae..9298a0f8f 100644 --- a/infer/src/backend/builtin.ml +++ b/infer/src/backend/builtin.ml @@ -12,7 +12,7 @@ open! Utils (** Module for builtin functions with their symbolic execution handler *) type args = { - pdesc : Cfg.Procdesc.t; + pdesc : Procdesc.t; instr : Sil.instr; tenv : Tenv.t; prop_ : Prop.normal Prop.t; diff --git a/infer/src/backend/builtin.mli b/infer/src/backend/builtin.mli index 3efbe035f..e50efa71f 100644 --- a/infer/src/backend/builtin.mli +++ b/infer/src/backend/builtin.mli @@ -12,7 +12,7 @@ open! Utils (** Module for builtin functions with their symbolic execution handler *) type args = { - pdesc : Cfg.Procdesc.t; + pdesc : Procdesc.t; instr : Sil.instr; tenv : Tenv.t; prop_ : Prop.normal Prop.t; diff --git a/infer/src/backend/callbacks.ml b/infer/src/backend/callbacks.ml index d076ff628..e5dd92949 100644 --- a/infer/src/backend/callbacks.ml +++ b/infer/src/backend/callbacks.ml @@ -14,12 +14,12 @@ module L = Logging (** Module to register and invoke callbacks *) type proc_callback_args = { - get_proc_desc : Procname.t -> Cfg.Procdesc.t option; + get_proc_desc : Procname.t -> Procdesc.t option; get_procs_in_file : Procname.t -> Procname.t list; idenv : Idenv.t; tenv : Tenv.t; proc_name : Procname.t; - proc_desc : Cfg.Procdesc.t; + proc_desc : Procdesc.t; } type proc_callback_t = proc_callback_args -> unit @@ -27,8 +27,8 @@ type proc_callback_t = proc_callback_args -> unit type cluster_callback_t = Exe_env.t -> Procname.t list -> - (Procname.t -> Cfg.Procdesc.t option) -> - (Idenv.t * Tenv.t * Procname.t * Cfg.Procdesc.t) list -> + (Procname.t -> Procdesc.t option) -> + (Idenv.t * Tenv.t * Procname.t * Procdesc.t) list -> unit let procedure_callbacks = ref [] @@ -51,7 +51,7 @@ let get_procedure_definition exe_env proc_name = Option.map (fun proc_desc -> let idenv = Idenv.create proc_desc - and language = (Cfg.Procdesc.get_attributes proc_desc).ProcAttributes.language in + and language = (Procdesc.get_attributes proc_desc).ProcAttributes.language in (idenv, tenv, proc_name, proc_desc, language)) (Exe_env.get_proc_desc exe_env proc_name) @@ -68,7 +68,7 @@ let iterate_procedure_callbacks exe_env caller_pname = let get_procs_in_file proc_name = match Exe_env.get_cfg exe_env proc_name with | Some cfg-> - IList.map Cfg.Procdesc.get_proc_name (Cfg.get_defined_procs cfg) + IList.map Procdesc.get_proc_name (Cfg.get_defined_procs cfg) | None -> [] in diff --git a/infer/src/backend/callbacks.mli b/infer/src/backend/callbacks.mli index 01f28e93e..d71368277 100644 --- a/infer/src/backend/callbacks.mli +++ b/infer/src/backend/callbacks.mli @@ -12,12 +12,12 @@ open! Utils (** Module to register and invoke callbacks *) type proc_callback_args = { - get_proc_desc : Procname.t -> Cfg.Procdesc.t option; + get_proc_desc : Procname.t -> Procdesc.t option; get_procs_in_file : Procname.t -> Procname.t list; idenv : Idenv.t; tenv : Tenv.t; proc_name : Procname.t; - proc_desc : Cfg.Procdesc.t; + proc_desc : Procdesc.t; } (** Type of a procedure callback: @@ -31,8 +31,8 @@ type proc_callback_t = proc_callback_args -> unit type cluster_callback_t = Exe_env.t -> Procname.t list -> - (Procname.t -> Cfg.Procdesc.t option) -> - (Idenv.t * Tenv.t * Procname.t * Cfg.Procdesc.t) list -> + (Procname.t -> Procdesc.t option) -> + (Idenv.t * Tenv.t * Procname.t * Procdesc.t) list -> unit (** register a procedure callback *) diff --git a/infer/src/backend/dotty.ml b/infer/src/backend/dotty.ml index f7181881a..dbeeb8106 100644 --- a/infer/src/backend/dotty.ml +++ b/infer/src/backend/dotty.ml @@ -936,8 +936,8 @@ let pp_proplist_parsed2dotty_file filename plist = (********** Print control flow graph (in dot form) for fundec to *) (* channel. You have to compute an interprocedural cfg first *) -let pp_cfgnodename pname fmt (n : Cfg.Node.t) = - F.fprintf fmt "\"%s_%d\"" (Procname.to_filename pname) (Cfg.Node.get_id n :> int) +let pp_cfgnodename pname fmt (n : Procdesc.Node.t) = + F.fprintf fmt "\"%s_%d\"" (Procname.to_filename pname) (Procdesc.Node.get_id n :> int) let pp_etlist fmt etl = IList.iter (fun (id, ty) -> @@ -947,60 +947,62 @@ let pp_local_list fmt etl = IList.iter (fun (id, ty) -> Format.fprintf fmt " %a:%a" Mangled.pp id (Typ.pp_full pe_text) ty) etl -let pp_cfgnodelabel pdesc fmt (n : Cfg.Node.t) = +let pp_cfgnodelabel pdesc fmt (n : Procdesc.Node.t) = let pp_label fmt n = - match Cfg.Node.get_kind n with - | Cfg.Node.Start_node pname -> + match Procdesc.Node.get_kind n with + | Procdesc.Node.Start_node pname -> Format.fprintf fmt "Start %s\\nFormals: %a\\nLocals: %a" (Procname.to_string pname) - pp_etlist (Cfg.Procdesc.get_formals pdesc) - pp_local_list (Cfg.Procdesc.get_locals pdesc); - if IList.length (Cfg.Procdesc.get_captured pdesc) <> 0 then + pp_etlist (Procdesc.get_formals pdesc) + pp_local_list (Procdesc.get_locals pdesc); + if IList.length (Procdesc.get_captured pdesc) <> 0 then Format.fprintf fmt "\\nCaptured: %a" - pp_local_list (Cfg.Procdesc.get_captured pdesc) - | Cfg.Node.Exit_node pname -> + pp_local_list (Procdesc.get_captured pdesc) + | Procdesc.Node.Exit_node pname -> Format.fprintf fmt "Exit %s" (Procname.to_string pname) - | Cfg.Node.Join_node -> + | Procdesc.Node.Join_node -> Format.fprintf fmt "+" - | Cfg.Node.Prune_node (is_true_branch, _, _) -> + | Procdesc.Node.Prune_node (is_true_branch, _, _) -> Format.fprintf fmt "Prune (%b branch)" is_true_branch - | Cfg.Node.Stmt_node s -> Format.fprintf fmt " %s" s - | Cfg.Node.Skip_node s -> Format.fprintf fmt "Skip %s" s in + | Procdesc.Node.Stmt_node s -> Format.fprintf fmt " %s" s + | Procdesc.Node.Skip_node s -> Format.fprintf fmt "Skip %s" s in let instr_string i = let pp f () = Sil.pp_instr pe_text f i in let str = pp_to_string pp () in Escape.escape_dotty str in let pp_instrs fmt instrs = IList.iter (fun i -> F.fprintf fmt " %s\\n " (instr_string i)) instrs in - let instrs = Cfg.Node.get_instrs n in - F.fprintf fmt "%d: %a \\n %a" (Cfg.Node.get_id n :> int) pp_label n pp_instrs instrs - -let pp_cfgnodeshape fmt (n: Cfg.Node.t) = - match Cfg.Node.get_kind n with - | Cfg.Node.Start_node _ | Cfg.Node.Exit_node _ -> F.fprintf fmt "color=yellow style=filled" - | Cfg.Node.Prune_node _ -> F.fprintf fmt "shape=\"invhouse\"" - | Cfg.Node.Skip_node _ -> F.fprintf fmt "color=\"gray\"" - | Cfg.Node.Stmt_node _ -> F.fprintf fmt "shape=\"box\"" + let instrs = Procdesc.Node.get_instrs n in + F.fprintf fmt "%d: %a \\n %a" (Procdesc.Node.get_id n :> int) pp_label n pp_instrs instrs + +let pp_cfgnodeshape fmt (n: Procdesc.Node.t) = + match Procdesc.Node.get_kind n with + | Procdesc.Node.Start_node _ + | Procdesc.Node.Exit_node _ -> F.fprintf fmt "color=yellow style=filled" + | Procdesc.Node.Prune_node _ -> F.fprintf fmt "shape=\"invhouse\"" + | Procdesc.Node.Skip_node _ -> F.fprintf fmt "color=\"gray\"" + | Procdesc.Node.Stmt_node _ -> F.fprintf fmt "shape=\"box\"" | _ -> F.fprintf fmt "" -let pp_cfgnode pdesc fmt (n: Cfg.Node.t) = - let pname = Cfg.Procdesc.get_proc_name pdesc in +let pp_cfgnode pdesc fmt (n: Procdesc.Node.t) = + let pname = Procdesc.get_proc_name pdesc in F.fprintf fmt "%a [label=\"%a\" %a]\n\t\n" (pp_cfgnodename pname) n (pp_cfgnodelabel pdesc) n pp_cfgnodeshape n; let print_edge n1 n2 is_exn = let color = if is_exn then "[color=\"red\" ]" else "" in - match Cfg.Node.get_kind n2 with - | Cfg.Node.Exit_node _ when is_exn = true -> (* don't print exception edges to the exit node *) + match Procdesc.Node.get_kind n2 with + | Procdesc.Node.Exit_node _ + when is_exn = true -> (* don't print exception edges to the exit node *) () | _ -> F.fprintf fmt "\n\t %a -> %a %s;" (pp_cfgnodename pname) n1 (pp_cfgnodename pname) n2 color in - IList.iter (fun n' -> print_edge n n' false) (Cfg.Node.get_succs n); - IList.iter (fun n' -> print_edge n n' true) (Cfg.Node.get_exn n) + IList.iter (fun n' -> print_edge n n' false) (Procdesc.Node.get_succs n); + IList.iter (fun n' -> print_edge n n' true) (Procdesc.Node.get_exn n) (* * print control flow graph (in dot form) for fundec to channel let *) (* print_cfg_channel (chan : out_channel) (fd : fundec) = let pnode (s: *) @@ -1014,7 +1016,7 @@ let pp_cfgnode pdesc fmt (n: Cfg.Node.t) = (* special node, and call / return edges *) let print_icfg source fmt cfg = let print_node pdesc node = - let loc = Cfg.Node.get_loc node in + let loc = Procdesc.Node.get_loc node in if (Config.dotty_cfg_libs || DB.source_file_equal loc.Location.file source) then F.fprintf fmt "%a\n" (pp_cfgnode pdesc) node in Cfg.iter_all_nodes print_node cfg diff --git a/infer/src/backend/errdesc.ml b/infer/src/backend/errdesc.ml index ab01bed42..ebb9bfea2 100644 --- a/infer/src/backend/errdesc.ml +++ b/infer/src/backend/errdesc.ml @@ -71,16 +71,16 @@ let explain_deallocate_constant_string s ra = let verbose = Config.trace_error let find_in_node_or_preds start_node f_node_instr = - let visited = ref Cfg.NodeSet.empty in + let visited = ref Procdesc.NodeSet.empty in let rec find node = - if Cfg.NodeSet.mem node !visited then None + if Procdesc.NodeSet.mem node !visited then None else begin - visited := Cfg.NodeSet.add node !visited; - let instrs = Cfg.Node.get_instrs node in + visited := Procdesc.NodeSet.add node !visited; + let instrs = Procdesc.Node.get_instrs node in match IList.find_map_opt (f_node_instr node) (IList.rev instrs) with | Some res -> Some res - | None -> IList.find_map_opt find (Cfg.Node.get_preds node) + | None -> IList.find_map_opt find (Procdesc.Node.get_preds node) end in find start_node @@ -93,7 +93,7 @@ let find_variable_assigment node id : Sil.instr option = (** Check if a nullify instruction exists for the program variable after the given instruction *) let find_nullify_after_instr node instr pvar : bool = - let node_instrs = Cfg.Node.get_instrs node in + let node_instrs = Procdesc.Node.get_instrs node in let found_instr = ref false in let find_nullify = function | Sil.Nullify (pv, _) when !found_instr -> Pvar.equal pv pvar @@ -105,11 +105,11 @@ let find_nullify_after_instr node instr pvar : bool = (** Find the other prune node of a conditional (e.g. the false branch given the true branch of a conditional) *) let find_other_prune_node node = - match Cfg.Node.get_preds node with + match Procdesc.Node.get_preds node with | [n_pre] -> - (match Cfg.Node.get_succs n_pre with + (match Procdesc.Node.get_succs n_pre with | [n1; n2] -> - if Cfg.Node.equal n1 node then Some n2 else Some n1 + if Procdesc.Node.equal n1 node then Some n2 else Some n1 | _ -> None) | _ -> None @@ -118,13 +118,13 @@ let id_is_assigned_then_dead node id = match find_variable_assigment node id with | Some (Sil.Store (Exp.Lvar pvar, _, _, _) as instr) when Pvar.is_local pvar || Pvar.is_callee pvar -> - let is_prune = match Cfg.Node.get_kind node with - | Cfg.Node.Prune_node _ -> true + let is_prune = match Procdesc.Node.get_kind node with + | Procdesc.Node.Prune_node _ -> true | _ -> false in let prune_check = function (* if prune node, check that it's also nullified in the other branch *) | Some node' -> - (match Cfg.Node.get_instrs node' with + (match Procdesc.Node.get_instrs node' with | instr':: _ -> find_nullify_after_instr node' instr' pvar | _ -> false) | _ -> false in @@ -135,7 +135,7 @@ let id_is_assigned_then_dead node id = (** Find the function call instruction used to initialize normal variable [id], and return the function name and arguments *) let find_normal_variable_funcall - (node: Cfg.Node.t) + (node: Procdesc.Node.t) (id: Ident.t): (Exp.t * (Exp.t list) * Location.t * CallFlags.t) option = let find_declaration _ = function | Sil.Call (Some (id0, _), fun_exp, args, loc, call_flags) when Ident.equal id id0 -> @@ -148,12 +148,12 @@ let find_normal_variable_funcall ("find_normal_variable_funcall could not find " ^ Ident.to_string id ^ " in node " ^ - string_of_int (Cfg.Node.get_id node :> int)); + string_of_int (Procdesc.Node.get_id node :> int)); L.d_ln ()); res (** Find a program variable assignment in the current node or predecessors. *) -let find_program_variable_assignment node pvar : (Cfg.Node.t * Ident.t) option = +let find_program_variable_assignment node pvar : (Procdesc.Node.t * Ident.t) option = let find_instr node = function | Sil.Store (Exp.Lvar _pvar, _, Exp.Var id, _) when Pvar.equal pvar _pvar && Ident.is_normal id -> @@ -184,7 +184,7 @@ let find_struct_by_value_assignment node pvar = else None (** Find a program variable assignment to id in the current node or predecessors. *) -let find_ident_assignment node id : (Cfg.Node.t * Exp.t) option = +let find_ident_assignment node id : (Procdesc.Node.t * Exp.t) option = let find_instr node = function | Sil.Load (_id, e, _, _) when Ident.equal _id id -> Some (node, e) | _ -> None in @@ -192,14 +192,14 @@ let find_ident_assignment node id : (Cfg.Node.t * Exp.t) option = (** Find a boolean assignment to a temporary variable holding a boolean condition. The boolean parameter indicates whether the true or false branch is required. *) -let rec find_boolean_assignment node pvar true_branch : Cfg.Node.t option = +let rec find_boolean_assignment node pvar true_branch : Procdesc.Node.t option = let find_instr n = let filter = function | Sil.Store (Exp.Lvar _pvar, _, Exp.Const (Const.Cint i), _) when Pvar.equal pvar _pvar -> IntLit.iszero i <> true_branch | _ -> false in - IList.exists filter (Cfg.Node.get_instrs n) in - match Cfg.Node.get_preds node with + IList.exists filter (Procdesc.Node.get_instrs n) in + match Procdesc.Node.get_preds node with | [pred_node] -> find_boolean_assignment pred_node pvar true_branch | [n1; n2] -> if find_instr n1 then (Some n1) @@ -257,7 +257,7 @@ let rec _find_normal_variable_load tenv (seen : Exp.Set.t) node id : DExp.t opti ("find_normal_variable_load could not find " ^ Ident.to_string id ^ " in node " ^ - string_of_int (Cfg.Node.get_id node :> int)); + string_of_int (Procdesc.Node.get_id node :> int)); L.d_ln ()); res @@ -484,7 +484,7 @@ let explain_leak tenv hpred prop alloc_att_opt bucket = let instro = State.get_instr () in let loc = State.get_loc () in let node = State.get_node () in - let node_instrs = Cfg.Node.get_instrs node in + let node_instrs = Procdesc.Node.get_instrs node in let hpred_typ_opt = find_hpred_typ hpred in let value_str_from_pvars_vpath pvars vpath = if pvars <> [] then diff --git a/infer/src/backend/errdesc.mli b/infer/src/backend/errdesc.mli index 0a3238543..2b9fdf30c 100644 --- a/infer/src/backend/errdesc.mli +++ b/infer/src/backend/errdesc.mli @@ -17,7 +17,7 @@ open! Utils val vpath_find : Tenv.t -> 'a Prop.t -> Exp.t -> DecompiledExp.vpath * Typ.t option (** Return true if [id] is assigned to a program variable which is then nullified *) -val id_is_assigned_then_dead : Cfg.Node.t -> Ident.t -> bool +val id_is_assigned_then_dead : Procdesc.Node.t -> Ident.t -> bool (** Check whether the hpred is a |-> representing a resource in the Racquire state *) val hpred_is_open_resource : Tenv.t -> 'a Prop.t -> Sil.hpred -> PredSymb.resource option @@ -25,20 +25,21 @@ val hpred_is_open_resource : Tenv.t -> 'a Prop.t -> Sil.hpred -> PredSymb.resour (** Find the function call instruction used to initialize normal variable [id], and return the function name and arguments *) val find_normal_variable_funcall : - Cfg.Node.t -> Ident.t -> (Exp.t * (Exp.t list) * Location.t * CallFlags.t) option + Procdesc.Node.t -> Ident.t -> (Exp.t * (Exp.t list) * Location.t * CallFlags.t) option (** Find a program variable assignment in the current node or straightline predecessor. *) -val find_program_variable_assignment : Cfg.Node.t -> Pvar.t -> (Cfg.Node.t * Ident.t) option +val find_program_variable_assignment : + Procdesc.Node.t -> Pvar.t -> (Procdesc.Node.t * Ident.t) option (** Find a program variable assignment to id in the current node or predecessors. *) -val find_ident_assignment : Cfg.Node.t -> Ident.t -> (Cfg.Node.t * Exp.t) option +val find_ident_assignment : Procdesc.Node.t -> Ident.t -> (Procdesc.Node.t * Exp.t) option (** Find a boolean assignment to a temporary variable holding a boolean condition. The boolean parameter indicates whether the true or false branch is required. *) -val find_boolean_assignment : Cfg.Node.t -> Pvar.t -> bool -> Cfg.Node.t option +val find_boolean_assignment : Procdesc.Node.t -> Pvar.t -> bool -> Procdesc.Node.t option (** describe rvalue [e] as a dexp *) -val exp_rv_dexp : Tenv.t -> Cfg.Node.t -> Exp.t -> DecompiledExp.t option +val exp_rv_dexp : Tenv.t -> Procdesc.Node.t -> Exp.t -> DecompiledExp.t option (** Produce a description of a persistent reference to an Android Context *) val explain_context_leak : Procname.t -> Typ.t -> Ident.fieldname -> @@ -54,7 +55,7 @@ val explain_array_access : Tenv.t -> Localise.deref_str -> 'a Prop.t -> Location (** explain a class cast exception *) val explain_class_cast_exception : Tenv.t -> Procname.t option -> Exp.t -> Exp.t -> Exp.t -> - Cfg.Node.t -> Location.t -> Localise.error_desc + Procdesc.Node.t -> Location.t -> Localise.error_desc (** Explain a deallocate stack variable error *) val explain_deallocate_stack_var : Pvar.t -> PredSymb.res_action -> Localise.error_desc @@ -72,10 +73,10 @@ val explain_dereference : val explain_dereference_as_caller_expression : Tenv.t -> ?use_buckets:bool -> Localise.deref_str -> 'a Prop.t -> 'b Prop.t -> Exp.t -> - Cfg.Node.t -> Location.t -> Pvar.t list -> Localise.error_desc + Procdesc.Node.t -> Location.t -> Pvar.t list -> Localise.error_desc (** explain a division by zero *) -val explain_divide_by_zero : Tenv.t -> Exp.t -> Cfg.Node.t -> Location.t -> Localise.error_desc +val explain_divide_by_zero : Tenv.t -> Exp.t -> Procdesc.Node.t -> Location.t -> Localise.error_desc (** explain a return expression required *) val explain_return_expression_required : Location.t -> Typ.t -> Localise.error_desc @@ -88,7 +89,7 @@ val explain_condition_is_assignment : Location.t -> Localise.error_desc (** explain a condition which is always true or false *) val explain_condition_always_true_false : - Tenv.t -> IntLit.t -> Exp.t -> Cfg.Node.t -> Location.t -> Localise.error_desc + Tenv.t -> IntLit.t -> Exp.t -> Procdesc.Node.t -> Location.t -> Localise.error_desc (** explain the escape of a stack variable address from its scope *) val explain_stack_variable_address_escape : @@ -107,7 +108,7 @@ val explain_retain_cycle : (** explain unary minus applied to unsigned expression *) val explain_unary_minus_applied_to_unsigned_expression : - Tenv.t -> Exp.t -> Typ.t -> Cfg.Node.t -> Location.t -> Localise.error_desc + Tenv.t -> Exp.t -> Typ.t -> Procdesc.Node.t -> Location.t -> Localise.error_desc (** Explain a tainted value error *) val explain_tainted_value_reaching_sensitive_function : @@ -127,7 +128,7 @@ val explain_memory_access : Tenv.t -> Localise.deref_str -> 'a Prop.t -> Locatio (** explain a test for NULL of a dereferenced pointer *) val explain_null_test_after_dereference : - Tenv.t -> Exp.t -> Cfg.Node.t -> int -> Location.t -> Localise.error_desc + Tenv.t -> Exp.t -> Procdesc.Node.t -> int -> Location.t -> Localise.error_desc (** Print a warning to the err stream at the given location (note: only prints in developer mode) *) val warning_err : Location.t -> ('a, Format.formatter, unit) format -> 'a diff --git a/infer/src/backend/exe_env.mli b/infer/src/backend/exe_env.mli index 6dd7a3ef6..13c4c3582 100644 --- a/infer/src/backend/exe_env.mli +++ b/infer/src/backend/exe_env.mli @@ -41,7 +41,7 @@ val get_tenv : ?create:bool -> t -> Procname.t -> Tenv.t val get_cfg : t -> Procname.t -> Cfg.cfg option (** return the proc desc associated to the procedure *) -val get_proc_desc : t -> Procname.t -> Cfg.Procdesc.t option +val get_proc_desc : t -> Procname.t -> Procdesc.t option (** [iter_files f exe_env] applies [f] to the source file and tenv and cfg for each file in [exe_env] *) val iter_files : (DB.source_file -> Cfg.cfg -> unit) -> t -> unit diff --git a/infer/src/backend/interproc.ml b/infer/src/backend/interproc.ml index 9f7888652..e168e696f 100644 --- a/infer/src/backend/interproc.ml +++ b/infer/src/backend/interproc.ml @@ -18,7 +18,7 @@ module F = Format (** A node with a number of visits *) type visitednode = { - node: Cfg.Node.t; + node: Procdesc.Node.t; visits: int; } @@ -28,11 +28,11 @@ module NodeVisitSet = type t = visitednode let compare_ids n1 n2 = (* higher id is better *) - Cfg.Node.compare n2 n1 + Procdesc.Node.compare n2 n1 let compare_distance_to_exit { node = n1 } { node = n2 } = (* smaller means higher priority *) let n = - match Cfg.Node.get_distance_to_exit n1, Cfg.Node.get_distance_to_exit n2 with + match Procdesc.Node.get_distance_to_exit n1, Procdesc.Node.get_distance_to_exit n2 with | None, None -> 0 | None, Some _ -> @@ -59,11 +59,11 @@ module NodeVisitSet = module Join_table : sig type t - val add : t -> Cfg.Node.id -> Paths.PathSet.t -> unit + val add : t -> Procdesc.Node.id -> Paths.PathSet.t -> unit val create : unit -> t - val find : t -> Cfg.Node.id -> Paths.PathSet.t + val find : t -> Procdesc.Node.id -> Paths.PathSet.t end = struct - type t = (Cfg.Node.id, Paths.PathSet.t) Hashtbl.t + type t = (Procdesc.Node.id, Paths.PathSet.t) Hashtbl.t let create () : t = Hashtbl.create 11 @@ -78,14 +78,13 @@ end (* =============== START of module Worklist =============== *) module Worklist = struct - module NodeMap = Map.Make(Cfg.Node) type t = { join_table : Join_table.t; (** Table of join results *) - path_set_todo : (Cfg.Node.id, Paths.PathSet.t) Hashtbl.t; (** Pathset todo *) - path_set_visited : (Cfg.Node.id, Paths.PathSet.t) Hashtbl.t; (** Pathset visited *) + path_set_todo : (Procdesc.Node.id, Paths.PathSet.t) Hashtbl.t; (** Pathset todo *) + path_set_visited : (Procdesc.Node.id, Paths.PathSet.t) Hashtbl.t; (** Pathset visited *) mutable todo_set : NodeVisitSet.t; (** Set of nodes still to do, with visit count *) - mutable visit_map : int NodeMap.t; (** Map from nodes done to visit count *) + mutable visit_map : int Procdesc.NodeMap.t; (** Map from nodes done to visit count *) } let create () = { @@ -93,26 +92,26 @@ module Worklist = struct path_set_todo = Hashtbl.create 11; path_set_visited = Hashtbl.create 11; todo_set = NodeVisitSet.empty; - visit_map = NodeMap.empty; + visit_map = Procdesc.NodeMap.empty; } let is_empty (wl : t) : bool = NodeVisitSet.is_empty wl.todo_set - let add (wl : t) (node : Cfg.Node.t) : unit = + let add (wl : t) (node : Procdesc.Node.t) : unit = let visits = (* recover visit count if it was visited before *) - try NodeMap.find node wl.visit_map with + try Procdesc.NodeMap.find node wl.visit_map with | Not_found -> 0 in wl.todo_set <- NodeVisitSet.add { node; visits } wl.todo_set (** remove the minimum element from the worklist, and increase its number of visits *) - let remove (wl : t) : Cfg.Node.t = + let remove (wl : t) : Procdesc.Node.t = try let min = NodeVisitSet.min_elt wl.todo_set in wl.todo_set <- NodeVisitSet.remove min wl.todo_set; wl.visit_map <- - NodeMap.add min.node (min.visits + 1) wl.visit_map; (* increase the visits *) + Procdesc.NodeMap.add min.node (min.visits + 1) wl.visit_map; (* increase the visits *) min.node with Not_found -> begin L.out "@\n...Work list is empty! Impossible to remove edge...@\n"; @@ -124,10 +123,11 @@ end let path_set_create_worklist pdesc = State.reset (); - Cfg.Procdesc.compute_distance_to_exit_node pdesc; + Procdesc.compute_distance_to_exit_node pdesc; Worklist.create () -let htable_retrieve (htable : (Cfg.Node.id, Paths.PathSet.t) Hashtbl.t) (key : Cfg.Node.id) +let htable_retrieve + (htable : (Procdesc.Node.id, Paths.PathSet.t) Hashtbl.t) (key : Procdesc.Node.id) : Paths.PathSet.t = try Hashtbl.find htable key @@ -136,11 +136,11 @@ let htable_retrieve (htable : (Cfg.Node.id, Paths.PathSet.t) Hashtbl.t) (key : C Paths.PathSet.empty (** Add [d] to the pathset todo at [node] returning true if changed *) -let path_set_put_todo (wl : Worklist.t) (node: Cfg.Node.t) (d: Paths.PathSet.t) : bool = +let path_set_put_todo (wl : Worklist.t) (node: Procdesc.Node.t) (d: Paths.PathSet.t) : bool = let changed = if Paths.PathSet.is_empty d then false else - let node_id = Cfg.Node.get_id node in + let node_id = Procdesc.Node.get_id node in let old_todo = htable_retrieve wl.Worklist.path_set_todo node_id in let old_visited = htable_retrieve wl.Worklist.path_set_visited node_id in let d' = Paths.PathSet.diff d old_visited in (* differential fixpoint *) @@ -149,9 +149,9 @@ let path_set_put_todo (wl : Worklist.t) (node: Cfg.Node.t) (d: Paths.PathSet.t) not (Paths.PathSet.equal old_todo todo_new) in changed -let path_set_checkout_todo (wl : Worklist.t) (node: Cfg.Node.t) : Paths.PathSet.t = +let path_set_checkout_todo (wl : Worklist.t) (node: Procdesc.Node.t) : Paths.PathSet.t = try - let node_id = Cfg.Node.get_id node in + let node_id = Procdesc.Node.get_id node in let todo = Hashtbl.find wl.Worklist.path_set_todo node_id in Hashtbl.replace wl.Worklist.path_set_todo node_id Paths.PathSet.empty; let visited = Hashtbl.find wl.Worklist.path_set_visited node_id in @@ -159,7 +159,7 @@ let path_set_checkout_todo (wl : Worklist.t) (node: Cfg.Node.t) : Paths.PathSet. Hashtbl.replace wl.Worklist.path_set_visited node_id new_visited; todo with Not_found -> - L.out "@.@.ERROR: could not find todo for node %a@.@." Cfg.Node.pp node; + L.out "@.@.ERROR: could not find todo for node %a@.@." Procdesc.Node.pp node; assert false (* =============== END of the edge_set object =============== *) @@ -250,7 +250,7 @@ let collect_preconditions tenv proc_name : Prop.normal Specs.Jprop.t list = (** propagate a set of results to the given node *) let propagate - (wl : Worklist.t) pname ~is_exception (pset: Paths.PathSet.t) (curr_node: Cfg.Node.t) = + (wl : Worklist.t) pname ~is_exception (pset: Paths.PathSet.t) (curr_node: Procdesc.Node.t) = let edgeset_todo = (* prop must be a renamed prop by the invariant preserved by PropSet *) let f prop path edgeset_curr = @@ -269,14 +269,14 @@ let propagate (** propagate a set of results, including exceptions and divergence *) let propagate_nodes_divergence - tenv (pdesc: Cfg.Procdesc.t) (pset: Paths.PathSet.t) - (succ_nodes: Cfg.Node.t list) (exn_nodes: Cfg.Node.t list) (wl : Worklist.t) = - let pname = Cfg.Procdesc.get_proc_name pdesc in + tenv (pdesc: Procdesc.t) (pset: Paths.PathSet.t) + (succ_nodes: Procdesc.Node.t list) (exn_nodes: Procdesc.Node.t list) (wl : Worklist.t) = + let pname = Procdesc.get_proc_name pdesc in let pset_exn, pset_ok = Paths.PathSet.partition (Tabulation.prop_is_exn pname) pset in if !Config.footprint && not (Paths.PathSet.is_empty (State.get_diverging_states_node ())) then begin Errdesc.warning_err (State.get_loc ()) "Propagating Divergence@."; - let exit_node = Cfg.Procdesc.get_exit_node pdesc in + let exit_node = Procdesc.get_exit_node pdesc in let diverging_states = State.get_diverging_states_node () in let prop_incons = let mk_incons prop = @@ -297,8 +297,8 @@ let propagate_nodes_divergence (** Symbolic execution for a Join node *) let do_symexec_join pname tenv wl curr_node (edgeset_todo : Paths.PathSet.t) = - let curr_node_id = Cfg.Node.get_id curr_node in - let succ_nodes = Cfg.Node.get_succs curr_node in + let curr_node_id = Procdesc.Node.get_id curr_node in + let succ_nodes = Procdesc.Node.get_succs curr_node in let new_dset = edgeset_todo in let old_dset = Join_table.find wl.Worklist.join_table curr_node_id in let old_dset', new_dset' = Dom.pathset_join pname tenv old_dset new_dset in @@ -333,7 +333,7 @@ let reset_prop_metrics () = exception RE_EXE_ERROR let do_before_node pname source session node = - let loc = Cfg.Node.get_loc node in + let loc = Procdesc.Node.get_loc node in State.set_node node; State.set_session session; L.reset_delayed_prints (); @@ -360,10 +360,10 @@ let instrs_get_normal_vars instrs = (* we exclude function calls: if (g(x,y)) ....*) (* we check that prune nodes have simple guards: a var or its negation*) let check_assignement_guard pdesc node = - let pname = Cfg.Procdesc.get_proc_name pdesc in + let pname = Procdesc.get_proc_name pdesc in let verbose = false in let node_contains_call n = - let instrs = Cfg.Node.get_instrs n in + let instrs = Procdesc.Node.get_instrs n in let is_call = function | Sil.Call _ -> true | _ -> false in @@ -385,13 +385,13 @@ let check_assignement_guard pdesc node = | Exp.Lvar pv -> Pvar.is_frontend_tmp pv | _ -> false in - let succs = Cfg.Node.get_succs node in - let l_node = Cfg.Node.get_last_loc node in + let succs = Procdesc.Node.get_succs node in + let l_node = Procdesc.Node.get_last_loc node in (* e is prune if in all successors prune nodes we have for some temp n$1: *) (* n$1=*&e;Prune(n$1) or n$1=*&e;Prune(!n$1) *) let is_prune_exp e = let prune_var n = - let ins = Cfg.Node.get_instrs n in + let ins = Procdesc.Node.get_instrs n in let pi = IList.filter is_prune_instr ins in let leti = IList.filter is_load_instr ins in match pi, leti with @@ -406,10 +406,10 @@ let check_assignement_guard pdesc node = | _ -> [] in let prune_vars = IList.flatten(IList.map (fun n -> prune_var n) succs) in IList.for_all (fun e' -> Exp.equal e' e) prune_vars in - let succs_loc = IList.map (fun n -> Cfg.Node.get_loc n) succs in + let succs_loc = IList.map (fun n -> Procdesc.Node.get_loc n) succs in let succs_are_all_prune_nodes () = - IList.for_all (fun n -> match Cfg.Node.get_kind n with - | Cfg.Node.Prune_node(_) -> true + IList.for_all (fun n -> match Procdesc.Node.get_kind n with + | Procdesc.Node.Prune_node(_) -> true | _ -> false) succs in let succs_same_loc_as_node () = if verbose then @@ -428,13 +428,13 @@ let check_assignement_guard pdesc node = | Sil.Prune _ -> false | _ -> true in let check_guard n = - IList.for_all check_instr (Cfg.Node.get_instrs n) in + IList.for_all check_instr (Procdesc.Node.get_instrs n) in IList.for_all check_guard succs in if !Config.curr_language = Config.Clang && succs_are_all_prune_nodes () && succs_same_loc_as_node () && succs_have_simple_guards () then - (let instr = Cfg.Node.get_instrs node in + (let instr = Procdesc.Node.get_instrs node in match succs_loc with (* at this point all successors are at the same location, so we can take the first*) | loc_succ:: _ -> @@ -461,12 +461,12 @@ let check_assignement_guard pdesc node = (** Perform symbolic execution for a node starting from an initial prop *) let do_symbolic_execution pdesc handle_exn tenv - (node : Cfg.Node.t) (prop: Prop.normal Prop.t) (path : Paths.Path.t) = + (node : Procdesc.Node.t) (prop: Prop.normal Prop.t) (path : Paths.Path.t) = State.mark_execution_start node; (* build the const map lazily *) State.set_const_map (ConstantPropagation.build_const_map tenv pdesc); check_assignement_guard pdesc node; - let instrs = Cfg.Node.get_instrs node in + let instrs = Procdesc.Node.get_instrs node in (* fresh normal vars must be fresh w.r.t. instructions *) Ident.update_name_generator (instrs_get_normal_vars instrs); let pset = @@ -478,7 +478,7 @@ let do_symbolic_execution pdesc handle_exn tenv pset let mark_visited summary node = - let node_id = Cfg.Node.get_id node in + let node_id = Procdesc.Node.get_id node in let stats = summary.Specs.stats in if !Config.footprint then @@ -490,7 +490,7 @@ let add_taint_attrs tenv proc_name proc_desc prop = match Taint.tainted_params proc_name with | [] -> prop | tainted_param_nums -> - let formal_params = Cfg.Procdesc.get_formals proc_desc in + let formal_params = Procdesc.get_formals proc_desc in let formal_params' = IList.map (fun (p, _) -> Pvar.mk p proc_name) formal_params in Taint.get_params_to_taint tainted_param_nums formal_params' @@ -502,7 +502,7 @@ let add_taint_attrs tenv proc_name proc_desc prop = prop let forward_tabulate tenv pdesc wl source = - let pname = Cfg.Procdesc.get_proc_name pdesc in + let pname = Procdesc.get_proc_name pdesc in let handle_exn_node curr_node exn = Exceptions.print_exception_html "Failure of symbolic execution: " exn; let pre_opt = (* precondition leading to error, if any *) @@ -512,7 +512,7 @@ let forward_tabulate tenv pdesc wl source = L.d_strln "Precondition:"; Prop.d_prop pre; L.d_ln () | None -> ()); L.d_strln "SIL INSTR:"; - Cfg.Node.d_instrs ~sub_instrs: true (State.get_instr ()) curr_node; L.d_ln (); + Procdesc.Node.d_instrs ~sub_instrs: true (State.get_instr ()) curr_node; L.d_ln (); Reporting.log_error pname exn; State.mark_instr_fail exn in @@ -533,14 +533,14 @@ let forward_tabulate tenv pdesc wl source = let timestamp = Specs.get_timestamp summary in F.sprintf "[%s:%d] %s" phase_string timestamp (Procname.to_string proc_name) in L.d_strln ("**** " ^ (log_string pname) ^ " " ^ - "Node: " ^ string_of_int (Cfg.Node.get_id curr_node :> int) ^ ", " ^ + "Node: " ^ string_of_int (Procdesc.Node.get_id curr_node :> int) ^ ", " ^ "Procedure: " ^ Procname.to_string pname ^ ", " ^ "Session: " ^ string_of_int session ^ ", " ^ "Todo: " ^ string_of_int (Paths.PathSet.size pathset_todo) ^ " ****"); L.d_increase_indent 1; Propset.d Prop.prop_emp (Paths.PathSet.to_propset tenv pathset_todo); L.d_strln ".... Instructions: .... "; - Cfg.Node.d_instrs ~sub_instrs: true (State.get_instr ()) curr_node; + Procdesc.Node.d_instrs ~sub_instrs: true (State.get_instr ()) curr_node; L.d_ln (); L.d_ln () in let do_prop curr_node handle_exn prop_ path cnt num_paths = @@ -555,8 +555,8 @@ let forward_tabulate tenv pdesc wl source = State.reset_diverging_states_node (); let pset = do_symbolic_execution pdesc handle_exn tenv curr_node prop path in - let succ_nodes = Cfg.Node.get_succs curr_node in - let exn_nodes = Cfg.Node.get_exn curr_node in + let succ_nodes = Procdesc.Node.get_succs curr_node in + let exn_nodes = Procdesc.Node.get_exn curr_node in propagate_nodes_divergence tenv pdesc pset succ_nodes exn_nodes wl; L.d_decrease_indent 1; L.d_ln(); with @@ -568,14 +568,14 @@ let forward_tabulate tenv pdesc wl source = check_prop_size pathset_todo; print_node_preamble curr_node session pathset_todo; - match Cfg.Node.get_kind curr_node with - | Cfg.Node.Join_node -> + match Procdesc.Node.get_kind curr_node with + | Procdesc.Node.Join_node -> do_symexec_join pname tenv wl curr_node pathset_todo - | Cfg.Node.Stmt_node _ - | Cfg.Node.Prune_node _ - | Cfg.Node.Exit_node _ - | Cfg.Node.Skip_node _ - | Cfg.Node.Start_node _ -> + | Procdesc.Node.Stmt_node _ + | Procdesc.Node.Prune_node _ + | Procdesc.Node.Exit_node _ + | Procdesc.Node.Skip_node _ + | Procdesc.Node.Start_node _ -> exe_iter (do_prop curr_node handle_exn) pathset_todo in let do_node_and_handle curr_node session = @@ -690,10 +690,10 @@ let report_context_leaks pname sigma tenv = (** Remove locals and formals, and check if the address of a stack variable is left in the result *) let remove_locals_formals_and_check tenv pdesc p = - let pname = Cfg.Procdesc.get_proc_name pdesc in + let pname = Procdesc.get_proc_name pdesc in let pvars, p' = PropUtil.remove_locals_formals tenv pdesc p in let check_pvar pvar = - let loc = Cfg.Node.get_loc (Cfg.Procdesc.get_exit_node pdesc) in + let loc = Procdesc.Node.get_loc (Procdesc.get_exit_node pdesc) in let dexp_opt, _ = Errdesc.vpath_find tenv p (Exp.Lvar pvar) in let desc = Errdesc.explain_stack_variable_address_escape loc pvar dexp_opt in let exn = Exceptions.Stack_variable_address_escape (desc, __POS__) in @@ -703,8 +703,8 @@ let remove_locals_formals_and_check tenv pdesc p = (** Collect the analysis results for the exit node. *) let collect_analysis_result tenv wl pdesc : Paths.PathSet.t = - let exit_node = Cfg.Procdesc.get_exit_node pdesc in - let exit_node_id = Cfg.Node.get_id exit_node in + let exit_node = Procdesc.get_exit_node pdesc in + let exit_node_id = Procdesc.Node.get_id exit_node in let pathset = htable_retrieve wl.Worklist.path_set_visited exit_node_id in Paths.PathSet.map (remove_locals_formals_and_check tenv pdesc) pathset @@ -716,7 +716,7 @@ module Pmap = Map.Make let vset_ref_add_path vset_ref path = Paths.Path.iter_all_nodes_nocalls - (fun n -> vset_ref := Cfg.NodeSet.add n !vset_ref) + (fun n -> vset_ref := Procdesc.NodeSet.add n !vset_ref) path let vset_ref_add_pathset vset_ref pathset = @@ -725,19 +725,19 @@ let vset_ref_add_pathset vset_ref pathset = let compute_visited vset = let res = ref Specs.Visitedset.empty in let node_get_all_lines n = - let node_loc = Cfg.Node.get_loc n in - let instrs_loc = IList.map Sil.instr_get_loc (Cfg.Node.get_instrs n) in + let node_loc = Procdesc.Node.get_loc n in + let instrs_loc = IList.map Sil.instr_get_loc (Procdesc.Node.get_instrs n) in let lines = IList.map (fun loc -> loc.Location.line) (node_loc :: instrs_loc) in IList.remove_duplicates int_compare (IList.sort int_compare lines) in let do_node n = res := - Specs.Visitedset.add (Cfg.Node.get_id n, node_get_all_lines n) !res in - Cfg.NodeSet.iter do_node vset; + Specs.Visitedset.add (Procdesc.Node.get_id n, node_get_all_lines n) !res in + Procdesc.NodeSet.iter do_node vset; !res (** Extract specs from a pathset *) let extract_specs tenv pdesc pathset : Prop.normal Specs.spec list = - let pname = Cfg.Procdesc.get_proc_name pdesc in + let pname = Procdesc.get_proc_name pdesc in let sub = let fav = Sil.fav_new () in Paths.PathSet.iter @@ -756,13 +756,13 @@ let extract_specs tenv pdesc pathset : Prop.normal Specs.spec list = let pre, post = Prop.extract_spec prop'' in let pre' = Prop.normalize tenv (Prop.prop_sub sub pre) in if !Config.curr_language = - Config.Java && Cfg.Procdesc.get_access pdesc <> PredSymb.Private then + Config.Java && Procdesc.get_access pdesc <> PredSymb.Private then report_context_leaks pname post.Prop.sigma tenv; let post' = if Prover.check_inconsistency_base tenv prop then None else Some (Prop.normalize tenv (Prop.prop_sub sub post), path) in let visited = - let vset_ref = ref Cfg.NodeSet.empty in + let vset_ref = ref Procdesc.NodeSet.empty in vset_ref_add_path vset_ref path; compute_visited !vset_ref in (pre', post', visited) in @@ -794,7 +794,7 @@ let extract_specs tenv pdesc pathset : Prop.normal Specs.spec list = !specs let collect_postconditions wl tenv pdesc : Paths.PathSet.t * Specs.Visitedset.t = - let pname = Cfg.Procdesc.get_proc_name pdesc in + let pname = Procdesc.get_proc_name pdesc in let pathset = collect_analysis_result tenv wl pdesc in (* Assuming C++ developers use RAII, remove resources from the constructor posts *) @@ -818,7 +818,7 @@ let collect_postconditions wl tenv pdesc : Paths.PathSet.t * Specs.Visitedset.t let pathset = collect_do_abstract_post pname tenv pathset in let pathset_diverging = State.get_diverging_states_proc () in let visited = - let vset_ref = ref Cfg.NodeSet.empty in + let vset_ref = ref Procdesc.NodeSet.empty in vset_ref_add_pathset vset_ref pathset; (* nodes from diverging states were also visited *) vset_ref_add_pathset vset_ref pathset_diverging; @@ -867,13 +867,13 @@ let prop_init_formals_seed tenv new_formals (prop : 'a Prop.t) : Prop.exposed Pr (** Construct an initial prop by extending [prop] with locals, and formals if [add_formals] is true as well as seed variables *) let initial_prop - tenv (curr_f: Cfg.Procdesc.t) (prop : 'a Prop.t) add_formals + tenv (curr_f: Procdesc.t) (prop : 'a Prop.t) add_formals : Prop.normal Prop.t = let construct_decl (x, typ) = - (Pvar.mk x (Cfg.Procdesc.get_proc_name curr_f), typ) in + (Pvar.mk x (Procdesc.get_proc_name curr_f), typ) in let new_formals = if add_formals - then IList.map construct_decl (Cfg.Procdesc.get_formals curr_f) + then IList.map construct_decl (Procdesc.get_formals curr_f) else [] (* no new formals added *) in let prop1 = Prop.prop_reset_inst @@ -906,7 +906,7 @@ let initial_prop_from_pre tenv curr_f pre = (** Re-execute one precondition and return some spec if there was no re-execution error. *) let execute_filter_prop wl tenv pdesc init_node (precondition : Prop.normal Specs.Jprop.t) source : Prop.normal Specs.spec option = - let pname = Cfg.Procdesc.get_proc_name pdesc in + let pname = Procdesc.get_proc_name pdesc in do_before_node pname source 0 init_node; L.d_strln ("#### Start: RE-execution for " ^ Procname.to_string pname ^ " ####"); L.d_indent 1; @@ -967,13 +967,13 @@ let get_procs_and_defined_children call_graph = let pp_intra_stats wl proc_desc fmt _ = let nstates = ref 0 in - let nodes = Cfg.Procdesc.get_nodes proc_desc in + let nodes = Procdesc.get_nodes proc_desc in IList.iter (fun node -> nstates := !nstates + Paths.PathSet.size - (htable_retrieve wl.Worklist.path_set_visited (Cfg.Node.get_id node))) + (htable_retrieve wl.Worklist.path_set_visited (Procdesc.Node.get_id node))) nodes; F.fprintf fmt "(%d nodes containing %d states)" (IList.length nodes) !nstates @@ -984,10 +984,10 @@ type exe_phase = (unit -> unit) * (unit -> Prop.normal Specs.spec list * Specs.p and [get_results ()] returns the results computed. This function is architected so that [get_results ()] can be called even after [go ()] was interrupted by and exception. *) -let perform_analysis_phase tenv (pname : Procname.t) (pdesc : Cfg.Procdesc.t) source +let perform_analysis_phase tenv (pname : Procname.t) (pdesc : Procdesc.t) source : exe_phase = let summary = Specs.get_summary_unsafe "check_recursion_level" pname in - let start_node = Cfg.Procdesc.get_start_node pdesc in + let start_node = Procdesc.get_start_node pdesc in let check_recursion_level () = let recursion_level = Specs.get_timestamp summary in @@ -1021,7 +1021,7 @@ let perform_analysis_phase tenv (pname : Procname.t) (pdesc : Cfg.Procdesc.t) so Worklist.add wl start_node; Config.arc_mode := Hashtbl.mem - (Cfg.Procdesc.get_flags pdesc) + (Procdesc.get_flags pdesc) Mleak_buckets.objc_arc_flag; ignore (path_set_put_todo wl start_node init_edgeset); forward_tabulate tenv pdesc wl source in @@ -1103,7 +1103,7 @@ let perform_analysis_phase tenv (pname : Procname.t) (pdesc : Cfg.Procdesc.t) so re_execution () let set_current_language proc_desc = - let language = (Cfg.Procdesc.get_attributes proc_desc).ProcAttributes.language in + let language = (Procdesc.get_attributes proc_desc).ProcAttributes.language in Config.curr_language := language (** reset global values before analysing a procedure *) @@ -1313,7 +1313,7 @@ let update_summary tenv prev_summary specs phase proc_name elapsed res = (** Analyze the procedure and return the resulting summary. *) let analyze_proc source exe_env proc_desc : Specs.summary = - let proc_name = Cfg.Procdesc.get_proc_name proc_desc in + let proc_name = Procdesc.get_proc_name proc_desc in let init_time = Unix.gettimeofday () in let tenv = Exe_env.get_tenv exe_env proc_name in reset_global_values proc_desc; @@ -1373,7 +1373,7 @@ let perform_transition exe_env tenv proc_name source = try match Exe_env.get_proc_desc exe_env proc_name with | Some pdesc -> - let start_node = Cfg.Procdesc.get_start_node pdesc in + let start_node = Procdesc.get_start_node pdesc in f start_node | None -> () with exn when SymOp.exn_not_failure exn -> () in @@ -1411,7 +1411,7 @@ let interprocedural_algorithm exe_env : unit = | Some proc_desc -> let reactive_changed = if Config.reactive_mode - then (Cfg.Procdesc.get_attributes proc_desc).ProcAttributes.changed + then (Procdesc.get_attributes proc_desc).ProcAttributes.changed else true in if reactive_changed && (* in reactive mode, only analyze changed procedures *) @@ -1438,7 +1438,7 @@ let do_analysis exe_env = let get_calls caller_pdesc = let calls = ref [] in let f (callee_pname, loc) = calls := (callee_pname, loc) :: !calls in - Cfg.Procdesc.iter_calls f caller_pdesc; + Procdesc.iter_calls f caller_pdesc; IList.rev !calls in let init_proc (pname, dep) = let pdesc = match Exe_env.get_proc_desc exe_env pname with @@ -1446,12 +1446,12 @@ let do_analysis exe_env = pdesc | None -> assert false in - let nodes = IList.map (fun n -> Cfg.Node.get_id n) (Cfg.Procdesc.get_nodes pdesc) in - let proc_flags = Cfg.Procdesc.get_flags pdesc in - let static_err_log = Cfg.Procdesc.get_err_log pdesc in (* err log from translation *) + let nodes = IList.map (fun n -> Procdesc.Node.get_id n) (Procdesc.get_nodes pdesc) in + let proc_flags = Procdesc.get_flags pdesc in + let static_err_log = Procdesc.get_err_log pdesc in (* err log from translation *) let calls = get_calls pdesc in let attributes = - { (Cfg.Procdesc.get_attributes pdesc) with + { (Procdesc.get_attributes pdesc) with ProcAttributes.err_log = static_err_log; } in let proc_desc_option = if Config.dynamic_dispatch = `Lazy @@ -1479,7 +1479,7 @@ let do_analysis exe_env = (Specs.get_summary proc_name) | None -> None in let analyze_ondemand source proc_desc = - let proc_name = Cfg.Procdesc.get_proc_name proc_desc in + let proc_name = Procdesc.get_proc_name proc_desc in let tenv = Exe_env.get_tenv exe_env proc_name in if not (Config.eradicate || Config.checkers) then @@ -1507,25 +1507,25 @@ let do_analysis exe_env = let visited_and_total_nodes ~filter cfg = let filter_node pdesc n = - Cfg.Procdesc.is_defined pdesc && + Procdesc.is_defined pdesc && filter pdesc && - match Cfg.Node.get_kind n with - | Cfg.Node.Stmt_node _ | Cfg.Node.Prune_node _ - | Cfg.Node.Start_node _ | Cfg.Node.Exit_node _ -> true - | Cfg.Node.Skip_node _ | Cfg.Node.Join_node -> false in + match Procdesc.Node.get_kind n with + | Procdesc.Node.Stmt_node _ | Procdesc.Node.Prune_node _ + | Procdesc.Node.Start_node _ | Procdesc.Node.Exit_node _ -> true + | Procdesc.Node.Skip_node _ | Procdesc.Node.Join_node -> false in let counted_nodes, visited_nodes_re = - let set = ref Cfg.NodeSet.empty in - let set_visited_re = ref Cfg.NodeSet.empty in + let set = ref Procdesc.NodeSet.empty in + let set_visited_re = ref Procdesc.NodeSet.empty in let add pdesc n = if filter_node pdesc n then begin - set := Cfg.NodeSet.add n !set; - if snd (Printer.node_is_visited (Cfg.Procdesc.get_proc_name pdesc) n) - then set_visited_re := Cfg.NodeSet.add n !set_visited_re + set := Procdesc.NodeSet.add n !set; + if snd (Printer.node_is_visited (Procdesc.get_proc_name pdesc) n) + then set_visited_re := Procdesc.NodeSet.add n !set_visited_re end in Cfg.iter_all_nodes add cfg; !set, !set_visited_re in - Cfg.NodeSet.elements visited_nodes_re, Cfg.NodeSet.elements counted_nodes + Procdesc.NodeSet.elements visited_nodes_re, Procdesc.NodeSet.elements counted_nodes (** Print the stats for the given cfg. Consider every defined proc unless a proc with the same name @@ -1533,7 +1533,7 @@ let visited_and_total_nodes ~filter cfg = let print_stats_cfg proc_shadowed source cfg = let err_table = Errlog.create_err_table () in let filter pdesc = - let pname = Cfg.Procdesc.get_proc_name pdesc in + let pname = Procdesc.get_proc_name pdesc in Specs.summary_exists pname && Specs.get_specs pname != [] in let nodes_visited, nodes_total = visited_and_total_nodes ~filter cfg in let num_proc = ref 0 in @@ -1545,7 +1545,7 @@ let print_stats_cfg proc_shadowed source cfg = let tot_symops = ref 0 in let num_timeout = ref 0 in let compute_stats_proc proc_desc = - let proc_name = Cfg.Procdesc.get_proc_name proc_desc in + let proc_name = Procdesc.get_proc_name proc_desc in if proc_shadowed proc_desc || Specs.get_summary proc_name = None then L.out "print_stats: ignoring function %a which is also defined in another file@." @@ -1615,7 +1615,7 @@ let print_stats exe_env = (fun source cfg -> let proc_shadowed proc_desc = (* return true if a proc with the same name in another module was analyzed instead *) - let proc_name = Cfg.Procdesc.get_proc_name proc_desc in + let proc_name = Procdesc.get_proc_name proc_desc in Exe_env.get_source exe_env proc_name <> Some source in print_stats_cfg proc_shadowed source cfg) exe_env diff --git a/infer/src/backend/ondemand.ml b/infer/src/backend/ondemand.ml index e0a486315..e5afdb2f7 100644 --- a/infer/src/backend/ondemand.ml +++ b/infer/src/backend/ondemand.ml @@ -32,9 +32,9 @@ let read_dirs_to_analyze () = let dirs_to_analyze = lazy (read_dirs_to_analyze ()) -type analyze_ondemand = DB.source_file -> Cfg.Procdesc.t -> unit +type analyze_ondemand = DB.source_file -> Procdesc.t -> unit -type get_proc_desc = Procname.t -> Cfg.Procdesc.t option +type get_proc_desc = Procname.t -> Procdesc.t option type callbacks = { @@ -110,8 +110,8 @@ let restore_global_state st = let run_proc_analysis tenv ~propagate_exceptions analyze_proc curr_pdesc callee_pdesc = - let curr_pname = Cfg.Procdesc.get_proc_name curr_pdesc in - let callee_pname = Cfg.Procdesc.get_proc_name callee_pdesc in + let curr_pname = Procdesc.get_proc_name curr_pdesc in + let callee_pname = Procdesc.get_proc_name callee_pdesc in (* Dot means start of a procedure *) L.log_progress_procedure (); @@ -195,8 +195,8 @@ let run_proc_analysis tenv ~propagate_exceptions analyze_proc curr_pdesc callee_ let analyze_proc_desc tenv ~propagate_exceptions curr_pdesc callee_pdesc = - let callee_pname = Cfg.Procdesc.get_proc_name callee_pdesc in - let proc_attributes = Cfg.Procdesc.get_attributes callee_pdesc in + let callee_pname = Procdesc.get_proc_name callee_pdesc in + let proc_attributes = Procdesc.get_attributes callee_pdesc in match !callbacks_ref with | Some callbacks when should_be_analyzed proc_attributes callee_pname -> diff --git a/infer/src/backend/ondemand.mli b/infer/src/backend/ondemand.mli index 5edb90f20..3196031ae 100644 --- a/infer/src/backend/ondemand.mli +++ b/infer/src/backend/ondemand.mli @@ -14,9 +14,9 @@ open! Utils (** Optional set of source dirs to analyze in on-demand mode. *) val dirs_to_analyze : StringSet.t option Lazy.t -type analyze_ondemand = DB.source_file -> Cfg.Procdesc.t -> unit +type analyze_ondemand = DB.source_file -> Procdesc.t -> unit -type get_proc_desc = Procname.t -> Cfg.Procdesc.t option +type get_proc_desc = Procname.t -> Procdesc.t option type callbacks = { @@ -30,12 +30,12 @@ val get_proc_desc : get_proc_desc (** analyze_proc_desc curr_pdesc callee_pdesc performs an on-demand analysis of callee_pdesc triggered during the analysis of curr_pdesc. *) -val analyze_proc_desc : Tenv.t -> propagate_exceptions:bool -> Cfg.Procdesc.t -> Cfg.Procdesc.t -> unit +val analyze_proc_desc : Tenv.t -> propagate_exceptions:bool -> Procdesc.t -> Procdesc.t -> unit (** analyze_proc_name curr_pdesc proc_name performs an on-demand analysis of proc_name triggered during the analysis of curr_pdesc. *) -val analyze_proc_name : Tenv.t -> propagate_exceptions:bool -> Cfg.Procdesc.t -> Procname.t -> unit +val analyze_proc_name : Tenv.t -> propagate_exceptions:bool -> Procdesc.t -> Procname.t -> unit (** Check if the procedure called needs to be analyzed. *) val procedure_should_be_analyzed : Procname.t -> bool diff --git a/infer/src/backend/paths.ml b/infer/src/backend/paths.ml index 09d690420..2c4ffaca1 100644 --- a/infer/src/backend/paths.ml +++ b/infer/src/backend/paths.ml @@ -36,7 +36,7 @@ module Path : sig val create_loc_trace : t -> PredSymb.path_pos option -> Errlog.loc_trace (** return the current node of the path *) - val curr_node : t -> Cfg.Node.t option + val curr_node : t -> Procdesc.Node.t option (** dump a path *) val d : t -> unit @@ -45,13 +45,13 @@ module Path : sig val d_stats : t -> unit (** extend a path with a new node reached from the given session, with an optional string for exceptions *) - val extend : Cfg.Node.t -> Typename.t option -> session -> t -> t + val extend : Procdesc.Node.t -> Typename.t option -> session -> t -> t (** extend a path with a new node reached from the given session, with an optional string for exceptions *) val add_description : t -> string -> t (** iterate over each node in the path, excluding calls, once *) - val iter_all_nodes_nocalls : (Cfg.Node.t -> unit) -> t -> unit + val iter_all_nodes_nocalls : (Procdesc.Node.t -> unit) -> t -> unit val iter_shortest_sequence : (int -> t -> int -> Typename.t option -> unit) -> PredSymb.path_pos option -> t -> unit @@ -66,7 +66,7 @@ module Path : sig val pp_stats : Format.formatter -> t -> unit (** create a new path with given start node *) - val start : Cfg.Node.t -> t + val start : Procdesc.Node.t -> t (* (** equality for paths *) @@ -83,8 +83,8 @@ end = struct type path = (* INVARIANT: stats are always set to dummy_stats unless we are in the middle of a traversal *) (* in particular: a new traversal cannot be initiated during an existing traversal *) - | Pstart of Cfg.Node.t * stats (** start node *) - | Pnode of Cfg.Node.t * Typename.t option * session * path * stats * string option + | Pstart of Procdesc.Node.t * stats (** start node *) + | Pnode of Procdesc.Node.t * Typename.t option * session * path * stats * string option (** we got to [node] from last [session] perhaps propagating exception [exn_opt], and continue with [path]. *) | Pjoin of path * path * stats (** join of two paths *) @@ -133,11 +133,11 @@ end = struct let rec compare p1 p2 : int = if p1 == p2 then 0 else match p1, p2 with | Pstart (n1, _), Pstart (n2, _) -> - Cfg.Node.compare n1 n2 + Procdesc.Node.compare n1 n2 | Pstart _, _ -> - 1 | _, Pstart _ -> 1 | Pnode (n1, eo1, s1, p1, _, _), Pnode (n2, eo2, s2, p2, _, _) -> - let n = Cfg.Node.compare n1 n2 in + let n = Procdesc.Node.compare n1 n2 in if n <> 0 then n else let n = exname_opt_compare eo1 eo2 in if n <> 0 then n else let n = int_compare s1 s2 in if n <> 0 then n else compare p1 p2 @@ -154,7 +154,7 @@ end = struct let start node = Pstart (node, get_dummy_stats ()) - let extend (node: Cfg.Node.t) exn_opt session path = + let extend (node: Procdesc.Node.t) exn_opt session path = Pnode (node, exn_opt, session, path, get_dummy_stats (), None) let join p1 p2 = @@ -212,7 +212,7 @@ end = struct satisfying [f] was found. Assumes that the invariant holds beforehand, and ensures that all the stats are computed afterwards. Since this breaks the invariant, it must be followed by reset_stats. *) - let rec compute_stats do_calls (f : Cfg.Node.t -> bool) = + let rec compute_stats do_calls (f : Procdesc.Node.t -> bool) = let nodes_found stats = stats.max_length > 0 in function | Pstart (node, stats) -> @@ -268,8 +268,8 @@ end = struct Invariant.reset_stats path let get_path_pos node = - let pn = Cfg.Node.get_proc_name node in - let n_id = Cfg.Node.get_id node in + let pn = Procdesc.Node.get_proc_name node in + let n_id = Procdesc.Node.get_id node in (pn, (n_id :> int)) let contains_position path pos = @@ -287,7 +287,7 @@ end = struct pass the exception information to [f] on the previous node *) let iter_shortest_sequence_filter (f : int -> t -> int -> Typename.t option -> unit) - (filter: Cfg.Node.t -> bool) (path: t) : unit = + (filter: Procdesc.Node.t -> bool) (path: t) : unit = let rec doit level session path prev_exn_opt = match path with | Pstart _ -> f level path session prev_exn_opt | Pnode (_, exn_opt, session', p, _, _) -> @@ -347,26 +347,26 @@ end = struct (fun (level, p, session, exn_opt) -> f level p session exn_opt) sequence_up_to_last_seen - module NodeMap = Map.Make (Cfg.Node) - (** return the node visited most, and number of visits, in the shortest linear sequence *) let repetitions path = - let map = ref NodeMap.empty in + let map = ref Procdesc.NodeMap.empty in let add_node = function | Some node -> begin try - let n = NodeMap.find node !map in - map := NodeMap.add node (n + 1) !map + let n = Procdesc.NodeMap.find node !map in + map := Procdesc.NodeMap.add node (n + 1) !map with Not_found -> - map := NodeMap.add node 1 !map + map := Procdesc.NodeMap.add node 1 !map end | None -> () in iter_shortest_sequence (fun _ p _ _ -> add_node (curr_node p)) None path; - let max_rep_node = ref (Cfg.Node.dummy ()) in + let max_rep_node = ref (Procdesc.Node.dummy ()) in let max_rep_num = ref 0 in - NodeMap.iter (fun node num -> if num > !max_rep_num then (max_rep_node := node; max_rep_num := num)) !map; + Procdesc.NodeMap.iter + (fun node num -> if num > !max_rep_num then (max_rep_node := node; max_rep_num := num)) + !map; (!max_rep_node, !max_rep_num) let stats_string path = @@ -376,7 +376,7 @@ end = struct "linear paths: " ^ string_of_float (Invariant.get_stats path).linear_num ^ " max length: " ^ string_of_int (Invariant.get_stats path).max_length ^ " has repetitions: " ^ string_of_int repetitions ^ - " of node " ^ (string_of_int (Cfg.Node.get_id node :> int)) in + " of node " ^ (string_of_int (Procdesc.Node.get_id node :> int)) in Invariant.reset_stats path; str @@ -418,9 +418,9 @@ end = struct with Not_found -> match path with | Pstart (node, _) -> - F.fprintf fmt "n%a" Cfg.Node.pp node + F.fprintf fmt "n%a" Procdesc.Node.pp node | Pnode (node, _, session, path, _, _) -> - F.fprintf fmt "%a(s%d).n%a" (doit (n - 1)) path (session :> int) Cfg.Node.pp node + F.fprintf fmt "%a(s%d).n%a" (doit (n - 1)) path (session :> int) Procdesc.Node.pp node | Pjoin (path1, path2, _) -> F.fprintf fmt "(%a + %a)" (doit (n - 1)) path1 (doit (n - 1)) path2 | Pcall (path1, _, path2, _) -> @@ -454,10 +454,10 @@ end = struct match curr_node path with | Some curr_node -> begin - let curr_loc = Cfg.Node.get_loc curr_node in - match Cfg.Node.get_kind curr_node with - | Cfg.Node.Join_node -> () (* omit join nodes from error traces *) - | Cfg.Node.Start_node pname -> + let curr_loc = Procdesc.Node.get_loc curr_node in + match Procdesc.Node.get_kind curr_node with + | Procdesc.Node.Join_node -> () (* omit join nodes from error traces *) + | Procdesc.Node.Start_node pname -> let name = Procname.to_string pname in let name_id = Procname.to_filename pname in let descr = "start of procedure " ^ (Procname.to_simplified_string pname) in @@ -466,7 +466,7 @@ end = struct (Io_infer.Xml.tag_name, name); (Io_infer.Xml.tag_name_id, name_id)] in trace := mk_trace_elem level curr_loc descr node_tags :: !trace - | Cfg.Node.Prune_node (is_true_branch, if_kind, _) -> + | Procdesc.Node.Prune_node (is_true_branch, if_kind, _) -> let descr = match is_true_branch, if_kind with | true, Sil.Ik_if -> "Taking true branch" | false, Sil.Ik_if -> "Taking false branch" @@ -482,7 +482,7 @@ end = struct [(Io_infer.Xml.tag_kind,"condition"); (Io_infer.Xml.tag_branch, if is_true_branch then "true" else "false")] in trace := mk_trace_elem level curr_loc descr node_tags :: !trace - | Cfg.Node.Exit_node pname -> + | Procdesc.Node.Exit_node pname -> let descr = "return from a call to " ^ (Procname.to_string pname) in let name = Procname.to_string pname in let name_id = Procname.to_filename pname in @@ -644,10 +644,10 @@ end = struct (** check if the nodes in path p1 are a subset of those in p2 (not trace subset) *) let path_nodes_subset p1 p2 = let get_nodes p = - let s = ref Cfg.NodeSet.empty in - Path.iter_all_nodes_nocalls (fun n -> s := Cfg.NodeSet.add n !s) p; + let s = ref Procdesc.NodeSet.empty in + Path.iter_all_nodes_nocalls (fun n -> s := Procdesc.NodeSet.add n !s) p; !s in - Cfg.NodeSet.subset (get_nodes p1) (get_nodes p2) + Procdesc.NodeSet.subset (get_nodes p1) (get_nodes p2) (** difference between pathsets for the differential fixpoint *) let diff (ps1: t) (ps2: t) : t = diff --git a/infer/src/backend/paths.mli b/infer/src/backend/paths.mli index 9a495c1e6..7709337cf 100644 --- a/infer/src/backend/paths.mli +++ b/infer/src/backend/paths.mli @@ -31,7 +31,7 @@ module Path : sig val create_loc_trace : t -> PredSymb.path_pos option -> Errlog.loc_trace (** return the current node of the path *) - val curr_node : t -> Cfg.Node.t option + val curr_node : t -> Procdesc.Node.t option (** dump a path *) val d : t -> unit @@ -40,12 +40,12 @@ module Path : sig val d_stats : t -> unit (** extend a path with a new node reached from the given session, with an optional string for exceptions *) - val extend : Cfg.Node.t -> Typename.t option -> session -> t -> t + val extend : Procdesc.Node.t -> Typename.t option -> session -> t -> t val add_description : t -> string -> t (** iterate over each node in the path, excluding calls, once *) - val iter_all_nodes_nocalls : (Cfg.Node.t -> unit) -> t -> unit + val iter_all_nodes_nocalls : (Procdesc.Node.t -> unit) -> t -> unit (** iterate over the shortest sequence belonging to the path, restricting to those containing the given position if given. @@ -65,7 +65,7 @@ module Path : sig val pp_stats : Format.formatter -> t -> unit (** create a new path with given start node *) - val start : Cfg.Node.t -> t + val start : Procdesc.Node.t -> t end (** Set of (prop,path) pairs, where the identity is given by prop *) diff --git a/infer/src/backend/preanal.ml b/infer/src/backend/preanal.ml index 3c31ee930..f2f304917 100644 --- a/infer/src/backend/preanal.ml +++ b/infer/src/backend/preanal.ml @@ -53,17 +53,17 @@ let add_dispatch_calls pdesc cg tenv ~handle_dynamic_dispatch = | [] -> instr) | instr -> instr in - let instrs = Cfg.Node.get_instrs node in + let instrs = Procdesc.Node.get_instrs node in if has_dispatch_call instrs then IList.map replace_dispatch_calls instrs - |> Cfg.Node.replace_instrs node in - let pname = Cfg.Procdesc.get_proc_name pdesc in + |> Procdesc.Node.replace_instrs node in + let pname = Procdesc.get_proc_name pdesc in if Procname.is_java pname then - Cfg.Procdesc.iter_nodes (node_add_dispatch_calls pname) pdesc + Procdesc.iter_nodes (node_add_dispatch_calls pname) pdesc (** add instructions to perform abstraction *) let add_abstraction_instructions pdesc = - let open Cfg in + let open Procdesc in (* true if there is a succ node s.t.: it is an exit node, or the succ of >1 nodes *) let converging_node node = let is_exit node = match Node.get_kind node with @@ -88,7 +88,7 @@ let add_abstraction_instructions pdesc = let do_node node = let loc = Node.get_last_loc node in if node_requires_abstraction node then Node.append_instrs node [Sil.Abstract loc] in - Cfg.Procdesc.iter_nodes do_node pdesc + Procdesc.iter_nodes do_node pdesc module BackwardCfg = ProcCfg.OneInstrPerNode(ProcCfg.Backward(ProcCfg.Exceptional)) @@ -175,12 +175,12 @@ let remove_dead_frontend_stores pdesc liveness_inv_map = let instr_nodes' = IList.filter_changed is_used_store instr_nodes in if instr_nodes' != instr_nodes then - Cfg.Node.replace_instrs node (IList.rev_map fst instr_nodes') in - Cfg.Procdesc.iter_nodes node_remove_dead_stores pdesc + Procdesc.Node.replace_instrs node (IList.rev_map fst instr_nodes') in + Procdesc.iter_nodes node_remove_dead_stores pdesc let add_nullify_instrs pdesc tenv liveness_inv_map = let address_taken_vars = - if Procname.is_java (Cfg.Procdesc.get_proc_name pdesc) + if Procname.is_java (Procdesc.get_proc_name pdesc) then AddressTaken.Domain.empty (* can't take the address of a variable in Java *) else match AddressTaken.Analyzer.compute_post (ProcData.make_default pdesc tenv) with @@ -196,17 +196,17 @@ let add_nullify_instrs pdesc tenv liveness_inv_map = not (Pvar.is_return pvar || Pvar.is_global pvar) in let node_add_nullify_instructions node pvars = - let loc = Cfg.Node.get_last_loc node in + let loc = Procdesc.Node.get_last_loc node in let nullify_instrs = IList.filter is_local pvars |> IList.map (fun pvar -> Sil.Nullify (pvar, loc)) in if nullify_instrs <> [] - then Cfg.Node.append_instrs node (IList.rev nullify_instrs) in + then Procdesc.Node.append_instrs node (IList.rev nullify_instrs) in let node_add_removetmps_instructions node ids = if ids <> [] then - let loc = Cfg.Node.get_last_loc node in - Cfg.Node.append_instrs node [Sil.Remove_temps (IList.rev ids, loc)] in + let loc = Procdesc.Node.get_last_loc node in + Procdesc.Node.append_instrs node [Sil.Remove_temps (IList.rev ids, loc)] in IList.iter (fun node -> @@ -282,18 +282,18 @@ let do_copy_propagation pdesc tenv = (fun node -> let instrs, changed = rev_transform_node_instrs node in if changed - then Cfg.Node.replace_instrs node (IList.rev instrs)) - (Cfg.Procdesc.get_nodes pdesc) + then Procdesc.Node.replace_instrs node (IList.rev instrs)) + (Procdesc.get_nodes pdesc) let do_liveness pdesc tenv = let liveness_proc_cfg = BackwardCfg.from_pdesc pdesc in LivenessAnalysis.exec_cfg liveness_proc_cfg (ProcData.make_default pdesc tenv) let doit ?(handle_dynamic_dispatch= (Config.dynamic_dispatch = `Sound)) pdesc cg tenv = - if not (Cfg.Procdesc.did_preanalysis pdesc) + if not (Procdesc.did_preanalysis pdesc) then begin - Cfg.Procdesc.signal_did_preanalysis pdesc; + Procdesc.signal_did_preanalysis pdesc; if Config.copy_propagation then do_copy_propagation pdesc tenv; let liveness_inv_map = do_liveness pdesc tenv in if Config.dynamic_dispatch <> `Lazy && Config.copy_propagation diff --git a/infer/src/backend/preanal.mli b/infer/src/backend/preanal.mli index ef136fd7a..3d4cf04a7 100644 --- a/infer/src/backend/preanal.mli +++ b/infer/src/backend/preanal.mli @@ -13,4 +13,4 @@ open! Utils (** Preanalysis for eliminating dead local variables *) (** Perform liveness analysis *) -val doit : ?handle_dynamic_dispatch:bool -> Cfg.Procdesc.t -> Cg.t -> Tenv.t -> unit +val doit : ?handle_dynamic_dispatch:bool -> Procdesc.t -> Cg.t -> Tenv.t -> unit diff --git a/infer/src/backend/printer.ml b/infer/src/backend/printer.ml index 16266bb67..950f7aa3c 100644 --- a/infer/src/backend/printer.ml +++ b/infer/src/backend/printer.ml @@ -84,9 +84,9 @@ let node_is_visited proc_name node = | Some summary -> let stats = summary.Specs.stats in let is_visited_fp = - IntSet.mem (Cfg.Node.get_id node :> int) stats.Specs.nodes_visited_fp in + IntSet.mem (Procdesc.Node.get_id node :> int) stats.Specs.nodes_visited_fp in let is_visited_re = - IntSet.mem (Cfg.Node.get_id node :> int) stats.Specs.nodes_visited_re in + IntSet.mem (Procdesc.Node.get_id node :> int) stats.Specs.nodes_visited_re in is_visited_fp, is_visited_re (** Return true if the node was visited during analysis *) @@ -100,7 +100,8 @@ let is_visited proc_name node = when starting and finishing the processing of a node *) module NodesHtml : sig val start_node : - int -> Location.t -> Procname.t -> Cfg.Node.t list -> Cfg.Node.t list -> Cfg.Node.t list -> + int -> Location.t -> Procname.t -> Procdesc.Node.t list -> + Procdesc.Node.t list -> Procdesc.Node.t list -> DB.source_file -> bool val finish_node : Procname.t -> int -> DB.source_file -> unit end = struct @@ -131,38 +132,38 @@ end = struct IList.iter (fun node -> Io_infer.Html.pp_node_link [".."] - (Cfg.Node.get_proc_name node) + (Procdesc.Node.get_proc_name node) ~description:"" - ~preds:(IList.map Cfg.Node.get_id (Cfg.Node.get_preds node) :> int list) - ~succs:(IList.map Cfg.Node.get_id (Cfg.Node.get_succs node) :> int list) - ~exn:(IList.map Cfg.Node.get_id (Cfg.Node.get_exn node) :> int list) + ~preds:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_preds node) :> int list) + ~succs:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_succs node) :> int list) + ~exn:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_exn node) :> int list) ~isvisited:(is_visited proc_name node) ~isproof:false - fmt (Cfg.Node.get_id node :> int)) preds; + fmt (Procdesc.Node.get_id node :> int)) preds; F.fprintf fmt "
SUCCS: @\n"; IList.iter (fun node -> Io_infer.Html.pp_node_link [".."] - (Cfg.Node.get_proc_name node) + (Procdesc.Node.get_proc_name node) ~description:"" - ~preds:(IList.map Cfg.Node.get_id (Cfg.Node.get_preds node) :> int list) - ~succs:(IList.map Cfg.Node.get_id (Cfg.Node.get_succs node) :> int list) - ~exn:(IList.map Cfg.Node.get_id (Cfg.Node.get_exn node) :> int list) + ~preds:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_preds node) :> int list) + ~succs:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_succs node) :> int list) + ~exn:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_exn node) :> int list) ~isvisited:(is_visited proc_name node) ~isproof:false - fmt (Cfg.Node.get_id node :> int)) succs; + fmt (Procdesc.Node.get_id node :> int)) succs; F.fprintf fmt "
EXN: @\n"; IList.iter (fun node -> Io_infer.Html.pp_node_link [".."] - (Cfg.Node.get_proc_name node) + (Procdesc.Node.get_proc_name node) ~description:"" - ~preds:(IList.map Cfg.Node.get_id (Cfg.Node.get_preds node) :> int list) - ~succs:(IList.map Cfg.Node.get_id (Cfg.Node.get_succs node) :> int list) - ~exn:(IList.map Cfg.Node.get_id (Cfg.Node.get_exn node) :> int list) + ~preds:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_preds node) :> int list) + ~succs:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_succs node) :> int list) + ~exn:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_exn node) :> int list) ~isvisited:(is_visited proc_name node) ~isproof:false - fmt (Cfg.Node.get_id node :> int)) exns; + fmt (Procdesc.Node.get_id node :> int)) exns; F.fprintf fmt "
@\n"; F.pp_print_flush fmt (); true @@ -237,16 +238,16 @@ let force_delayed_print fmt = let (loc: Location.t) = Obj.obj loc in Location.pp fmt loc | (L.PTnode_instrs, b_n) -> - let (b: bool), (io: Sil.instr option), (n: Cfg.Node.t) = Obj.obj b_n in + let (b: bool), (io: Sil.instr option), (n: Procdesc.Node.t) = Obj.obj b_n in if Config.write_html then F.fprintf fmt "%a%a%a" Io_infer.Html.pp_start_color Green - (Cfg.Node.pp_instrs (pe_html Green) io ~sub_instrs: b) n + (Procdesc.Node.pp_instrs (pe_html Green) io ~sub_instrs: b) n Io_infer.Html.pp_end_color () else F.fprintf fmt "%a" - (Cfg.Node.pp_instrs pe_text io ~sub_instrs: b) n + (Procdesc.Node.pp_instrs pe_text io ~sub_instrs: b) n | (L.PToff, off) -> let (off: Sil.offset) = Obj.obj off in Sil.pp_offset pe_default fmt off @@ -376,17 +377,17 @@ let force_delayed_prints () = (** Start a session, and create a new html fine for the node if it does not exist yet *) let start_session node (loc: Location.t) proc_name session source = - let node_id = Cfg.Node.get_id node in + let node_id = Procdesc.Node.get_id node in (if NodesHtml.start_node (node_id :> int) loc proc_name - (Cfg.Node.get_preds node) - (Cfg.Node.get_succs node) - (Cfg.Node.get_exn node) + (Procdesc.Node.get_preds node) + (Procdesc.Node.get_succs node) + (Procdesc.Node.get_exn node) source then F.fprintf !curr_html_formatter "%a%a%a" Io_infer.Html.pp_start_color Green - (Cfg.Node.pp_instrs (pe_html Green) None ~sub_instrs: true) node + (Procdesc.Node.pp_instrs (pe_html Green) None ~sub_instrs: true) node Io_infer.Html.pp_end_color ()); F.fprintf !curr_html_formatter "%a%a" Io_infer.Html.pp_hline () @@ -406,7 +407,10 @@ let node_finish_session node source = if Config.write_html then begin F.fprintf !curr_html_formatter "%a" Io_infer.Html.pp_end_color (); - NodesHtml.finish_node (Cfg.Node.get_proc_name node) (Cfg.Node.get_id node :> int) source + NodesHtml.finish_node + (Procdesc.Node.get_proc_name node) + (Procdesc.Node.get_id node :> int) + source end (** Write html file for the procedure. @@ -414,9 +418,9 @@ let node_finish_session node source = let write_proc_html source whole_seconds pdesc = if Config.write_html then begin - let pname = Cfg.Procdesc.get_proc_name pdesc in - let nodes = IList.sort Cfg.Node.compare (Cfg.Procdesc.get_nodes pdesc) in - let linenum = (Cfg.Node.get_loc (IList.hd nodes)).Location.line in + let pname = Procdesc.get_proc_name pdesc in + let nodes = IList.sort Procdesc.Node.compare (Procdesc.get_nodes pdesc) in + let linenum = (Procdesc.Node.get_loc (IList.hd nodes)).Location.line in let fd, fmt = Io_infer.Html.create (DB.Results_dir.Abs_source_dir source) @@ -430,14 +434,14 @@ let write_proc_html source whole_seconds pdesc = (fun n -> Io_infer.Html.pp_node_link [] - (Cfg.Node.get_proc_name n) - ~description:(Cfg.Node.get_description (pe_html Black) n) - ~preds:(IList.map Cfg.Node.get_id (Cfg.Node.get_preds n) :> int list) - ~succs:(IList.map Cfg.Node.get_id (Cfg.Node.get_succs n) :> int list) - ~exn:(IList.map Cfg.Node.get_id (Cfg.Node.get_exn n) :> int list) + (Procdesc.Node.get_proc_name n) + ~description:(Procdesc.Node.get_description (pe_html Black) n) + ~preds:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_preds n) :> int list) + ~succs:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_succs n) :> int list) + ~exn:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_exn n) :> int list) ~isvisited:(is_visited pname n) ~isproof:false - fmt (Cfg.Node.get_id n :> int)) + fmt (Procdesc.Node.get_id n :> int)) nodes; (match Specs.get_summary pname with | None -> @@ -468,24 +472,24 @@ let create_err_message err_string = "\n
" ^ err_string ^ "
" let write_html_proc source proof_cover table_nodes_at_linenum global_err_log proc_desc = - let proc_name = Cfg.Procdesc.get_proc_name proc_desc in + let proc_name = Procdesc.get_proc_name proc_desc in let process_node n = - let lnum = (Cfg.Node.get_loc n).Location.line in + let lnum = (Procdesc.Node.get_loc n).Location.line in let curr_nodes = try Hashtbl.find table_nodes_at_linenum lnum with Not_found -> [] in Hashtbl.replace table_nodes_at_linenum lnum ((n, proc_desc) :: curr_nodes) in - let proc_loc = Cfg.Procdesc.get_loc proc_desc in + let proc_loc = Procdesc.get_loc proc_desc in let process_proc = - Cfg.Procdesc.is_defined proc_desc && + Procdesc.is_defined proc_desc && DB.source_file_equal proc_loc.Location.file source && match AttributesTable.find_file_capturing_procedure proc_name with | None -> true | Some (source_captured, _) -> - DB.source_file_equal source_captured (Cfg.Procdesc.get_loc proc_desc).file in + DB.source_file_equal source_captured (Procdesc.get_loc proc_desc).file in if process_proc then begin - IList.iter process_node (Cfg.Procdesc.get_nodes proc_desc); + IList.iter process_node (Procdesc.get_nodes proc_desc); match Specs.get_summary proc_name with | None -> () @@ -539,22 +543,22 @@ let write_html_file linereader filename procs = IList.iter (fun (n, pdesc) -> let isproof = - Specs.Visitedset.mem (Cfg.Node.get_id n, []) !proof_cover in + Specs.Visitedset.mem (Procdesc.Node.get_id n, []) !proof_cover in Io_infer.Html.pp_node_link [fname_encoding] - (Cfg.Node.get_proc_name n) - ~description:(Cfg.Node.get_description (pe_html Black) n) - ~preds:(IList.map Cfg.Node.get_id (Cfg.Node.get_preds n) :> int list) - ~succs:(IList.map Cfg.Node.get_id (Cfg.Node.get_succs n) :> int list) - ~exn:(IList.map Cfg.Node.get_id (Cfg.Node.get_exn n) :> int list) - ~isvisited:(is_visited (Cfg.Procdesc.get_proc_name pdesc) n) + (Procdesc.Node.get_proc_name n) + ~description:(Procdesc.Node.get_description (pe_html Black) n) + ~preds:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_preds n) :> int list) + ~succs:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_succs n) :> int list) + ~exn:(IList.map Procdesc.Node.get_id (Procdesc.Node.get_exn n) :> int list) + ~isvisited:(is_visited (Procdesc.get_proc_name pdesc) n) ~isproof - fmt (Cfg.Node.get_id n :> int)) + fmt (Procdesc.Node.get_id n :> int)) nodes_at_linenum; IList.iter (fun (n, _) -> - match Cfg.Node.get_kind n with - | Cfg.Node.Start_node proc_name -> + match Procdesc.Node.get_kind n with + | Procdesc.Node.Start_node proc_name -> let num_specs = IList.length (Specs.get_specs proc_name) in let label = (Escape.escape_xml (Procname.to_string proc_name)) ^ @@ -599,9 +603,9 @@ let write_all_html_files exe_env = let files = ref DB.SourceFileSet.empty in Cfg.iter_proc_desc cfg (fun _ proc_desc -> - if Cfg.Procdesc.is_defined proc_desc + if Procdesc.is_defined proc_desc then - let file = (Cfg.Procdesc.get_loc proc_desc).Location.file in + let file = (Procdesc.get_loc proc_desc).Location.file in files := DB.SourceFileSet.add file !files); !files in DB.SourceFileSet.iter diff --git a/infer/src/backend/printer.mli b/infer/src/backend/printer.mli index 11ced5fdb..a2d20ee4d 100644 --- a/infer/src/backend/printer.mli +++ b/infer/src/backend/printer.mli @@ -37,19 +37,20 @@ val curr_html_formatter : Format.formatter ref val force_delayed_prints : unit -> unit (** Finish a session, and perform delayed print actions if required *) -val node_finish_session : Cfg.Node.t -> DB.source_file -> unit +val node_finish_session : Procdesc.Node.t -> DB.source_file -> unit (** Return true if the node was visited during footprint and during re-execution *) -val node_is_visited : Procname.t -> Cfg.Node.t -> bool * bool +val node_is_visited : Procname.t -> Procdesc.Node.t -> bool * bool (** Start a session, and create a new html fine for the node if it does not exist yet *) -val node_start_session : Cfg.Node.t -> Location.t -> Procname.t -> int -> DB.source_file -> unit +val node_start_session : + Procdesc.Node.t -> Location.t -> Procname.t -> int -> DB.source_file -> unit (** Write html file for the procedure. The boolean indicates whether to print whole seconds only. *) -val write_proc_html : DB.source_file -> bool -> Cfg.Procdesc.t -> unit +val write_proc_html : DB.source_file -> bool -> Procdesc.t -> unit -val write_html_file : LineReader.t -> DB.source_file -> Cfg.Procdesc.t list -> unit +val write_html_file : LineReader.t -> DB.source_file -> Procdesc.t list -> unit (** Create filename.ext.html for each file in the exe_env. *) val write_all_html_files : Exe_env.t -> unit diff --git a/infer/src/backend/prover.ml b/infer/src/backend/prover.ml index 42d33d784..bb22dadd2 100644 --- a/infer/src/backend/prover.ml +++ b/infer/src/backend/prover.ml @@ -861,7 +861,7 @@ let check_inconsistency_base tenv prop = | None -> false | Some (_, _, pdesc) -> let procedure_attr = - Cfg.Procdesc.get_attributes pdesc in + Procdesc.get_attributes pdesc in let is_java_this pvar = procedure_attr.ProcAttributes.language = Config.Java && Pvar.is_this pvar in let is_objc_instance_self pvar = diff --git a/infer/src/backend/rearrange.ml b/infer/src/backend/rearrange.ml index 21c765566..0c676222d 100644 --- a/infer/src/backend/rearrange.ml +++ b/infer/src/backend/rearrange.ml @@ -613,7 +613,7 @@ let prop_iter_add_hpred_footprint_to_prop pname tenv prop (lexp, typ) inst = expressing the safety conditions for the access. Complain if these conditions cannot be met. *) let add_guarded_by_constraints tenv prop lexp pdesc = let lookup = Tenv.lookup tenv in - let pname = Cfg.Procdesc.get_proc_name pdesc in + let pname = Procdesc.get_proc_name pdesc in let excluded_guardedby_string str = (* nothing with a space in it can be a valid Java expression, shouldn't warn *) let is_invalid_exp_str str = @@ -729,7 +729,7 @@ let add_guarded_by_constraints tenv prop lexp pdesc = (* return true if [pdesc] has an annotation that matches [guarded_by_str] *) let proc_has_matching_annot pdesc guarded_by_str = let proc_signature = - Annotations.get_annotated_signature (Cfg.Procdesc.get_attributes pdesc) in + Annotations.get_annotated_signature (Procdesc.get_attributes pdesc) in let proc_annot, _ = proc_signature.Annotations.ret in match extract_guarded_by_str proc_annot with | Some proc_guarded_by_str -> @@ -738,7 +738,7 @@ let add_guarded_by_constraints tenv prop lexp pdesc = | None -> false in let is_synchronized_on_class guarded_by_str = guarded_by_str_is_current_class guarded_by_str pname && - Cfg.Procdesc.is_java_synchronized pdesc && Procname.java_is_static pname in + Procdesc.is_java_synchronized pdesc && Procname.java_is_static pname in let warn accessed_fld guarded_by_str = let loc = State.get_loc () in let err_desc = @@ -755,9 +755,9 @@ let add_guarded_by_constraints tenv prop lexp pdesc = let has_lock guarded_by_exp = (* procedure is synchronized and guarded by this *) (guarded_by_str_is_current_class_this guarded_by_str pname && - Cfg.Procdesc.is_java_synchronized pdesc) || + Procdesc.is_java_synchronized pdesc) || (guarded_by_str_is_current_class guarded_by_str pname && - Cfg.Procdesc.is_java_synchronized pdesc && Procname.java_is_static pname) || + Procdesc.is_java_synchronized pdesc && Procname.java_is_static pname) || (* or the prop says we already have the lock *) IList.exists (function @@ -769,7 +769,7 @@ let add_guarded_by_constraints tenv prop lexp pdesc = string_is_suffix guarded_by_str (Ident.fieldname_to_string accessed_fld) in let proc_has_suppress_guarded_by_annot pdesc = let proc_signature = - Annotations.get_annotated_signature (Cfg.Procdesc.get_attributes pdesc) in + Annotations.get_annotated_signature (Procdesc.get_attributes pdesc) in let proc_annot, _ = proc_signature.Annotations.ret in match extract_suppress_warnings_str proc_annot with | Some suppression_str-> @@ -795,9 +795,9 @@ let add_guarded_by_constraints tenv prop lexp pdesc = flds | _ -> false) prop.Prop.sigma in - Cfg.Procdesc.get_access pdesc <> PredSymb.Private && + Procdesc.get_access pdesc <> PredSymb.Private && not (Annotations.pdesc_has_annot pdesc Annotations.visibleForTesting) && - not (Procname.java_is_access_method (Cfg.Procdesc.get_proc_name pdesc)) && + not (Procname.java_is_access_method (Procdesc.get_proc_name pdesc)) && not (is_accessible_through_local_ref lexp) && not guardedby_is_self_referential && not (proc_has_suppress_guarded_by_annot pdesc) @@ -1214,7 +1214,7 @@ let rec iter_rearrange res let is_weak_captured_var pdesc pvar = - let pname = Cfg.Procdesc.get_proc_name pdesc in + let pname = Procdesc.get_proc_name pdesc in match pname with | Block _ -> let is_weak_captured (var, typ) = @@ -1222,7 +1222,7 @@ let is_weak_captured_var pdesc pvar = | Typ.Tptr (_, Pk_objc_weak) -> Mangled.equal (Pvar.get_name pvar) var | _ -> false in - IList.exists is_weak_captured (Cfg.Procdesc.get_captured pdesc) + IList.exists is_weak_captured (Procdesc.get_captured pdesc) | _ -> false @@ -1363,7 +1363,7 @@ let check_call_to_objc_block_error tenv pdesc prop fun_exp loc = match get_exp_called () with | Some (_, Exp.Lvar pvar) -> (* pvar is the block *) let name = Pvar.get_name pvar in - IList.exists (fun (cn, _) -> (Mangled.equal name cn)) (Cfg.Procdesc.get_captured pdesc) + IList.exists (fun (cn, _) -> (Mangled.equal name cn)) (Procdesc.get_captured pdesc) | _ -> false in let is_field_deref () = (*Called expression is a field *) match get_exp_called () with @@ -1422,7 +1422,7 @@ let rearrange ?(report_deref_errors=true) pdesc tenv lexp typ prop loc L.d_str "Exp: "; Sil.d_exp nlexp; L.d_ln (); L.d_str "Prop: "; L.d_ln(); Prop.d_prop prop; L.d_ln (); L.d_ln (); if report_deref_errors then check_dereference_error tenv pdesc prop nlexp (State.get_loc ()); - let pname = Cfg.Procdesc.get_proc_name pdesc in + let pname = Procdesc.get_proc_name pdesc in let prop' = if Config.csl_analysis && !Config.footprint && Procname.is_java pname && not (Procname.is_constructor pname || Procname.is_class_initializer pname) diff --git a/infer/src/backend/rearrange.mli b/infer/src/backend/rearrange.mli index bcddec967..74969deec 100644 --- a/infer/src/backend/rearrange.mli +++ b/infer/src/backend/rearrange.mli @@ -16,17 +16,17 @@ exception ARRAY_ACCESS (** Check for dereference errors: dereferencing 0, a freed value, or an undefined value *) val check_dereference_error : - Tenv.t -> Cfg.Procdesc.t -> Prop.normal Prop.t -> Exp.t -> Location.t -> unit + Tenv.t -> Procdesc.t -> Prop.normal Prop.t -> Exp.t -> Location.t -> unit (** Check that an expression representing an objc block can be null and raise a [B1] null exception. It's used to check that we don't call possibly null blocks *) val check_call_to_objc_block_error : - Tenv.t -> Cfg.Procdesc.t -> Prop.normal Prop.t -> Exp.t -> Location.t -> unit + Tenv.t -> Procdesc.t -> Prop.normal Prop.t -> Exp.t -> Location.t -> unit (** [rearrange lexp prop] rearranges [prop] into the form [prop' * lexp|->strexp:typ]. It returns an iterator with [lexp |-> strexp: typ] as current predicate and the path (an [offsetlist]) which leads to [lexp] as the iterator state. *) val rearrange : - ?report_deref_errors:bool -> Cfg.Procdesc.t -> Tenv.t -> Exp.t -> + ?report_deref_errors:bool -> Procdesc.t -> Tenv.t -> Exp.t -> Typ.t -> Prop.normal Prop.t -> Location.t -> (Sil.offset list) Prop.prop_iter list diff --git a/infer/src/backend/specs.ml b/infer/src/backend/specs.ml index 10c980ef5..572cc483a 100644 --- a/infer/src/backend/specs.ml +++ b/infer/src/backend/specs.ml @@ -143,8 +143,8 @@ end module Visitedset = Set.Make (struct - type t = Cfg.Node.id * int list - let compare (node_id1, _) (node_id2, _) = Cfg.Node.id_compare node_id1 node_id2 + type t = Procdesc.Node.id * int list + let compare (node_id1, _) (node_id2, _) = Procdesc.Node.id_compare node_id1 node_id2 end) let visited_str vis = @@ -331,7 +331,7 @@ type payload = type summary = { dependency_map: dependency_map_t; (** maps children procs to timestamp as last seen at the start of an analysys phase for this proc *) - nodes: Cfg.Node.id list; (** ids of cfg nodes of the procedure *) + nodes: Procdesc.Node.id list; (** ids of cfg nodes of the procedure *) phase: phase; (** in FOOTPRINT phase or in RE_EXECUTION PHASE *) payload: payload; (** payload containing the result of some analysis *) sessions: int ref; (** Session number: how many nodes went trough symbolic execution *) @@ -339,7 +339,7 @@ type summary = status: status; (** ACTIVE when the proc is being analyzed *) timestamp: int; (** Timestamp of the specs, >= 0, increased every time the specs change *) attributes : ProcAttributes.t; (** Attributes of the procedure *) - proc_desc_option : Cfg.Procdesc.t option; + proc_desc_option : Procdesc.t option; } type spec_tbl = (summary * DB.origin) Procname.Hash.t @@ -668,7 +668,7 @@ let proc_resolve_attributes proc_name = (** Like proc_resolve_attributes but start from a proc_desc. *) let pdesc_resolve_attributes proc_desc = - let proc_name = Cfg.Procdesc.get_proc_name proc_desc in + let proc_name = Procdesc.get_proc_name proc_desc in match proc_resolve_attributes proc_name with | Some proc_attributes -> proc_attributes diff --git a/infer/src/backend/specs.mli b/infer/src/backend/specs.mli index f325042aa..1e6b8c5d3 100644 --- a/infer/src/backend/specs.mli +++ b/infer/src/backend/specs.mli @@ -61,7 +61,7 @@ module Jprop : sig end (** set of visited nodes: node id and list of lines of all the instructions *) -module Visitedset : Set.S with type elt = Cfg.Node.id * int list +module Visitedset : Set.S with type elt = Procdesc.Node.id * int list (** convert a Visitedset to a string *) val visited_str : Visitedset.t -> string @@ -136,7 +136,7 @@ type payload = (** Procedure summary *) type summary = { dependency_map: dependency_map_t; (** maps children procs to timestamp as last seen at the start of an analysys phase for this proc *) - nodes: Cfg.Node.id list; (** ids of cfg nodes of the procedure *) + nodes: Procdesc.Node.id list; (** ids of cfg nodes of the procedure *) phase: phase; (** in FOOTPRINT phase or in RE_EXECUTION PHASE *) payload: payload; (** payload containing the result of some analysis *) sessions: int ref; (** Session number: how many nodes went trough symbolic execution *) @@ -144,7 +144,7 @@ type summary = status: status; (** ACTIVE when the proc is being analyzed *) timestamp: int; (** Timestamp of the specs, >= 0, increased every time the specs change *) attributes : ProcAttributes.t; (** Attributes of the procedure *) - proc_desc_option : Cfg.Procdesc.t option; + proc_desc_option : Procdesc.t option; } (** Add the summary to the table for the given function *) @@ -211,16 +211,16 @@ val is_active : summary -> bool Do nothing if a summary exists already. *) val init_summary : (Procname.t list * (* depend list *) - Cfg.Node.id list * (* nodes *) + Procdesc.Node.id list * (* nodes *) proc_flags * (* procedure flags *) (Procname.t * Location.t) list * (* calls *) (Cg.in_out_calls option) * (* in and out calls *) ProcAttributes.t * (* attributes of the procedure *) - Cfg.Procdesc.t option) (* procdesc option *) + Procdesc.t option) (* procdesc option *) -> unit (** Reset a summary rebuilding the dependents and preserving the proc attributes if present. *) -val reset_summary : Cg.t -> Procname.t -> ProcAttributes.t option -> Cfg.Procdesc.t option -> unit +val reset_summary : Cg.t -> Procname.t -> ProcAttributes.t option -> Procdesc.t option -> unit (** Load procedure summary from the given file *) val load_summary : DB.filename -> summary option @@ -248,7 +248,7 @@ val pp_summary_latex : whole_seconds:bool -> color -> Format.formatter -> summar val pp_summary_text : whole_seconds:bool -> Format.formatter -> summary -> unit (** Like proc_resolve_attributes but start from a proc_desc. *) -val pdesc_resolve_attributes : Cfg.Procdesc.t -> ProcAttributes.t +val pdesc_resolve_attributes : Procdesc.t -> ProcAttributes.t (** Try to find the attributes for a defined proc. First look at specs (to get attributes computed by analysis) diff --git a/infer/src/backend/state.ml b/infer/src/backend/state.ml index ce0f202b0..2a94de69b 100644 --- a/infer/src/backend/state.ml +++ b/infer/src/backend/state.ml @@ -15,7 +15,7 @@ open! Utils module L = Logging module F = Format -type const_map = Cfg.Node.t -> Exp.t -> Const.t option +type const_map = Procdesc.Node.t -> Exp.t -> Const.t option (** failure statistics for symbolic execution on a given node *) type failure_stats = { @@ -28,7 +28,7 @@ type failure_stats = { (* exception at the first failure *) } -module NodeHash = Cfg.NodeHash +module NodeHash = Procdesc.NodeHash type t = { mutable const_map : const_map; @@ -43,13 +43,13 @@ type t = { mutable last_instr : Sil.instr option; (** Last instruction seen *) - mutable last_node : Cfg.Node.t; + mutable last_node : Procdesc.Node.t; (** Last node seen *) mutable last_path : (Paths.Path.t * (PredSymb.path_pos option)) option; (** Last path seen *) - mutable last_prop_tenv_pdesc : (Prop.normal Prop.t * Tenv.t * Cfg.Procdesc.t) option; + mutable last_prop_tenv_pdesc : (Prop.normal Prop.t * Tenv.t * Procdesc.t) option; (** Last prop,tenv,pdesc seen *) mutable last_session : int; @@ -64,7 +64,7 @@ let initial () = { diverging_states_node = Paths.PathSet.empty; diverging_states_proc = Paths.PathSet.empty; last_instr = None; - last_node = Cfg.Node.dummy (); + last_node = Procdesc.Node.dummy (); last_path = None; last_prop_tenv_pdesc = None; last_session = 0; @@ -112,7 +112,7 @@ let get_instr () = let get_loc () = match !gs.last_instr with | Some instr -> Sil.instr_get_loc instr - | None -> Cfg.Node.get_loc !gs.last_node + | None -> Procdesc.Node.get_loc !gs.last_node let get_node () = !gs.last_node @@ -133,13 +133,13 @@ let node_simple_key node = | Sil.Abstract _ -> add_key 6 | Sil.Remove_temps _ -> add_key 7 | Sil.Declare_locals _ -> add_key 8 in - IList.iter do_instr (Cfg.Node.get_instrs node); + IList.iter do_instr (Procdesc.Node.get_instrs node); Hashtbl.hash !key (** key for a node: look at the current node, successors and predecessors *) let node_key node = - let succs = Cfg.Node.get_succs node in - let preds = Cfg.Node.get_preds node in + let succs = Procdesc.Node.get_succs node in + let preds = Procdesc.Node.get_preds node in let v = (node_simple_key node, IList.map node_simple_key succs, IList.map node_simple_key preds) in Hashtbl.hash v @@ -161,25 +161,25 @@ let instrs_normalize instrs = (** Create a function to find duplicate nodes. A node is a duplicate of another one if they have the same kind and location and normalized (w.r.t. renaming of let - bound ids) list of instructions. *) -let mk_find_duplicate_nodes proc_desc : (Cfg.Node.t -> Cfg.NodeSet.t) = +let mk_find_duplicate_nodes proc_desc : (Procdesc.Node.t -> Procdesc.NodeSet.t) = let module M = (* map from (loc,kind) *) Map.Make(struct - type t = Location.t * Cfg.Node.nodekind + type t = Location.t * Procdesc.Node.nodekind let compare (loc1, k1) (loc2, k2) = let n = Location.compare loc1 loc2 in - if n <> 0 then n else Cfg.Node.kind_compare k1 k2 + if n <> 0 then n else Procdesc.Node.kind_compare k1 k2 end) in let module S = (* set of nodes with normalized insructions *) Set.Make(struct - type t = Cfg.Node.t * Sil.instr list + type t = Procdesc.Node.t * Sil.instr list let compare (n1, _) (n2, _) = - Cfg.Node.compare n1 n2 + Procdesc.Node.compare n1 n2 end) in let get_key node = (* map key *) - let loc = Cfg.Node.get_loc node in - let kind = Cfg.Node.get_kind node in + let loc = Procdesc.Node.get_loc node in + let kind = Procdesc.Node.get_kind node in (loc, kind) in let map = @@ -192,14 +192,14 @@ let mk_find_duplicate_nodes proc_desc : (Cfg.Node.t -> Cfg.NodeSet.t) = end in let do_node node = - let normalized_instrs = instrs_normalize (Cfg.Node.get_instrs node) in + let normalized_instrs = instrs_normalize (Procdesc.Node.get_instrs node) in let key = get_key node in let s = try M.find key !m with Not_found -> S.empty in if S.cardinal s > E.threshold then raise E.Threshold; let s' = S.add (node, normalized_instrs) s in m := M.add key s' !m in - let nodes = Cfg.Procdesc.get_nodes proc_desc in + let nodes = Procdesc.get_nodes proc_desc in try IList.iter do_node nodes; !m @@ -211,7 +211,7 @@ let mk_find_duplicate_nodes proc_desc : (Cfg.Node.t -> Cfg.NodeSet.t) = let s = M.find (get_key node) map in let elements = S.elements s in let (_, node_normalized_instrs), _ = - let filter (node', _) = Cfg.Node.equal node node' in + let filter (node', _) = Procdesc.Node.equal node node' in match IList.partition filter elements with | [this], others -> this, others | _ -> raise Not_found in @@ -220,17 +220,17 @@ let mk_find_duplicate_nodes proc_desc : (Cfg.Node.t -> Cfg.NodeSet.t) = IList.compare Sil.instr_compare node_normalized_instrs normalized_instrs' = 0 in IList.filter equal_normalized_instrs elements in IList.fold_left - (fun nset (node', _) -> Cfg.NodeSet.add node' nset) - Cfg.NodeSet.empty duplicates - with Not_found -> Cfg.NodeSet.singleton node in + (fun nset (node', _) -> Procdesc.NodeSet.add node' nset) + Procdesc.NodeSet.empty duplicates + with Not_found -> Procdesc.NodeSet.singleton node in find_duplicate_nodes let get_node_id () = - Cfg.Node.get_id !gs.last_node + Procdesc.Node.get_id !gs.last_node let get_node_id_key () = - (Cfg.Node.get_id !gs.last_node, node_key !gs.last_node) + (Procdesc.Node.get_id !gs.last_node, node_key !gs.last_node) let get_inst_update pos = let loc = get_loc () in @@ -274,7 +274,7 @@ let get_session () = let get_path_pos () = let pname = match get_prop_tenv_pdesc () with - | Some (_, _, pdesc) -> Cfg.Procdesc.get_proc_name pdesc + | Some (_, _, pdesc) -> Procdesc.get_proc_name pdesc | None -> Procname.from_string_c_fun "unknown_procedure" in let nid = get_node_id () in (pname, (nid :> int)) @@ -317,7 +317,7 @@ type log_issue = let process_execution_failures (log_issue : log_issue) pname = let do_failure _ fs = - (* L.err "Node:%a node_ok:%d node_fail:%d@." Cfg.Node.pp node fs.node_ok fs.node_fail; *) + (* L.err "Node:%a node_ok:%d node_fail:%d@." Procdesc.Node.pp node fs.node_ok fs.node_fail; *) match fs.node_ok, fs.first_failure with | 0, Some (loc, key, _, loc_trace, exn) -> let ex_name, _, ml_loc_opt, _, _, _, _ = Exceptions.recognize_exception exn in @@ -336,7 +336,7 @@ let set_path path pos_opt = let set_prop_tenv_pdesc prop tenv pdesc = !gs.last_prop_tenv_pdesc <- Some (prop, tenv, pdesc) -let set_node (node: Cfg.Node.t) = +let set_node (node: Procdesc.Node.t) = !gs.last_instr <- None; !gs.last_node <- node diff --git a/infer/src/backend/state.mli b/infer/src/backend/state.mli index 82b5ac4e8..402545be5 100644 --- a/infer/src/backend/state.mli +++ b/infer/src/backend/state.mli @@ -18,7 +18,7 @@ type t (** Add diverging states *) val add_diverging_states : Paths.PathSet.t -> unit -type const_map = Cfg.Node.t -> Exp.t -> Const.t option +type const_map = Procdesc.Node.t -> Exp.t -> Const.t option (** Get the constant map for the current procedure. *) val get_const_map : unit -> const_map @@ -42,13 +42,13 @@ val get_loc : unit -> Location.t val get_loc_trace : unit -> Errlog.loc_trace (** Get last node seen in symbolic execution *) -val get_node : unit -> Cfg.Node.t +val get_node : unit -> Procdesc.Node.t (** Get id of last node seen in symbolic execution *) -val get_node_id : unit -> Cfg.Node.id +val get_node_id : unit -> Procdesc.Node.id (** Get id and key of last node seen in symbolic execution *) -val get_node_id_key : unit -> Cfg.Node.id * int +val get_node_id_key : unit -> Procdesc.Node.id * int (** return the normalized precondition extracted form the last prop seen, if any the abstraction function is a parameter to get around module dependencies *) @@ -62,16 +62,16 @@ val get_path : unit -> Paths.Path.t * (PredSymb.path_pos option) val get_path_pos : unit -> PredSymb.path_pos (** Get last last prop,tenv,pdesc seen in symbolic execution *) -val get_prop_tenv_pdesc : unit -> (Prop.normal Prop.t * Tenv.t * Cfg.Procdesc.t) option +val get_prop_tenv_pdesc : unit -> (Prop.normal Prop.t * Tenv.t * Procdesc.t) option (** Get last session seen in symbolic execution *) val get_session : unit -> int (** Mark the end of symbolic execution of a node *) -val mark_execution_end : Cfg.Node.t -> unit +val mark_execution_end : Procdesc.Node.t -> unit (** Mark the start of symbolic execution of a node *) -val mark_execution_start : Cfg.Node.t -> unit +val mark_execution_start : Procdesc.Node.t -> unit (** Mark that the execution of the current instruction failed *) val mark_instr_fail : exn -> unit @@ -82,7 +82,7 @@ val mark_instr_ok : unit -> unit (** Create a function to find duplicate nodes. A node is a duplicate of another one if they have the same kind and location and normalized (w.r.t. renaming of let - bound ids) list of instructions. *) -val mk_find_duplicate_nodes: Cfg.Procdesc.t -> (Cfg.Node.t -> Cfg.NodeSet.t) +val mk_find_duplicate_nodes: Procdesc.t -> (Procdesc.Node.t -> Procdesc.NodeSet.t) type log_issue = Procname.t -> @@ -115,13 +115,13 @@ val set_const_map : const_map -> unit val set_instr : Sil.instr -> unit (** Set last node seen in symbolic execution *) -val set_node : Cfg.Node.t -> unit +val set_node : Procdesc.Node.t -> unit (** Get last path seen in symbolic execution *) val set_path : Paths.Path.t -> PredSymb.path_pos option -> unit (** Set last prop,tenv,pdesc seen in symbolic execution *) -val set_prop_tenv_pdesc : Prop.normal Prop.t -> Tenv.t -> Cfg.Procdesc.t -> unit +val set_prop_tenv_pdesc : Prop.normal Prop.t -> Tenv.t -> Procdesc.t -> unit (** Set last session seen in symbolic execution *) val set_session : int -> unit diff --git a/infer/src/backend/symExec.ml b/infer/src/backend/symExec.ml index 31ad3ea28..068d96308 100644 --- a/infer/src/backend/symExec.ml +++ b/infer/src/backend/symExec.ml @@ -47,7 +47,7 @@ let unroll_type tenv (typ: Typ.t) (off: Sil.offset) = let get_blocks_nullified node = let null_blocks = IList.flatten(IList.map (fun i -> match i with | Sil.Nullify(pvar, _) when Sil.is_block_pvar pvar -> [pvar] - | _ -> []) (Cfg.Node.get_instrs node)) in + | _ -> []) (Procdesc.Node.get_instrs node)) in null_blocks (** Given a proposition and an objc block checks whether by existentially quantifying @@ -83,7 +83,7 @@ let check_block_retain_cycle tenv caller_pname prop block_nullified = let rec apply_offlist pdesc tenv p fp_root nullify_struct (root_lexp, strexp, typ) offlist (f: Exp.t option -> Exp.t) inst lookup_inst = - let pname = Cfg.Procdesc.get_proc_name pdesc in + let pname = Procdesc.get_proc_name pdesc in let pp_error () = L.d_strln ".... Invalid Field ...."; L.d_str "strexp : "; Sil.d_sexp strexp; L.d_ln (); @@ -803,7 +803,7 @@ let add_constraints_on_retval tenv pdesc prop ret_exp ~has_nullable_annot typ ca if Procname.is_infer_undefined callee_pname then prop else let is_rec_call pname = (* TODO: (t7147096) extend this to detect mutual recursion *) - Procname.equal pname (Cfg.Procdesc.get_proc_name pdesc) in + Procname.equal pname (Procdesc.get_proc_name pdesc) in let already_has_abduced_retval p abduced_ret_pv = IList.exists (fun hpred -> match hpred with @@ -977,7 +977,7 @@ let execute_store ?(report_deref_errors=true) pname pdesc tenv lhs_exp typ rhs_e (** Execute [instr] with a symbolic heap [prop].*) let rec sym_exec tenv current_pdesc _instr (prop_: Prop.normal Prop.t) path : (Prop.normal Prop.t * Paths.Path.t) list = - let current_pname = Cfg.Procdesc.get_proc_name current_pdesc in + let current_pname = Procdesc.get_proc_name current_pdesc in State.set_instr _instr; (* mark instruction last seen *) State.set_prop_tenv_pdesc prop_ tenv current_pdesc; (* mark prop,tenv,pdesc last seen *) SymOp.pay(); (* pay one symop *) @@ -1118,7 +1118,7 @@ let rec sym_exec tenv current_pdesc _instr (prop_: Prop.normal Prop.t) path Ondemand.analyze_proc_name tenv ~propagate_exceptions:true current_pdesc resolved_pname; let callee_pdesc_opt = Ondemand.get_proc_desc resolved_pname in - let ret_typ_opt = Option.map Cfg.Procdesc.get_ret_type callee_pdesc_opt in + let ret_typ_opt = Option.map Procdesc.get_ret_type callee_pdesc_opt in let sentinel_result = if !Config.curr_language = Config.Clang then check_variadic_sentinel_if_present @@ -1129,7 +1129,7 @@ let rec sym_exec tenv current_pdesc _instr (prop_: Prop.normal Prop.t) path if Option.map_default call_should_be_skipped true resolved_summary_opt then (* If it's an ObjC getter or setter, call the builtin rather than skipping *) let attrs_opt = - let attr_opt = Option.map Cfg.Procdesc.get_attributes callee_pdesc_opt in + let attr_opt = Option.map Procdesc.get_attributes callee_pdesc_opt in match attr_opt, resolved_pname with | Some attrs, Procname.ObjC_Cpp _ -> Some attrs | None, Procname.ObjC_Cpp _ -> AttributesTable.load_attributes resolved_pname @@ -1426,7 +1426,7 @@ and unknown_or_scan_call ~is_scan ret_type_option ret_annots | _ -> pre_1 in let pre_3 = add_constraints_on_actuals_by_ref tenv pre_2 actuals_by_ref callee_pname loc in - let caller_pname = Cfg.Procdesc.get_proc_name pdesc in + let caller_pname = Procdesc.get_proc_name pdesc in add_tainted_pre pre_3 args caller_pname callee_pname in if is_scan (* if scan function, don't mark anything with undef attributes *) then [(Tabulation.remove_constant_string_class tenv pre_final, path)] @@ -1523,13 +1523,13 @@ and sym_exec_objc_accessor property_accesor ret_typ tenv ret_id pdesc _ loc args | ProcAttributes.Objc_setter field_name -> sym_exec_objc_setter field_name in (* we want to execute in the context of the current procedure, not in the context of callee_pname, since this is the procname of the setter/getter method *) - let cur_pname = Cfg.Procdesc.get_proc_name pdesc in + let cur_pname = Procdesc.get_proc_name pdesc in f_accessor ret_typ tenv ret_id pdesc cur_pname loc args prop |> IList.map (fun p -> (p, path)) (** Perform symbolic execution for a function call *) and proc_call summary {Builtin.pdesc; tenv; prop_= pre; path; ret_id; args= actual_pars; loc; } = - let caller_pname = Cfg.Procdesc.get_proc_name pdesc in + let caller_pname = Procdesc.get_proc_name pdesc in let callee_pname = Specs.get_proc_name summary in let ret_typ = Specs.get_ret_type summary in let check_return_value_ignored () = @@ -1588,7 +1588,7 @@ and proc_call summary {Builtin.pdesc; tenv; prop_= pre; path; ret_id; args= actu (** perform symbolic execution for a single prop, and check for junk *) and sym_exec_wrapper handle_exn tenv pdesc instr ((prop: Prop.normal Prop.t), path) : Paths.PathSet.t = - let pname = Cfg.Procdesc.get_proc_name pdesc in + let pname = Procdesc.get_proc_name pdesc in let prop_primed_to_normal p = (* Rename primed vars with fresh normal vars, and return them *) let fav = Prop.prop_fav p in Sil.fav_filter_ident fav Ident.is_primed; @@ -1623,10 +1623,10 @@ and sym_exec_wrapper handle_exn tenv pdesc instr ((prop: Prop.normal Prop.t), pa let instr_is_abstraction = function | Sil.Abstract _ -> true | _ -> false in - IList.exists instr_is_abstraction (Cfg.Node.get_instrs node) in + IList.exists instr_is_abstraction (Procdesc.Node.get_instrs node) in let curr_node = State.get_node () in - match Cfg.Node.get_kind curr_node with - | Cfg.Node.Prune_node _ when not (node_has_abstraction curr_node) -> + match Procdesc.Node.get_kind curr_node with + | Procdesc.Node.Prune_node _ when not (node_has_abstraction curr_node) -> (* don't check for leaks in prune nodes, unless there is abstraction anyway,*) (* but force them into either branch *) p' @@ -1657,11 +1657,11 @@ and sym_exec_wrapper handle_exn tenv pdesc instr ((prop: Prop.normal Prop.t), pa (** {2 Lifted Abstract Transfer Functions} *) let node handle_exn tenv pdesc node (pset : Paths.PathSet.t) : Paths.PathSet.t = - let pname = Cfg.Procdesc.get_proc_name pdesc in + let pname = Procdesc.get_proc_name pdesc in let exe_instr_prop instr p tr (pset1: Paths.PathSet.t) = let pset2 = if Tabulation.prop_is_exn pname p && not (Sil.instr_is_auxiliary instr) - && Cfg.Node.get_kind node <> Cfg.Node.exn_handler_kind + && Procdesc.Node.get_kind node <> Procdesc.Node.exn_handler_kind (* skip normal instructions if an exception was thrown, unless this is an exception handler node *) then @@ -1673,4 +1673,4 @@ let node handle_exn tenv pdesc node (pset : Paths.PathSet.t) : Paths.PathSet.t = Paths.PathSet.union pset2 pset1 in let exe_instr_pset pset instr = Paths.PathSet.fold (exe_instr_prop instr) pset Paths.PathSet.empty in - IList.fold_left exe_instr_pset pset (Cfg.Node.get_instrs node) + IList.fold_left exe_instr_pset pset (Procdesc.Node.get_instrs node) diff --git a/infer/src/backend/symExec.mli b/infer/src/backend/symExec.mli index e3f91db99..10e8f3415 100644 --- a/infer/src/backend/symExec.mli +++ b/infer/src/backend/symExec.mli @@ -14,12 +14,12 @@ open! Utils (** Symbolic execution of the instructions of a node, lifted to sets of propositions. *) val node : - (exn -> unit) -> Tenv.t -> Cfg.Procdesc.t -> Cfg.Node.t -> Paths.PathSet.t -> Paths.PathSet.t + (exn -> unit) -> Tenv.t -> Procdesc.t -> Procdesc.Node.t -> Paths.PathSet.t -> Paths.PathSet.t (** Symbolic execution of a sequence of instructions. If errors occur and [mask_errors] is true, just treat as skip. *) val instrs : - ?mask_errors:bool -> Tenv.t -> Cfg.Procdesc.t -> Sil.instr list -> + ?mask_errors:bool -> Tenv.t -> Procdesc.t -> Sil.instr list -> (Prop.normal Prop.t * Paths.Path.t) list -> (Prop.normal Prop.t * Paths.Path.t) list (** Symbolic execution of the divergent pure computation. *) diff --git a/infer/src/backend/tabulation.ml b/infer/src/backend/tabulation.ml index 4a97e0bd2..32dd8a0ff 100644 --- a/infer/src/backend/tabulation.ml +++ b/infer/src/backend/tabulation.ml @@ -673,7 +673,7 @@ let combine tenv ret_id (posts: ('a Prop.t * Paths.Path.t) list) actual_pre path_pre split caller_pdesc callee_pname loc = - let caller_pname = Cfg.Procdesc.get_proc_name caller_pdesc in + let caller_pname = Procdesc.get_proc_name caller_pdesc in let instantiated_post = let posts' = if !Config.footprint && posts = [] @@ -1008,7 +1008,7 @@ let check_uninitialize_dangling_deref tenv callee_pname actual_pre sub formal_pa let exe_spec tenv ret_id (n, nspecs) caller_pdesc callee_pname callee_attrs loc prop path_pre (spec : Prop.exposed Specs.spec) actual_params formal_params : abduction_res = - let caller_pname = Cfg.Procdesc.get_proc_name caller_pdesc in + let caller_pname = Procdesc.get_proc_name caller_pdesc in let posts = mk_posts tenv ret_id prop callee_pname callee_attrs spec.Specs.posts in let actual_pre = mk_actual_precondition tenv prop actual_params formal_params in let spec_pre = @@ -1272,7 +1272,7 @@ let exe_call_postprocess tenv ret_id trace_call callee_pname callee_attrs loc re (** Execute the function call and return the list of results with return value *) let exe_function_call callee_attrs tenv ret_id caller_pdesc callee_pname loc actual_params prop path = - let caller_pname = Cfg.Procdesc.get_proc_name caller_pdesc in + let caller_pname = Procdesc.get_proc_name caller_pdesc in let trace_call res = match Specs.get_summary caller_pname with | None -> () diff --git a/infer/src/backend/tabulation.mli b/infer/src/backend/tabulation.mli index 3dd075ba6..22e456e34 100644 --- a/infer/src/backend/tabulation.mli +++ b/infer/src/backend/tabulation.mli @@ -44,6 +44,6 @@ val d_splitting : splitting -> unit (** Execute the function call and return the list of results with return value *) val exe_function_call: - ProcAttributes.t -> Tenv.t -> (Ident.t * Typ.t) option -> Cfg.Procdesc.t -> Procname.t -> + ProcAttributes.t -> Tenv.t -> (Ident.t * Typ.t) option -> Procdesc.t -> Procname.t -> Location.t -> (Exp.t * Typ.t) list -> Prop.normal Prop.t -> Paths.Path.t -> (Prop.normal Prop.t * Paths.Path.t) list diff --git a/infer/src/checkers/BoundedCallTree.ml b/infer/src/checkers/BoundedCallTree.ml index 6f44b5cee..708812148 100644 --- a/infer/src/checkers/BoundedCallTree.ml +++ b/infer/src/checkers/BoundedCallTree.ml @@ -37,14 +37,14 @@ module SpecSummary = Summary.Make (struct end) type extras_t = { - get_proc_desc : Procname.t -> Cfg.Procdesc.t option; + get_proc_desc : Procname.t -> Procdesc.t option; stacktraces : Stacktrace.t list; } let line_range_of_pdesc pdesc = - let ploc = Cfg.Procdesc.get_loc pdesc in + let ploc = Procdesc.get_loc pdesc in let start_line = ploc.Location.line in - let end_line = Cfg.Procdesc.fold_instrs + let end_line = Procdesc.fold_instrs (fun acc _ instr -> let new_loc = Sil.instr_get_loc instr in max acc new_loc.Location.line) @@ -54,10 +54,10 @@ let line_range_of_pdesc pdesc = let stacktree_of_pdesc pdesc - ?(loc=Cfg.Procdesc.get_loc pdesc) + ?(loc=Procdesc.get_loc pdesc) ?(callees=[]) location_type = - let procname = Cfg.Procdesc.get_proc_name pdesc in + let procname = Procdesc.get_proc_name pdesc in let frame_loc = Some { Stacktree_j.location_type = location_type; file = DB.source_file_to_string loc.Location.file; @@ -95,7 +95,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct stacktree_of_pdesc pdesc ~loc ~callees location_type let output_json_summary tenv pdesc astate loc location_type get_proc_desc = - let caller = Cfg.Procdesc.get_proc_name pdesc in + let caller = Procdesc.get_proc_name pdesc in let stacktree = stacktree_of_astate tenv pdesc astate loc location_type get_proc_desc in let dir = Filename.concat Config.results_dir "crashcontext" in @@ -112,7 +112,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct let get_proc_desc = proc_data.ProcData.extras.get_proc_desc in let traces = proc_data.ProcData.extras.stacktraces in let tenv = proc_data.ProcData.tenv in - let caller = Cfg.Procdesc.get_proc_name proc_data.ProcData.pdesc in + let caller = Procdesc.get_proc_name proc_data.ProcData.pdesc in let matches_proc frame = let matches_class pname = match pname with | Procname.Java java_proc -> @@ -186,7 +186,7 @@ let checker { Callbacks.proc_desc; tenv; get_proc_desc; } = | Some stacktraces -> begin let extras = { get_proc_desc; stacktraces; } in SpecSummary.write_summary - (Cfg.Procdesc.get_proc_name proc_desc) + (Procdesc.get_proc_name proc_desc) (Some (stacktree_of_pdesc proc_desc "proc_start")); ignore(Analyzer.exec_pdesc (ProcData.make proc_desc tenv extras)) end diff --git a/infer/src/checkers/SimpleChecker.ml b/infer/src/checkers/SimpleChecker.ml index 74db23524..283823c02 100644 --- a/infer/src/checkers/SimpleChecker.ml +++ b/infer/src/checkers/SimpleChecker.ml @@ -25,7 +25,7 @@ module type Spec = sig input is the previous state, current instruction, current node kind, current procedure and type environment. *) - val exec_instr : astate -> Sil.instr -> Cfg.Node.nodekind -> Procname.t -> Tenv.t -> astate + val exec_instr : astate -> Sil.instr -> Procdesc.Node.nodekind -> Procname.t -> Tenv.t -> astate (** log errors here. input is a state, location where the state occurs in the source, and the current procedure. @@ -74,7 +74,7 @@ module Make (Spec : Spec) : S = struct let exec_instr astate_set proc_data node instr = let node_kind = CFG.kind node in - let pname = Cfg.Procdesc.get_proc_name proc_data.ProcData.pdesc in + let pname = Procdesc.get_proc_name proc_data.ProcData.pdesc in Domain.fold (fun astate acc -> Domain.add (Spec.exec_instr astate instr node_kind pname proc_data.ProcData.tenv) acc) @@ -89,7 +89,7 @@ module Make (Spec : Spec) : S = struct (TransferFunctions) let checker { Callbacks.proc_desc; proc_name; tenv; } = - let nodes = Cfg.Procdesc.get_nodes proc_desc in + let nodes = Procdesc.get_nodes proc_desc in let do_reporting node_id state = let astate_set = state.AbstractInterpreter.post in if not (Domain.is_empty astate_set) @@ -97,7 +97,7 @@ module Make (Spec : Spec) : S = struct (* should never fail since keys in the invariant map should always be real node id's *) let node = IList.find - (fun node -> Cfg.Node.id_compare node_id (Cfg.Node.get_id node) = 0) + (fun node -> Procdesc.Node.id_compare node_id (Procdesc.Node.get_id node) = 0) nodes in Domain.iter (fun astate -> diff --git a/infer/src/checkers/SimpleChecker.mli b/infer/src/checkers/SimpleChecker.mli index ecf5819a5..9ec95785d 100644 --- a/infer/src/checkers/SimpleChecker.mli +++ b/infer/src/checkers/SimpleChecker.mli @@ -13,7 +13,7 @@ sig val initial : astate val exec_instr : astate -> - Sil.instr -> Cfg.Node.nodekind -> Procname.t -> Tenv.t -> astate + Sil.instr -> Procdesc.Node.nodekind -> Procname.t -> Tenv.t -> astate val report : astate -> Location.t -> Procname.t -> unit val compare : astate -> astate -> int end diff --git a/infer/src/checkers/Siof.ml b/infer/src/checkers/Siof.ml index cbd9b9df6..dd1ce42d9 100644 --- a/infer/src/checkers/Siof.ml +++ b/infer/src/checkers/Siof.ml @@ -48,7 +48,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct let sink_of_global global pname loc = let site = CallSite.make pname loc in SiofTrace.Sink.make global site in - let pname = Cfg.Procdesc.get_proc_name pdesc in + let pname = Procdesc.get_proc_name pdesc in let trace = match astate with | Domain.Bottom -> SiofTrace.initial | Domain.NonBottom t -> t in @@ -134,7 +134,7 @@ let report_siof trace pdesc tenv loc = unit: %a. %a" pp_sink final_sink pp_path_part (IList.rev path) in - let caller_pname = Cfg.Procdesc.get_proc_name pdesc in + let caller_pname = Procdesc.get_proc_name pdesc in let exn = Exceptions.Checkers ("STATIC_INITIALIZATION_ORDER_FIASCO", Localise.verbatim_desc description) in Reporting.log_error caller_pname ~loc exn in @@ -143,7 +143,7 @@ let report_siof trace pdesc tenv loc = let siof_check pdesc tenv = function | Some (SiofDomain.NonBottom post) -> - let attrs = Cfg.Procdesc.get_attributes pdesc in + let attrs = Procdesc.get_attributes pdesc in let is_orig_file f = match attrs.ProcAttributes.translation_unit with | Some orig_file -> let orig_path = DB.source_file_to_abs_path orig_file in @@ -162,7 +162,7 @@ let siof_check pdesc tenv = function let checker ({ Callbacks.tenv; proc_desc } as callback) = let post = Interprocedural.checker callback ProcData.empty_extras in - let pname = Cfg.Procdesc.get_proc_name proc_desc in + let pname = Procdesc.get_proc_name proc_desc in match pname with | Procname.C c when Procname.is_globals_initializer c -> siof_check proc_desc tenv post diff --git a/infer/src/checkers/ThreadSafety.ml b/infer/src/checkers/ThreadSafety.ml index e4ad8fa2e..60b976423 100644 --- a/infer/src/checkers/ThreadSafety.ml +++ b/infer/src/checkers/ThreadSafety.ml @@ -45,7 +45,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct let exec_instr ((lockstate,(readstate,writestate)) as astate) { ProcData.pdesc; } _ = let is_unprotected lockstate = - (not (Cfg.Procdesc.is_java_synchronized pdesc)) && (LocksDomain.is_empty lockstate) + (not (Procdesc.is_java_synchronized pdesc)) && (LocksDomain.is_empty lockstate) in function | Sil.Call (_, Const (Cfun pn), _, _, _) -> @@ -87,20 +87,20 @@ let method_analysis { Callbacks.proc_desc; tenv; } = match Analyzer.compute_post (ProcData.make_default proc_desc tenv) with | Some post -> (* I am printing to commandline and out to cater to javac and buck*) (L.stdout "\n Procedure: %s@ " - (Procname.to_string (Cfg.Procdesc.get_proc_name proc_desc) ) + (Procname.to_string (Procdesc.get_proc_name proc_desc) ) ); L.stdout "\n POST: %a\n" CombinedDomain.pp post; (L.out "\n Procedure: %s@ " - (Procname.to_string (Cfg.Procdesc.get_proc_name proc_desc) ) + (Procname.to_string (Procdesc.get_proc_name proc_desc) ) ); L.out "\n POST: %a\n" CombinedDomain.pp post | None -> () (* a results table is a Map where a key is an a procedure environment, - i.e., something of type Idenv.t * Tenv.t * Procname.t * Cfg.Procdesc.t + i.e., something of type Idenv.t * Tenv.t * Procname.t * Procdesc.t *) module ResultsTableType = Map.Make (struct - type t = Idenv.t * Tenv.t * Procname.t * Cfg.Procdesc.t + type t = Idenv.t * Tenv.t * Procname.t * Procdesc.t let compare (_, _, pn1, _) (_,_,pn2,_) = Procname.compare pn1 pn2 end) @@ -109,7 +109,7 @@ let should_analyze_proc (_,tenv,proc_name,proc_desc) = not (Procname.java_is_autogen_method proc_name) && not (Procname.is_constructor proc_name) && not (Procname.is_class_initializer proc_name) && - Cfg.Procdesc.get_access proc_desc <> PredSymb.Private + Procdesc.get_access proc_desc <> PredSymb.Private (* creates a map from proc_envs to postconditions *) let make_results_table file_env = @@ -162,7 +162,7 @@ let report_thread_safety_errors ( _, tenv, pname, pdesc) writestate = pname pdesc "CHECKERS_THREAD_SAFETY_WARNING" - (Cfg.Procdesc.get_loc pdesc) + (Procdesc.get_loc pdesc) description in IList.iter report_one_error (IList.map snd (PathDomain.elements writestate)) @@ -190,7 +190,7 @@ let should_analyze_file file_env = (*Gathers results by analyzing all the methods in a file, then post-processes the results to check (approximation of) thread safety *) -(* file_env: (Idenv.t * Tenv.t * Procname.t * Cfg.Procdesc.t) list *) +(* file_env: (Idenv.t * Tenv.t * Procname.t * Procdesc.t) list *) let file_analysis _ _ _ file_env = if should_analyze_file file_env then process_results_table diff --git a/infer/src/checkers/abstractInterpreter.ml b/infer/src/checkers/abstractInterpreter.ml index 456ff3af3..d61cce828 100644 --- a/infer/src/checkers/abstractInterpreter.ml +++ b/infer/src/checkers/abstractInterpreter.ml @@ -135,7 +135,7 @@ module MakeNoCFG let analyze_ondemand_ _ pdesc = match compute_post (ProcData.make pdesc tenv extras) with | Some post -> - Summ.write_summary (Cfg.Procdesc.get_proc_name pdesc) post; + Summ.write_summary (Procdesc.get_proc_name pdesc) post; Some post | None -> None in diff --git a/infer/src/checkers/annotationReachability.ml b/infer/src/checkers/annotationReachability.ml index f49c2ea4e..58c1321cf 100644 --- a/infer/src/checkers/annotationReachability.ml +++ b/infer/src/checkers/annotationReachability.ml @@ -323,7 +323,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct when is_unlikely callee_pname -> Domain.add_tracking_var (Var.of_id id) astate | Sil.Call (_, Const (Cfun callee_pname), _, call_loc, _) -> - let caller_pname = Cfg.Procdesc.get_proc_name pdesc in + let caller_pname = Procdesc.get_proc_name pdesc in let call_site = CallSite.make callee_pname call_loc in begin (* Runs the analysis of callee_pname if not already analyzed *) @@ -368,7 +368,7 @@ module Interprocedural = struct is_modeled_expensive tenv pname || is_expensive tenv pname let check_and_report ({ Callbacks.proc_desc; proc_name; tenv; } as proc_data) = - let loc = Cfg.Procdesc.get_loc proc_desc in + let loc = Procdesc.get_loc proc_desc in let expensive = is_expensive tenv proc_name in (* TODO: generalize so we can check subtyping on arbitrary annotations *) let check_expensive_subtyping_rules overridden_pname = diff --git a/infer/src/checkers/annotations.ml b/infer/src/checkers/annotations.ml index f88d5fed8..c82af98c7 100644 --- a/infer/src/checkers/annotations.ml +++ b/infer/src/checkers/annotations.ml @@ -92,7 +92,7 @@ let ma_contains ma ann_names = !found let pdesc_has_annot pdesc annot = - ma_contains (Cfg.Procdesc.get_attributes pdesc).ProcAttributes.method_annotation [annot] + ma_contains (Procdesc.get_attributes pdesc).ProcAttributes.method_annotation [annot] let initializer_ = "Initializer" let inject = "Inject" diff --git a/infer/src/checkers/annotations.mli b/infer/src/checkers/annotations.mli index ffc4a0dad..1d033dac0 100644 --- a/infer/src/checkers/annotations.mli +++ b/infer/src/checkers/annotations.mli @@ -101,7 +101,7 @@ val ia_iter : (Annot.t -> unit) -> Annot.Item.t -> unit val ma_has_annotation_with : Annot.Method.t -> (Annot.t -> bool) -> bool -val pdesc_has_annot : Cfg.Procdesc.t -> string -> bool +val pdesc_has_annot : Procdesc.t -> string -> bool (** Mark the return of the method_annotation with the given annotation. *) val method_annotation_mark_return : diff --git a/infer/src/checkers/checkDeadCode.ml b/infer/src/checkers/checkDeadCode.ml index 5831db5e8..f4900fb94 100644 --- a/infer/src/checkers/checkDeadCode.ml +++ b/infer/src/checkers/checkDeadCode.ml @@ -20,25 +20,25 @@ let verbose = false module State = struct type t = { - visited : Cfg.NodeSet.t; + visited : Procdesc.NodeSet.t; } let initial = { - visited = Cfg.NodeSet.empty; + visited = Procdesc.NodeSet.empty; } let equal t1 t2 = - Cfg.NodeSet.equal t1.visited t2.visited + Procdesc.NodeSet.equal t1.visited t2.visited let join t1 t2 = { - visited = Cfg.NodeSet.union t1.visited t2.visited + visited = Procdesc.NodeSet.union t1.visited t2.visited } let add_visited node t = { - visited = Cfg.NodeSet.add node t.visited; + visited = Procdesc.NodeSet.add node t.visited; } let get_visited t = @@ -46,16 +46,16 @@ module State = struct let pp fmt t = F.fprintf fmt "visited: %a" - (pp_seq Cfg.Node.pp) (Cfg.NodeSet.elements t.visited) + (pp_seq Procdesc.Node.pp) (Procdesc.NodeSet.elements t.visited) let num_visited t = - Cfg.NodeSet.cardinal t.visited + Procdesc.NodeSet.cardinal t.visited end let do_node _ node (s : State.t) : (State.t list) * (State.t list) = let s' = State.add_visited node s in if verbose then L.stderr " N:%a (#visited: %a)@." - Cfg.Node.pp node + Procdesc.Node.pp node State.pp s'; [s'], [s'] @@ -68,20 +68,22 @@ let report_error tenv description pn pd loc = (** Check the final state at the end of the analysis. *) let check_final_state tenv proc_name proc_desc final_s = - let proc_nodes = Cfg.Procdesc.get_nodes proc_desc in + let proc_nodes = Procdesc.get_nodes proc_desc in let tot_nodes = IList.length proc_nodes in let tot_visited = State.num_visited final_s in if verbose then L.stderr "TOT nodes: %d (visited: %n)@." tot_nodes tot_visited; if tot_nodes <> tot_visited then begin let not_visited = - IList.filter (fun n -> not (Cfg.NodeSet.mem n (State.get_visited final_s))) proc_nodes in + IList.filter + (fun n -> not (Procdesc.NodeSet.mem n (State.get_visited final_s))) + proc_nodes in let do_node n = - let loc = Cfg.Node.get_loc n in - let description = Format.sprintf "Node not visited: %d" (Cfg.Node.get_id n :> int) in - let report = match Cfg.Node.get_kind n with - | Cfg.Node.Join_node -> false - | k when k = Cfg.Node.exn_sink_kind -> false + let loc = Procdesc.Node.get_loc n in + let description = Format.sprintf "Node not visited: %d" (Procdesc.Node.get_id n :> int) in + let report = match Procdesc.Node.get_kind n with + | Procdesc.Node.Join_node -> false + | k when k = Procdesc.Node.exn_sink_kind -> false | _ -> true in if report then report_error tenv description proc_name proc_desc loc in @@ -103,7 +105,7 @@ let callback_check_dead_code { Callbacks.proc_desc; proc_name; tenv } = begin if verbose then L.stderr "@.--@.PROC: %a@." Procname.pp proc_name; let transitions = DFDead.run tenv proc_desc State.initial in - let exit_node = Cfg.Procdesc.get_exit_node proc_desc in + let exit_node = Procdesc.get_exit_node proc_desc in match transitions exit_node with | DFDead.Transition (pre_final_s, _, _) -> let final_s = State.add_visited exit_node pre_final_s in diff --git a/infer/src/checkers/checkTraceCallSequence.ml b/infer/src/checkers/checkTraceCallSequence.ml index 7234f6e72..f48456923 100644 --- a/infer/src/checkers/checkTraceCallSequence.ml +++ b/infer/src/checkers/checkTraceCallSequence.ml @@ -220,7 +220,7 @@ module Automaton = struct if not (State.is_balanced s) then begin let description = Printf.sprintf "%d missing end/stop" (Elem.get_int (State.max s)) in - let loc = Cfg.Node.get_loc exit_node in + let loc = Procdesc.Node.get_loc exit_node in report_warning tenv description pn pd loc end @@ -303,7 +303,7 @@ end (** State transformation for a cfg node. *) let do_node tenv pn pd idenv _ node (s : State.t) : (State.t list) * (State.t list) = - if verbose then L.stderr "N:%d S:%s@." (Cfg.Node.get_id node :> int) (State.to_string s); + if verbose then L.stderr "N:%d S:%s@." (Procdesc.Node.get_id node :> int) (State.to_string s); let curr_state = ref s in @@ -312,7 +312,7 @@ let do_node tenv pn pd idenv _ node (s : State.t) : (State.t list) * (State.t li let state2 = BooleanVars.do_instr pn pd idenv instr state1 in curr_state := state2 in - IList.iter do_instr (Cfg.Node.get_instrs node); + IList.iter do_instr (Procdesc.Node.get_instrs node); [!curr_state], [!curr_state] (** Check the final state at the end of the analysis. *) @@ -340,7 +340,7 @@ let callback_check_trace_call_sequence { Callbacks.proc_desc; proc_name; idenv; begin if verbose then L.stderr "@.--@.PROC: %a@." Procname.pp proc_name; let transitions = DFTrace.run tenv proc_desc State.balanced in - let exit_node = Cfg.Procdesc.get_exit_node proc_desc in + let exit_node = Procdesc.get_exit_node proc_desc in match transitions exit_node with | DFTrace.Transition (final_s, _, _) -> check_final_state tenv proc_name proc_desc exit_node final_s diff --git a/infer/src/checkers/checkers.ml b/infer/src/checkers/checkers.ml index b095aef88..3ca747eaf 100644 --- a/infer/src/checkers/checkers.ml +++ b/infer/src/checkers/checkers.ml @@ -160,7 +160,7 @@ module ST = struct end let report_calls_and_accesses tenv callback proc_desc instr = - let proc_name = Cfg.Procdesc.get_proc_name proc_desc in + let proc_name = Procdesc.get_proc_name proc_desc in let callee = Procname.to_string proc_name in match PatternMatch.get_java_field_access_signature instr with | Some (bt, fn, ft) -> @@ -168,7 +168,7 @@ let report_calls_and_accesses tenv callback proc_desc instr = proc_name proc_desc (callback ^ "_CALLBACK") - (Cfg.Procdesc.get_loc proc_desc) + (Procdesc.get_loc proc_desc) (Format.sprintf "field access %s.%s:%s in %s@." bt fn ft callee) | None -> match PatternMatch.get_java_method_call_formal_signature instr with @@ -177,13 +177,13 @@ let report_calls_and_accesses tenv callback proc_desc instr = proc_name proc_desc (callback ^ "_CALLBACK") - (Cfg.Procdesc.get_loc proc_desc) + (Procdesc.get_loc proc_desc) (Format.sprintf "method call %s.%s(%s):%s in %s@." bt fn "..." rt callee) | None -> () (** Report all field accesses and method calls of a procedure. *) let callback_check_access { Callbacks.tenv; proc_desc } = - Cfg.Procdesc.iter_instrs + Procdesc.iter_instrs (fun _ instr -> report_calls_and_accesses tenv "PROC" proc_desc instr) proc_desc @@ -193,7 +193,7 @@ let callback_check_cluster_access exe_env all_procs get_proc_desc _ = match get_proc_desc proc_name with | Some proc_desc -> let tenv = Exe_env.get_tenv exe_env proc_name in - Cfg.Procdesc.iter_instrs + Procdesc.iter_instrs (fun _ instr -> report_calls_and_accesses tenv "CLUSTER" proc_desc instr) proc_desc | _ -> @@ -235,7 +235,7 @@ let callback_check_write_to_parcel_java let check r_desc w_desc = let is_serialization_node node = - match Cfg.Node.get_callees node with + match Procdesc.Node.get_callees node with | [] -> false | [Procname.Java pname_java] -> let class_name = Procname.java_get_class_name pname_java in @@ -261,18 +261,18 @@ let callback_check_write_to_parcel_java false in let node_to_call_desc node = - match Cfg.Node.get_callees node with + match Procdesc.Node.get_callees node with | [desc] -> desc | _ -> assert false in let r_call_descs = IList.map node_to_call_desc (IList.filter is_serialization_node - (Cfg.Procdesc.get_sliced_slope r_desc is_serialization_node)) in + (Procdesc.get_sliced_slope r_desc is_serialization_node)) in let w_call_descs = IList.map node_to_call_desc (IList.filter is_serialization_node - (Cfg.Procdesc.get_sliced_slope w_desc is_serialization_node)) in + (Procdesc.get_sliced_slope w_desc is_serialization_node)) in let rec check_match = function | rc:: rcs, wc:: wcs -> @@ -314,7 +314,7 @@ let callback_check_write_to_parcel_java if !verbose then L.stdout "Methods not available@." end | _ -> () in - Cfg.Procdesc.iter_instrs do_instr proc_desc + Procdesc.iter_instrs do_instr proc_desc (** Looks for writeToParcel methods and checks whether read is in reverse *) let callback_check_write_to_parcel ({ Callbacks.proc_name } as args) = @@ -329,7 +329,7 @@ let callback_monitor_nullcheck { Callbacks.proc_desc; idenv; proc_name } = let verbose = ref false in let class_formal_names = lazy ( - let formals = Cfg.Procdesc.get_formals proc_desc in + let formals = Procdesc.get_formals proc_desc in let class_formals = let is_class_type (p, typ) = match typ with @@ -375,7 +375,7 @@ let callback_monitor_nullcheck { Callbacks.proc_desc; idenv; proc_name } = let was_not_found formal_name = not (Exp.Set.exists (fun exp -> equal_formal_param exp formal_name) !checks_to_formals) in let missing = IList.filter was_not_found formal_names in - let loc = Cfg.Procdesc.get_loc proc_desc in + let loc = Procdesc.get_loc proc_desc in let pp_file_loc fmt () = F.fprintf fmt "%s:%d" (DB.source_file_to_string loc.Location.file) loc.Location.line in L.stdout "Null Checks of Formal Parameters: "; @@ -401,7 +401,7 @@ let callback_monitor_nullcheck { Callbacks.proc_desc; idenv; proc_name } = | _ -> ()) | _ -> () in - Cfg.Procdesc.iter_instrs do_instr proc_desc; + Procdesc.iter_instrs do_instr proc_desc; summary_checks_of_formals () (** Test persistent state. *) @@ -412,7 +412,7 @@ let callback_test_state { Callbacks.proc_name } = let callback_checkVisibleForTesting { Callbacks.proc_desc } = if Annotations.pdesc_has_annot proc_desc Annotations.visibleForTesting then begin - let loc = Cfg.Procdesc.get_loc proc_desc in + let loc = Procdesc.get_loc proc_desc in let linereader = Printer.LineReader.create () in L.stdout "%a@." (PP.pp_loc_range linereader 10 10) loc end @@ -426,10 +426,15 @@ let callback_find_deserialization { Callbacks.proc_desc; get_proc_desc; idenv; p let reverse_find_instr f node = (* this is not really sound but for the moment a sufficient approximation *) let has_instr node = - try ignore(IList.find f (Cfg.Node.get_instrs node)); true + try ignore(IList.find f (Procdesc.Node.get_instrs node)); true with Not_found -> false in - let preds = Cfg.Node.get_generated_slope node (fun n -> Cfg.Node.get_sliced_preds n has_instr) in - let instrs = IList.flatten (IList.map (fun n -> IList.rev (Cfg.Node.get_instrs n)) preds) in + let preds = + Procdesc.Node.get_generated_slope + node + (fun n -> Procdesc.Node.get_sliced_preds n has_instr) in + let instrs = + IList.flatten + (IList.map (fun n -> IList.rev (Procdesc.Node.get_instrs n)) preds) in try Some (IList.find f instrs) with Not_found -> None in @@ -442,9 +447,9 @@ let callback_find_deserialization { Callbacks.proc_desc; get_proc_desc; idenv; p Some proc_desc' -> let is_return_instr = function | Sil.Store (Exp.Lvar p, _, _, _) - when Pvar.equal p (Cfg.Procdesc.get_ret_var proc_desc') -> true + when Pvar.equal p (Procdesc.get_ret_var proc_desc') -> true | _ -> false in - (match reverse_find_instr is_return_instr (Cfg.Procdesc.get_exit_node proc_desc') with + (match reverse_find_instr is_return_instr (Procdesc.get_exit_node proc_desc') with | Some (Sil.Store (_, _, Exp.Const (Const.Cclass n), _)) -> Ident.name_to_string n | _ -> "<" ^ (Procname.to_string proc_name') ^ ">") | None -> "?" in @@ -509,7 +514,7 @@ let callback_find_deserialization { Callbacks.proc_desc; get_proc_desc; idenv; p ST.pname_add proc_name ret_const_key ret_const in store_return (); - Cfg.Procdesc.iter_instrs do_instr proc_desc + Procdesc.iter_instrs do_instr proc_desc (** Check field accesses. *) let callback_check_field_access { Callbacks.proc_desc } = @@ -552,7 +557,7 @@ let callback_check_field_access { Callbacks.proc_desc } = | Sil.Remove_temps _ | Sil.Declare_locals _ -> () in - Cfg.Procdesc.iter_instrs do_instr proc_desc + Procdesc.iter_instrs do_instr proc_desc (** Print c method calls. *) let callback_print_c_method_calls { Callbacks.tenv; proc_desc; proc_name } = @@ -580,7 +585,7 @@ let callback_print_c_method_calls { Callbacks.tenv; proc_desc; proc_name } = loc description | _ -> () in - Cfg.Procdesc.iter_instrs do_instr proc_desc + Procdesc.iter_instrs do_instr proc_desc (** Print access to globals. *) let callback_print_access_to_globals { Callbacks.tenv; proc_desc; proc_name } = @@ -608,4 +613,4 @@ let callback_print_access_to_globals { Callbacks.tenv; proc_desc; proc_name } = | Sil.Store (e, _, _, loc) when get_global_var e <> None -> Option.may (fun pvar -> do_pvar false pvar loc) (get_global_var e) | _ -> () in - Cfg.Procdesc.iter_instrs do_instr proc_desc + Procdesc.iter_instrs do_instr proc_desc diff --git a/infer/src/checkers/checkers.mli b/infer/src/checkers/checkers.mli index e6e008ff0..edd414c41 100644 --- a/infer/src/checkers/checkers.mli +++ b/infer/src/checkers/checkers.mli @@ -24,7 +24,7 @@ module ST : sig val report_error: Tenv.t -> Procname.t -> - Cfg.Procdesc.t -> + Procdesc.t -> string -> Location.t -> ?advice: string option -> diff --git a/infer/src/checkers/constantPropagation.ml b/infer/src/checkers/constantPropagation.ml index fd2b83754..864119a46 100644 --- a/infer/src/checkers/constantPropagation.ml +++ b/infer/src/checkers/constantPropagation.ml @@ -113,17 +113,17 @@ module ConstantFlow = Dataflow.MakeDF(struct if verbose then begin - L.stdout "Node %i:" (Cfg.Node.get_id node :> int); + L.stdout "Node %i:" (Procdesc.Node.get_id node :> int); L.stdout "%a" pp constants; IList.iter (fun instr -> L.stdout "%a@." (Sil.pp_instr pe_text) instr) - (Cfg.Node.get_instrs node) + (Procdesc.Node.get_instrs node) end; let constants = IList.fold_left do_instr constants - (Cfg.Node.get_instrs node) in + (Procdesc.Node.get_instrs node) in if verbose then L.stdout "%a\n@." pp constants; [constants], [constants] end) @@ -136,7 +136,7 @@ let run tenv proc_desc = | ConstantFlow.Dead_state -> ConstantMap.empty in get_constants -type const_map = Cfg.Node.t -> Exp.t -> Const.t option +type const_map = Procdesc.Node.t -> Exp.t -> Const.t option (** Build a const map lazily. *) let build_const_map tenv pdesc = diff --git a/infer/src/checkers/constantPropagation.mli b/infer/src/checkers/constantPropagation.mli index 04cdb7348..7d68632b3 100644 --- a/infer/src/checkers/constantPropagation.mli +++ b/infer/src/checkers/constantPropagation.mli @@ -9,7 +9,7 @@ open! Utils -type const_map = Cfg.Node.t -> Exp.t -> Const.t option +type const_map = Procdesc.Node.t -> Exp.t -> Const.t option (** Build a const map lazily. *) -val build_const_map : Tenv.t -> Cfg.Procdesc.t -> const_map +val build_const_map : Tenv.t -> Procdesc.t -> const_map diff --git a/infer/src/checkers/dataflow.ml b/infer/src/checkers/dataflow.ml index f6c9d4037..169875589 100644 --- a/infer/src/checkers/dataflow.ml +++ b/infer/src/checkers/dataflow.ml @@ -28,7 +28,7 @@ module type DFStateType = sig val join : t -> t -> t (** Perform a state transition on a node. *) - val do_node : Tenv.t -> Cfg.Node.t -> t -> (t list) * (t list) + val do_node : Tenv.t -> Procdesc.Node.t -> t -> (t list) * (t list) (** Can proc throw an exception? *) val proc_throws : Procname.t -> throws @@ -43,14 +43,14 @@ module type DF = sig | Transition of state * state list * state list val join : state list -> state -> state - val run : Tenv.t -> Cfg.Procdesc.t -> state -> (Cfg.Node.t -> transition) + val run : Tenv.t -> Procdesc.t -> state -> (Procdesc.Node.t -> transition) end (** Determine if the node can throw an exception. *) let node_throws pdesc node (proc_throws : Procname.t -> throws) : throws = let instr_throws instr = let is_return pvar = - let ret_pvar = Cfg.Procdesc.get_ret_var pdesc in + let ret_pvar = Procdesc.get_ret_var pdesc in Pvar.equal pvar ret_pvar in match instr with | Sil.Store (Exp.Lvar pvar, _, Exp.Exn _, _) when is_return pvar -> @@ -75,14 +75,14 @@ let node_throws pdesc node (proc_throws : Procname.t -> throws) : throws = | t, DoesNotThrow -> res := t in let do_instr instr = update_res (instr_throws instr) in - IList.iter do_instr (Cfg.Node.get_instrs node); + IList.iter do_instr (Procdesc.Node.get_instrs node); !res (** Create an instance of the dataflow algorithm given a state parameter. *) module MakeDF(St: DFStateType) : DF with type state = St.t = struct - module S = Cfg.NodeSet - module H = Cfg.NodeHash - module N = Cfg.Node + module S = Procdesc.NodeSet + module H = Procdesc.NodeHash + module N = Procdesc.Node type worklist = S.t type statemap = St.t H.t @@ -92,7 +92,7 @@ module MakeDF(St: DFStateType) : DF with type state = St.t = struct pre_states : statemap; post_states : statelistmap; exn_states : statelistmap; - proc_desc : Cfg.Procdesc.t + proc_desc : Procdesc.t } type state = St.t type transition = @@ -118,8 +118,8 @@ module MakeDF(St: DFStateType) : DF with type state = St.t = struct push_state dest_joined with Not_found -> push_state new_state in - let succ_nodes = Cfg.Node.get_succs node in - let exn_nodes = Cfg.Node.get_exn node in + let succ_nodes = Procdesc.Node.get_succs node in + let exn_nodes = Procdesc.Node.get_exn node in if throws <> Throws then IList.iter (fun s -> IList.iter (propagate_to_dest s) succ_nodes) @@ -136,7 +136,7 @@ module MakeDF(St: DFStateType) : DF with type state = St.t = struct let run tenv proc_desc state = let t = - let start_node = Cfg.Procdesc.get_start_node proc_desc in + let start_node = Procdesc.get_start_node proc_desc in let init_set = S.singleton start_node in let init_statemap = let m = H.create 1 in @@ -178,7 +178,7 @@ let callback_test_dataflow { Callbacks.proc_desc; tenv } = let equal = int_equal let join n m = if n = 0 then m else n let do_node _ n s = - if verbose then L.stdout "visiting node %a with state %d@." Cfg.Node.pp n s; + if verbose then L.stdout "visiting node %a with state %d@." Procdesc.Node.pp n s; [s + 1], [s + 1] let proc_throws _ = DoesNotThrow end) in @@ -187,4 +187,4 @@ let callback_test_dataflow { Callbacks.proc_desc; tenv } = match transitions node with | DFCount.Transition _ -> () | DFCount.Dead_state -> () in - IList.iter do_node (Cfg.Procdesc.get_nodes proc_desc) + IList.iter do_node (Procdesc.get_nodes proc_desc) diff --git a/infer/src/checkers/dataflow.mli b/infer/src/checkers/dataflow.mli index 836634c4f..469825585 100644 --- a/infer/src/checkers/dataflow.mli +++ b/infer/src/checkers/dataflow.mli @@ -26,7 +26,7 @@ module type DFStateType = sig val join : t -> t -> t (** Perform a state transition on a node. *) - val do_node : Tenv.t -> Cfg.Node.t -> t -> (t list) * (t list) + val do_node : Tenv.t -> Procdesc.Node.t -> t -> (t list) * (t list) (** Can proc throw an exception? *) val proc_throws : Procname.t -> throws @@ -43,7 +43,7 @@ module type DF = sig (** Run the dataflow analysis on a procedure starting from the given state. Returns a function to lookup the results of the analysis on every node *) - val run : Tenv.t -> Cfg.Procdesc.t -> state -> (Cfg.Node.t -> transition) + val run : Tenv.t -> Procdesc.t -> state -> (Procdesc.Node.t -> transition) end (** Functor to create an instance of a dataflow analysis. *) diff --git a/infer/src/checkers/fragmentRetainsViewChecker.ml b/infer/src/checkers/fragmentRetainsViewChecker.ml index 047917786..55c77f8fa 100644 --- a/infer/src/checkers/fragmentRetainsViewChecker.ml +++ b/infer/src/checkers/fragmentRetainsViewChecker.ml @@ -17,7 +17,7 @@ let report_error fragment_typ fld fld_typ pname pdesc = let retained_view = "CHECKERS_FRAGMENT_RETAINS_VIEW" in let description = Localise.desc_fragment_retains_view fragment_typ fld fld_typ pname in let exn = Exceptions.Checkers (retained_view, description) in - let loc = Cfg.Procdesc.get_loc pdesc in + let loc = Procdesc.get_loc pdesc in Reporting.log_error pname ~loc exn let callback_fragment_retains_view_java diff --git a/infer/src/checkers/idenv.ml b/infer/src/checkers/idenv.ml index 66b901b66..7160a4c0c 100644 --- a/infer/src/checkers/idenv.ml +++ b/infer/src/checkers/idenv.ml @@ -21,7 +21,7 @@ let create_ proc_desc = | Sil.Load (id, e, _, _) -> Ident.IdentHash.add map id e | _ -> () in - Cfg.Procdesc.iter_instrs do_instr proc_desc; + Procdesc.iter_instrs do_instr proc_desc; map (* lazy implementation, only create when used *) diff --git a/infer/src/checkers/idenv.mli b/infer/src/checkers/idenv.mli index 55ee9f41d..44a2d528e 100644 --- a/infer/src/checkers/idenv.mli +++ b/infer/src/checkers/idenv.mli @@ -15,12 +15,12 @@ open! Utils type t -val create : Cfg.Procdesc.t -> t -val create_from_idenv : t -> Cfg.Procdesc.t -> t +val create : Procdesc.t -> t +val create_from_idenv : t -> Procdesc.t -> t val lookup : t -> Ident.t -> Exp.t option val expand_expr : t -> Exp.t -> Exp.t val exp_is_temp : t -> Exp.t -> bool (** Stronger version of expand_expr which also expands a temporary variable. *) -val expand_expr_temps : t -> Cfg.Node.t -> Exp.t -> Exp.t +val expand_expr_temps : t -> Procdesc.Node.t -> Exp.t -> Exp.t diff --git a/infer/src/checkers/patternMatch.ml b/infer/src/checkers/patternMatch.ml index 33bda63bb..8a17885c7 100644 --- a/infer/src/checkers/patternMatch.ml +++ b/infer/src/checkers/patternMatch.ml @@ -140,7 +140,7 @@ let java_get_const_type_name | _ -> "_" let get_vararg_type_names tenv - (call_node: Cfg.Node.t) + (call_node: Procdesc.Node.t) (ivar: Pvar.t): string list = (* Is this the node creating ivar? *) let rec initializes_array instrs = @@ -167,7 +167,7 @@ let get_vararg_type_names tenv let rec added_nvar array_nvar instrs = match instrs with | Sil.Store (Exp.Lindex (Exp.Var iv, _), _, Exp.Var nvar, _):: _ - when Ident.equal iv array_nvar -> nvar_type_name nvar (Cfg.Node.get_instrs node) + when Ident.equal iv array_nvar -> nvar_type_name nvar (Procdesc.Node.get_instrs node) | Sil.Store (Exp.Lindex (Exp.Var iv, _), _, Exp.Const c, _):: _ when Ident.equal iv array_nvar -> Some (java_get_const_type_name c) | _:: is -> added_nvar array_nvar is @@ -179,14 +179,14 @@ let get_vararg_type_names tenv added_nvar nv instrs | _:: is -> array_nvar is | _ -> None in - array_nvar (Cfg.Node.get_instrs node) in + array_nvar (Procdesc.Node.get_instrs node) in (* Walk nodes backward until definition of ivar, adding type names *) let rec type_names node = - if initializes_array (Cfg.Node.get_instrs node) then + if initializes_array (Procdesc.Node.get_instrs node) then [] else - match (Cfg.Node.get_preds node) with + match (Procdesc.Node.get_preds node) with | [n] -> (match (added_type_name node) with | Some name -> name:: type_names n | None -> type_names n) @@ -195,7 +195,7 @@ let get_vararg_type_names tenv IList.rev (type_names call_node) let has_formal_proc_argument_type_names proc_desc argument_type_names = - let formals = Cfg.Procdesc.get_formals proc_desc in + let formals = Procdesc.get_formals proc_desc in let equal_formal_arg (_, typ) arg_type_name = get_type_name typ = arg_type_name in IList.length formals = IList.length argument_type_names && IList.for_all2 equal_formal_arg formals argument_type_names @@ -290,10 +290,10 @@ let java_get_vararg_values node pvar idenv = values := content_exp :: !values | _ -> () in let do_node n = - IList.iter do_instr (Cfg.Node.get_instrs n) in + IList.iter do_instr (Procdesc.Node.get_instrs n) in let () = match Errdesc.find_program_variable_assignment node pvar with | Some (node', _) -> - Cfg.Procdesc.iter_slope_range do_node node' node + Procdesc.iter_slope_range do_node node' node | None -> () in !values @@ -310,9 +310,9 @@ let proc_calls resolve_attributes pdesc filter : (Procname.t * ProcAttributes.t) end | _ -> () in let do_node node = - let instrs = Cfg.Node.get_instrs node in + let instrs = Procdesc.Node.get_instrs node in IList.iter (do_instruction node) instrs in - let nodes = Cfg.Procdesc.get_nodes pdesc in + let nodes = Procdesc.get_nodes pdesc in IList.iter do_node nodes; IList.rev !res @@ -355,7 +355,7 @@ let get_fields_nullified procdesc = (nullified_flds, Ident.IdentSet.add id this_ids) | _ -> (nullified_flds, this_ids) in let (nullified_flds, _) = - Cfg.Procdesc.fold_instrs + Procdesc.fold_instrs collect_nullified_flds (Ident.FieldSet.empty, Ident.IdentSet.empty) procdesc in nullified_flds diff --git a/infer/src/checkers/patternMatch.mli b/infer/src/checkers/patternMatch.mli index 162ca89c6..ef5e65e17 100644 --- a/infer/src/checkers/patternMatch.mli +++ b/infer/src/checkers/patternMatch.mli @@ -36,10 +36,10 @@ val get_this_type : ProcAttributes.t -> Typ.t option val get_type_name : Typ.t -> string (** Get the type names of a variable argument *) -val get_vararg_type_names : Tenv.t -> Cfg.Node.t -> Pvar.t -> string list +val get_vararg_type_names : Tenv.t -> Procdesc.Node.t -> Pvar.t -> string list val has_formal_method_argument_type_names : - Cfg.Procdesc.t -> Procname.java -> string list -> bool + Procdesc.t -> Procname.java -> string list -> bool (** Check if the method is one of the known initializer methods. *) val method_is_initializer : Tenv.t -> ProcAttributes.t -> bool @@ -66,14 +66,14 @@ val supertype_exists : Tenv.t -> (Typename.t -> StructTyp.t -> bool) -> Typename val java_get_const_type_name : Const.t -> string (** Get the values of a vararg parameter given the pvar used to assign the elements. *) -val java_get_vararg_values : Cfg.Node.t -> Pvar.t -> Idenv.t -> Exp.t list +val java_get_vararg_values : Procdesc.Node.t -> Pvar.t -> Idenv.t -> Exp.t list val java_proc_name_with_class_method : Procname.java -> string -> string -> bool (** Return the callees that satisfy [filter]. *) val proc_calls : (Procname.t -> ProcAttributes.t option) -> - Cfg.Procdesc.t -> + Procdesc.t -> (Procname.t -> ProcAttributes.t -> bool) -> (Procname.t * ProcAttributes.t) list @@ -99,7 +99,7 @@ val type_is_nested_in_direct_supertype : Tenv.t -> Typ.t -> Typename.t -> bool val type_is_object : Typ.t -> bool (** return the set of instance fields that are assigned to a null literal in [procdesc] *) -val get_fields_nullified : Cfg.Procdesc.t -> Ident.FieldSet.t +val get_fields_nullified : Procdesc.t -> Ident.FieldSet.t (** [is_exception tenv class_name] checks if class_name is of type java.lang.Exception *) val is_exception : Tenv.t -> Typename.t -> bool diff --git a/infer/src/checkers/printfArgs.ml b/infer/src/checkers/printfArgs.ml index a4fd372bc..3853699e6 100644 --- a/infer/src/checkers/printfArgs.ml +++ b/infer/src/checkers/printfArgs.ml @@ -115,10 +115,10 @@ let rec format_string_type_names let printf_args_name = "CHECKERS_PRINTF_ARGS" let check_printf_args_ok tenv - (node: Cfg.Node.t) + (node: Procdesc.Node.t) (instr: Sil.instr) (proc_name: Procname.t) - (proc_desc: Cfg.Procdesc.t): unit = + (proc_desc: Procdesc.t): unit = (* Check if format string lines up with arguments *) let rec check_type_names instr_loc n_arg instr_proc_name fmt_type_names arg_type_names = @@ -180,7 +180,7 @@ let check_printf_args_ok tenv | Some printf -> ( try let fmt, fixed_nvars, array_nvar = format_arguments printf args in - let instrs = Cfg.Node.get_instrs node in + let instrs = Procdesc.Node.get_instrs node in let fixed_nvar_type_names = IList.map (fixed_nvar_type_name instrs) fixed_nvars in let vararg_ivar_type_names = match array_nvar with | Some nvar -> ( @@ -212,7 +212,7 @@ let check_printf_args_ok tenv | _ -> () let callback_printf_args { Callbacks.tenv; proc_desc; proc_name } : unit = - Cfg.Procdesc.iter_instrs (fun n i -> check_printf_args_ok tenv n i proc_name proc_desc) proc_desc + Procdesc.iter_instrs (fun n i -> check_printf_args_ok tenv n i proc_name proc_desc) proc_desc (* let printf_signature_to_string diff --git a/infer/src/checkers/printfArgs.mli b/infer/src/checkers/printfArgs.mli index 35edb41f6..0b355d5cd 100644 --- a/infer/src/checkers/printfArgs.mli +++ b/infer/src/checkers/printfArgs.mli @@ -19,6 +19,7 @@ type printf_signature = { val add_printf_like_function : printf_signature -> unit -val check_printf_args_ok : Tenv.t -> Cfg.Node.t -> Sil.instr -> Procname.t -> Cfg.Procdesc.t -> unit +val check_printf_args_ok : + Tenv.t -> Procdesc.Node.t -> Sil.instr -> Procname.t -> Procdesc.t -> unit val callback_printf_args: Callbacks.proc_callback_t diff --git a/infer/src/checkers/procCfg.ml b/infer/src/checkers/procCfg.ml index c6b6d106e..6b08055ad 100644 --- a/infer/src/checkers/procCfg.ml +++ b/infer/src/checkers/procCfg.ml @@ -21,37 +21,37 @@ module type Node = sig type t type id - val kind : t -> Cfg.Node.nodekind + val kind : t -> Procdesc.Node.nodekind val id : t -> id val loc : t -> Location.t - val underlying_id : t -> Cfg.Node.id + val underlying_id : t -> Procdesc.Node.id val id_compare : id -> id -> int val pp_id : F.formatter -> id -> unit end module DefaultNode = struct - type t = Cfg.Node.t - type id = Cfg.Node.id + type t = Procdesc.Node.t + type id = Procdesc.Node.id - let kind = Cfg.Node.get_kind - let id = Cfg.Node.get_id - let loc = Cfg.Node.get_loc + let kind = Procdesc.Node.get_kind + let id = Procdesc.Node.get_id + let loc = Procdesc.Node.get_loc let underlying_id = id - let id_compare = Cfg.Node.id_compare - let pp_id = Cfg.Node.pp_id + let id_compare = Procdesc.Node.id_compare + let pp_id = Procdesc.Node.pp_id end module InstrNode = struct - type t = Cfg.Node.t - type id = Cfg.Node.id * index + type t = Procdesc.Node.t + type id = Procdesc.Node.id * index - let kind = Cfg.Node.get_kind + let kind = Procdesc.Node.get_kind - let underlying_id t = Cfg.Node.get_id t + let underlying_id t = Procdesc.Node.get_id t let id t = underlying_id t, Node_index - let loc t = Cfg.Node.get_loc t + let loc t = Procdesc.Node.get_loc t let index_compare index1 index2 = match index1, index2 with | Node_index, Node_index -> 0 @@ -60,13 +60,13 @@ module InstrNode = struct | Instr_index _, Node_index -> -1 let id_compare (id1, index1) (id2, index2) = - let n = Cfg.Node.id_compare id1 id2 in + let n = Procdesc.Node.id_compare id1 id2 in if n <> 0 then n else index_compare index1 index2 let pp_id fmt (id, index) = match index with - | Node_index -> Cfg.Node.pp_id fmt id - | Instr_index i -> F.fprintf fmt "(%a: %d)" Cfg.Node.pp_id id i + | Node_index -> Procdesc.Node.pp_id fmt id + | Instr_index i -> F.fprintf fmt "(%a: %d)" Procdesc.Node.pp_id id i end module type S = sig @@ -104,74 +104,74 @@ module type S = sig val exit_node : t -> node - val proc_desc : t -> Cfg.Procdesc.t + val proc_desc : t -> Procdesc.t val nodes : t -> node list - val from_pdesc : Cfg.Procdesc.t -> t + val from_pdesc : Procdesc.t -> t end (** Forward CFG with no exceptional control-flow *) module Normal = struct - type t = Cfg.Procdesc.t + type t = Procdesc.t type node = DefaultNode.t include (DefaultNode : module type of DefaultNode with type t := node) - let instrs = Cfg.Node.get_instrs + let instrs = Procdesc.Node.get_instrs let instr_ids n = IList.map (fun i -> i, None) (instrs n) - let normal_succs _ n = Cfg.Node.get_succs n - let normal_preds _ n = Cfg.Node.get_preds n + let normal_succs _ n = Procdesc.Node.get_succs n + let normal_preds _ n = Procdesc.Node.get_preds n (* prune away exceptional control flow *) let exceptional_succs _ _ = [] let exceptional_preds _ _ = [] let succs = normal_succs let preds = normal_preds - let start_node = Cfg.Procdesc.get_start_node - let exit_node = Cfg.Procdesc.get_exit_node + let start_node = Procdesc.get_start_node + let exit_node = Procdesc.get_exit_node let proc_desc t = t - let nodes = Cfg.Procdesc.get_nodes + let nodes = Procdesc.get_nodes let from_pdesc pdesc = pdesc end (** Forward CFG with exceptional control-flow *) module Exceptional = struct type node = DefaultNode.t - type id_node_map = node list Cfg.IdMap.t - type t = Cfg.Procdesc.t * id_node_map + type id_node_map = node list Procdesc.IdMap.t + type t = Procdesc.t * id_node_map include (DefaultNode : module type of DefaultNode with type t := node) let from_pdesc pdesc = (* map from a node to its exceptional predecessors *) let add_exn_preds exn_preds_acc n = let add_exn_pred exn_preds_acc exn_succ_node = - let exn_succ_node_id = Cfg.Node.get_id exn_succ_node in + let exn_succ_node_id = Procdesc.Node.get_id exn_succ_node in let existing_exn_preds = - try Cfg.IdMap.find exn_succ_node_id exn_preds_acc + try Procdesc.IdMap.find exn_succ_node_id exn_preds_acc with Not_found -> [] in - if not (IList.mem Cfg.Node.equal n existing_exn_preds) + if not (IList.mem Procdesc.Node.equal n existing_exn_preds) then (* don't add duplicates *) - Cfg.IdMap.add exn_succ_node_id (n :: existing_exn_preds) exn_preds_acc + Procdesc.IdMap.add exn_succ_node_id (n :: existing_exn_preds) exn_preds_acc else exn_preds_acc in - IList.fold_left add_exn_pred exn_preds_acc (Cfg.Node.get_exn n) in + IList.fold_left add_exn_pred exn_preds_acc (Procdesc.Node.get_exn n) in let exceptional_preds = - IList.fold_left add_exn_preds Cfg.IdMap.empty (Cfg.Procdesc.get_nodes pdesc) in + IList.fold_left add_exn_preds Procdesc.IdMap.empty (Procdesc.get_nodes pdesc) in pdesc, exceptional_preds - let instrs = Cfg.Node.get_instrs + let instrs = Procdesc.Node.get_instrs let instr_ids n = IList.map (fun i -> i, None) (instrs n) - let nodes (t, _) = Cfg.Procdesc.get_nodes t + let nodes (t, _) = Procdesc.get_nodes t - let normal_succs _ n = Cfg.Node.get_succs n + let normal_succs _ n = Procdesc.Node.get_succs n - let normal_preds _ n = Cfg.Node.get_preds n + let normal_preds _ n = Procdesc.Node.get_preds n - let exceptional_succs _ n = Cfg.Node.get_exn n + let exceptional_succs _ n = Procdesc.Node.get_exn n let exceptional_preds (_, exn_pred_map) n = - try Cfg.IdMap.find (Cfg.Node.get_id n) exn_pred_map + try Procdesc.IdMap.find (Procdesc.Node.get_id n) exn_pred_map with Not_found -> [] (** get all normal and exceptional successors of [n]. *) @@ -182,8 +182,8 @@ module Exceptional = struct normal_succs | exceptional_succs -> normal_succs @ exceptional_succs - |> IList.sort Cfg.Node.compare - |> IList.remove_duplicates Cfg.Node.compare + |> IList.sort Procdesc.Node.compare + |> IList.remove_duplicates Procdesc.Node.compare (** get all normal and exceptional predecessors of [n]. *) let preds t n = @@ -193,12 +193,12 @@ module Exceptional = struct normal_preds | exceptional_preds -> normal_preds @ exceptional_preds - |> IList.sort Cfg.Node.compare - |> IList.remove_duplicates Cfg.Node.compare + |> IList.sort Procdesc.Node.compare + |> IList.remove_duplicates Procdesc.Node.compare let proc_desc (pdesc, _) = pdesc - let start_node (pdesc, _) = Cfg.Procdesc.get_start_node pdesc - let exit_node (pdesc, _) = Cfg.Procdesc.get_exit_node pdesc + let start_node (pdesc, _) = Procdesc.get_start_node pdesc + let exit_node (pdesc, _) = Procdesc.get_exit_node pdesc end (** Wrapper that reverses the direction of the CFG *) @@ -217,9 +217,9 @@ module Backward (Base : S) = struct let exceptional_preds = Base.exceptional_succs end -module OneInstrPerNode (Base : S with type node = Cfg.Node.t - and type id = Cfg.Node.id) = struct - include (Base : module type of Base with type id := Cfg.Node.id and type t = Base.t) +module OneInstrPerNode (Base : S with type node = Procdesc.Node.t + and type id = Procdesc.Node.id) = struct + include (Base : module type of Base with type id := Procdesc.Node.id and type t = Base.t) type id = Base.id * index include (InstrNode : module type of InstrNode with type t := node and type id := id) @@ -227,7 +227,7 @@ module OneInstrPerNode (Base : S with type node = Cfg.Node.t let instr_ids t = IList.mapi (fun i instr -> - let id = Cfg.Node.get_id t, Instr_index i in + let id = Procdesc.Node.get_id t, Instr_index i in instr, Some id) (instrs t) end diff --git a/infer/src/checkers/procCfg.mli b/infer/src/checkers/procCfg.mli index e373056da..b1544e7ef 100644 --- a/infer/src/checkers/procCfg.mli +++ b/infer/src/checkers/procCfg.mli @@ -17,10 +17,10 @@ module type Node = sig type t type id - val kind : t -> Cfg.Node.nodekind + val kind : t -> Procdesc.Node.nodekind val id : t -> id val loc : t -> Location.t - val underlying_id : t -> Cfg.Node.id + val underlying_id : t -> Procdesc.Node.id val id_compare : id -> id -> int val pp_id : Format.formatter -> id -> unit end @@ -60,24 +60,24 @@ module type S = sig val exit_node : t -> node - val proc_desc : t -> Cfg.Procdesc.t + val proc_desc : t -> Procdesc.t val nodes : t -> node list - val from_pdesc : Cfg.Procdesc.t -> t + val from_pdesc : Procdesc.t -> t end -module DefaultNode : Node with type t = Cfg.Node.t and type id = Cfg.Node.id +module DefaultNode : Node with type t = Procdesc.Node.t and type id = Procdesc.Node.id -module InstrNode : Node with type t = Cfg.Node.t and type id = Cfg.Node.id * index +module InstrNode : Node with type t = Procdesc.Node.t and type id = Procdesc.Node.id * index (** Forward CFG with no exceptional control-flow *) -module Normal : S with type t = Cfg.Procdesc.t +module Normal : S with type t = Procdesc.t and type node = DefaultNode.t and type id = DefaultNode.id (** Forward CFG with exceptional control-flow *) -module Exceptional : S with type t = Cfg.Procdesc.t * DefaultNode.t list Cfg.IdMap.t +module Exceptional : S with type t = Procdesc.t * DefaultNode.t list Procdesc.IdMap.t and type node = DefaultNode.t and type id = DefaultNode.id diff --git a/infer/src/checkers/procData.ml b/infer/src/checkers/procData.ml index 56352c9d6..67c0ea1a6 100644 --- a/infer/src/checkers/procData.ml +++ b/infer/src/checkers/procData.ml @@ -9,7 +9,7 @@ open! Utils -type 'a t = { pdesc : Cfg.Procdesc.t; tenv : Tenv.t; extras : 'a; } +type 'a t = { pdesc : Procdesc.t; tenv : Tenv.t; extras : 'a; } type no_extras = unit diff --git a/infer/src/checkers/procData.mli b/infer/src/checkers/procData.mli index 34bff92e3..e98a42c49 100644 --- a/infer/src/checkers/procData.mli +++ b/infer/src/checkers/procData.mli @@ -7,12 +7,12 @@ * of patent rights can be found in the PATENTS file in the same directory. *) -type 'a t = { pdesc : Cfg.Procdesc.t; tenv : Tenv.t; extras : 'a; } +type 'a t = { pdesc : Procdesc.t; tenv : Tenv.t; extras : 'a; } type no_extras val empty_extras : no_extras -val make : Cfg.Procdesc.t -> Tenv.t -> 'a -> 'a t +val make : Procdesc.t -> Tenv.t -> 'a -> 'a t -val make_default : Cfg.Procdesc.t -> Tenv.t -> no_extras t +val make_default : Procdesc.t -> Tenv.t -> no_extras t diff --git a/infer/src/checkers/repeatedCallsChecker.ml b/infer/src/checkers/repeatedCallsChecker.ml index e7a8b38f7..4c95f3c90 100644 --- a/infer/src/checkers/repeatedCallsChecker.ml +++ b/infer/src/checkers/repeatedCallsChecker.ml @@ -73,7 +73,7 @@ struct | Sil.Call (_, Exp.Const (Const.Cfun pn), _, loc, _) when proc_is_new pn -> found := Some loc | _ -> () in - IList.iter do_instr (Cfg.Node.get_instrs node); + IList.iter do_instr (Procdesc.Node.get_instrs node); !found in let module DFAllocCheck = Dataflow.MakeDF(struct @@ -98,7 +98,7 @@ struct end) in let transitions = DFAllocCheck.run tenv pdesc None in - match transitions (Cfg.Procdesc.get_exit_node pdesc) with + match transitions (Procdesc.get_exit_node pdesc) with | DFAllocCheck.Transition (loc, _, _) -> loc | DFAllocCheck.Dead_state -> None @@ -144,7 +144,7 @@ struct let () = match get_proc_desc callee_pname with | None -> () | Some proc_desc -> - if Cfg.Procdesc.is_defined proc_desc + if Procdesc.is_defined proc_desc then report proc_desc in add_call instr_normalized_args extension | _ -> extension diff --git a/infer/src/checkers/sqlChecker.ml b/infer/src/checkers/sqlChecker.ml index 8203bd23b..1ae967da7 100644 --- a/infer/src/checkers/sqlChecker.ml +++ b/infer/src/checkers/sqlChecker.ml @@ -66,5 +66,5 @@ let callback_sql { Callbacks.proc_desc; proc_name; tenv } = try let const_map = ConstantPropagation.build_const_map tenv proc_desc in if verbose then L.stdout "Analyzing %a...\n@." Procname.pp proc_name; - Cfg.Procdesc.iter_instrs (do_instr const_map) proc_desc + Procdesc.iter_instrs (do_instr const_map) proc_desc with _ -> () diff --git a/infer/src/checkers/summary.ml b/infer/src/checkers/summary.ml index d6948e7eb..3c18ebb85 100644 --- a/infer/src/checkers/summary.ml +++ b/infer/src/checkers/summary.ml @@ -25,7 +25,7 @@ module type S = sig val write_summary : Procname.t -> summary -> unit (* read and return the summary for [callee_pname] called from [caller_pdesc]. does the analysis to create the summary if needed *) - val read_summary : Tenv.t -> Cfg.Procdesc.t -> Procname.t -> summary option + val read_summary : Tenv.t -> Procdesc.t -> Procname.t -> summary option end module Make (H : Helper) = struct diff --git a/infer/src/clang/cContext.ml b/infer/src/clang/cContext.ml index d087cb821..a9f33d01f 100644 --- a/infer/src/clang/cContext.ml +++ b/infer/src/clang/cContext.ml @@ -22,7 +22,7 @@ type curr_class = | ContextClsDeclPtr of Clang_ast_t.pointer | ContextNoCls -type str_node_map = (string, Cfg.Node.t) Hashtbl.t +type str_node_map = (string, Procdesc.Node.t) Hashtbl.t type t = { @@ -30,7 +30,7 @@ type t = tenv : Tenv.t; cg : Cg.t; cfg : Cfg.cfg; - procdesc : Cfg.Procdesc.t; + procdesc : Procdesc.t; is_objc_method : bool; curr_class: curr_class; return_param_typ : Typ.t option; @@ -65,7 +65,7 @@ let rec is_objc_instance context = match context.outer_context with | Some outer_context -> is_objc_instance outer_context | None -> - let attrs = Cfg.Procdesc.get_attributes context.procdesc in + let attrs = Procdesc.get_attributes context.procdesc in attrs.ProcAttributes.is_objc_instance_method let rec get_curr_class context = @@ -157,4 +157,4 @@ let static_vars_for_block context block_name = let rec get_outer_procname context = match context.outer_context with | Some outer_context -> get_outer_procname outer_context - | None -> Cfg.Procdesc.get_proc_name context.procdesc + | None -> Procdesc.get_proc_name context.procdesc diff --git a/infer/src/clang/cContext.mli b/infer/src/clang/cContext.mli index e0431b657..61b65f5fb 100644 --- a/infer/src/clang/cContext.mli +++ b/infer/src/clang/cContext.mli @@ -20,7 +20,7 @@ type curr_class = | ContextClsDeclPtr of Clang_ast_t.pointer | ContextNoCls -type str_node_map = (string, Cfg.Node.t) Hashtbl.t +type str_node_map = (string, Procdesc.Node.t) Hashtbl.t type t = { @@ -28,7 +28,7 @@ type t = tenv : Tenv.t; cg : Cg.t; cfg : Cfg.cfg; - procdesc : Cfg.Procdesc.t; + procdesc : Procdesc.t; is_objc_method : bool; curr_class: curr_class; return_param_typ : Typ.t option; @@ -38,7 +38,7 @@ type t = label_map : str_node_map; } -val get_procdesc : t -> Cfg.Procdesc.t +val get_procdesc : t -> Procdesc.t val get_cfg : t -> Cfg.cfg @@ -61,7 +61,7 @@ val is_objc_method : t -> bool val get_tenv : t -> Tenv.t val create_context : CFrontend_config.translation_unit_context -> Tenv.t -> Cg.t -> Cfg.cfg -> - Cfg.Procdesc.t -> curr_class -> Typ.t option -> bool -> t option -> t + Procdesc.t -> curr_class -> Typ.t option -> bool -> t option -> t val create_curr_class : Tenv.t -> string -> Csu.class_kind -> curr_class diff --git a/infer/src/clang/cFrontend_decl.ml b/infer/src/clang/cFrontend_decl.ml index ac28b9aae..81eede40b 100644 --- a/infer/src/clang/cFrontend_decl.ml +++ b/infer/src/clang/cFrontend_decl.ml @@ -28,21 +28,21 @@ struct try (match Cfg.find_proc_desc_from_name cfg procname with | Some procdesc -> - if (Cfg.Procdesc.is_defined procdesc && not (model_exists procname)) then + if (Procdesc.is_defined procdesc && not (model_exists procname)) then (let context = CContext.create_context trans_unit_ctx tenv cg cfg procdesc class_decl_opt has_return_param is_objc_method outer_context_opt in - let start_node = Cfg.Procdesc.get_start_node procdesc in - let exit_node = Cfg.Procdesc.get_exit_node procdesc in + let start_node = Procdesc.get_start_node procdesc in + let exit_node = Procdesc.get_exit_node procdesc in Logging.out_debug "\n\n>>---------- Start translating body of function: '%s' ---------<<\n@." (Procname.to_string procname); let meth_body_nodes = T.instructions_trans context body extra_instrs exit_node in - let proc_attributes = Cfg.Procdesc.get_attributes procdesc in - Cfg.Node.add_locals_ret_declaration - start_node proc_attributes (Cfg.Procdesc.get_locals procdesc); - Cfg.Procdesc.node_set_succs_exn procdesc start_node meth_body_nodes []; - Cg.add_defined_node (CContext.get_cg context) (Cfg.Procdesc.get_proc_name procdesc)) + let proc_attributes = Procdesc.get_attributes procdesc in + Procdesc.Node.add_locals_ret_declaration + start_node proc_attributes (Procdesc.get_locals procdesc); + Procdesc.node_set_succs_exn procdesc start_node meth_body_nodes []; + Cg.add_defined_node (CContext.get_cg context) (Procdesc.get_proc_name procdesc)) | None -> ()) with | Not_found -> () diff --git a/infer/src/clang/cMethod_trans.ml b/infer/src/clang/cMethod_trans.ml index 71d7c1f46..6adb6c29c 100644 --- a/infer/src/clang/cMethod_trans.ml +++ b/infer/src/clang/cMethod_trans.ml @@ -330,9 +330,9 @@ let sil_func_attributes_of_attributes attrs = let should_create_procdesc cfg procname defined = match Cfg.find_proc_desc_from_name cfg procname with | Some previous_procdesc -> - let is_defined_previous = Cfg.Procdesc.is_defined previous_procdesc in + let is_defined_previous = Procdesc.is_defined previous_procdesc in if defined && (not is_defined_previous) then - (Cfg.remove_proc_desc cfg (Cfg.Procdesc.get_proc_name previous_procdesc); + (Cfg.remove_proc_desc cfg (Procdesc.get_proc_name previous_procdesc); true) else false | None -> true @@ -421,13 +421,13 @@ let create_local_procdesc trans_unit_ctx cfg tenv ms fbody captured is_objc_inst Cfg.create_proc_desc cfg proc_attributes in if defined then (if !Config.arc_mode then - Cfg.Procdesc.set_flag procdesc Mleak_buckets.objc_arc_flag "true"; - let start_kind = Cfg.Node.Start_node proc_name in - let start_node = Cfg.Procdesc.create_node procdesc loc_start start_kind [] in - let exit_kind = Cfg.Node.Exit_node proc_name in - let exit_node = Cfg.Procdesc.create_node procdesc loc_exit exit_kind [] in - Cfg.Procdesc.set_start_node procdesc start_node; - Cfg.Procdesc.set_exit_node procdesc exit_node) in + Procdesc.set_flag procdesc Mleak_buckets.objc_arc_flag "true"; + let start_kind = Procdesc.Node.Start_node proc_name in + let start_node = Procdesc.create_node procdesc loc_start start_kind [] in + let exit_kind = Procdesc.Node.Exit_node proc_name in + let exit_node = Procdesc.create_node procdesc loc_exit exit_kind [] in + Procdesc.set_start_node procdesc start_node; + Procdesc.set_exit_node procdesc exit_node) in if should_create_procdesc cfg proc_name defined then (create_new_procdesc (); true) else false diff --git a/infer/src/clang/cModule_type.ml b/infer/src/clang/cModule_type.ml index 68c75810a..89d5d5aad 100644 --- a/infer/src/clang/cModule_type.ml +++ b/infer/src/clang/cModule_type.ml @@ -26,7 +26,7 @@ sig added before clang statements and the exit node and it returns a list of cfg nodes that represent the translation of the stmts into sil. *) val instructions_trans : CContext.t -> Clang_ast_t.stmt -> instr_type list -> - Cfg.Node.t -> Cfg.Node.t list + Procdesc.Node.t -> Procdesc.Node.t list end module type CFrontend = sig diff --git a/infer/src/clang/cTrans.ml b/infer/src/clang/cTrans.ml index 20ad61dd5..a34b4ce6c 100644 --- a/infer/src/clang/cTrans.ml +++ b/infer/src/clang/cTrans.ml @@ -69,7 +69,7 @@ struct let add_autorelease_call context exp typ sil_loc = - let method_name = Procname.get_method (Cfg.Procdesc.get_proc_name context.CContext.procdesc) in + let method_name = Procname.get_method (Procdesc.get_proc_name context.CContext.procdesc) in if !Config.arc_mode && not (CTrans_utils.is_owning_name method_name) && ObjcInterface_decl.is_pointer_to_objc_class typ then @@ -105,7 +105,7 @@ struct let allocate_block trans_state block_name captured_vars loc = let tenv = trans_state.context.CContext.tenv in let procdesc = trans_state.context.CContext.procdesc in - let procname = Cfg.Procdesc.get_proc_name procdesc in + let procname = Procdesc.get_proc_name procdesc in let mk_field_from_captured_var (var, typ) = let vname = Pvar.get_name var in let qual_name = Ast_utils.make_qual_name_decl [block_name] (Mangled.to_string vname) in @@ -244,7 +244,7 @@ struct Ident.NameGenerator.set_current ident_state let mk_temp_sil_var procdesc var_name_suffix = - let procname = Cfg.Procdesc.get_proc_name procdesc in + let procname = Procdesc.get_proc_name procdesc in Pvar.mk_tmp var_name_suffix procname let mk_temp_sil_var_for_expr tenv procdesc var_name_prefix expr_info = @@ -257,7 +257,7 @@ struct let procdesc = context.CContext.procdesc in let (pvar, typ) = mk_temp_sil_var_for_expr context.CContext.tenv procdesc var_name expr_info in - Cfg.Procdesc.append_locals procdesc [(Pvar.get_name pvar, typ)]; + Procdesc.append_locals procdesc [(Pvar.get_name pvar, typ)]; Exp.Lvar pvar, typ let create_call_instr trans_state return_type function_sil params_sil sil_loc @@ -273,7 +273,7 @@ struct | _ -> let procdesc = trans_state.context.CContext.procdesc in let pvar = mk_temp_sil_var procdesc "__temp_return_" in - Cfg.Procdesc.append_locals procdesc [(Pvar.get_name pvar, return_type)]; + Procdesc.append_locals procdesc [(Pvar.get_name pvar, return_type)]; Exp.Lvar pvar in (* It is very confusing - same expression has two different types in two contexts:*) (* 1. if passed as parameter it's RETURN_TYPE* since we are passing it as rvalue *) @@ -577,7 +577,7 @@ struct let this_expr_trans trans_state sil_loc class_type_ptr = let context = trans_state.context in - let procname = Cfg.Procdesc.get_proc_name context.CContext.procdesc in + let procname = Procdesc.get_proc_name context.CContext.procdesc in let name = CFrontend_config.this in let pvar = Pvar.mk (Mangled.from_string name) procname in let exp = Exp.Lvar pvar in @@ -600,7 +600,7 @@ struct (* create the label root node into the hashtbl *) let sil_loc = CLocation.get_sil_location stmt_info context in let root_node' = GotoLabel.find_goto_label trans_state.context label_name sil_loc in - Cfg.Procdesc.node_set_succs_exn context.procdesc root_node' res_trans.root_nodes []; + Procdesc.node_set_succs_exn context.procdesc root_node' res_trans.root_nodes []; { empty_res_trans with root_nodes = [root_node']; leaf_nodes = trans_state.succ_nodes } and var_deref_trans trans_state stmt_info (decl_ref : Clang_ast_t.decl_ref) = @@ -614,7 +614,7 @@ struct Typ.Tptr (ast_typ, Pk_reference) else ast_typ | _ -> ast_typ in - let procname = Cfg.Procdesc.get_proc_name context.procdesc in + let procname = Procdesc.get_proc_name context.procdesc in let sil_loc = CLocation.get_sil_location stmt_info context in let pvar = CVar_decl.sil_var_of_decl_ref context decl_ref procname in CContext.add_block_static_var context procname (pvar, typ); @@ -750,7 +750,7 @@ struct if res_trans_idx.root_nodes <> [] then IList.iter - (fun n -> Cfg.Procdesc.node_set_succs_exn context.procdesc n res_trans_idx.root_nodes []) + (fun n -> Procdesc.node_set_succs_exn context.procdesc n res_trans_idx.root_nodes []) res_trans_a.leaf_nodes; (* Note the order of res_trans_idx.ids @ res_trans_a.ids is important. *) @@ -832,7 +832,7 @@ struct let context = trans_state.context in let fn_type_no_ref = CType_decl.get_type_from_expr_info expr_info context.CContext.tenv in let function_type = add_reference_if_glvalue fn_type_no_ref expr_info in - let procname = Cfg.Procdesc.get_proc_name context.CContext.procdesc in + let procname = Procdesc.get_proc_name context.CContext.procdesc in let sil_loc = CLocation.get_sil_location si context in (* First stmt is the function expr and the rest are params *) let fun_exp_stmt, params_stmt = (match stmt_list with @@ -909,7 +909,7 @@ struct si function_type is_cpp_call_virtual extra_res_trans = let open CContext in let context = trans_state_pri.context in - let procname = Cfg.Procdesc.get_proc_name context.procdesc in + let procname = Procdesc.get_proc_name context.procdesc in let sil_loc = CLocation.get_sil_location si context in (* first for method address, second for 'this' expression *) assert ((IList.length result_trans_callee.exps) = 2); @@ -973,9 +973,9 @@ struct | Some exp_typ -> exp_typ | None -> let procdesc = trans_state.context.CContext.procdesc in - let pvar = Pvar.mk_tmp "__temp_construct_" (Cfg.Procdesc.get_proc_name procdesc) in + let pvar = Pvar.mk_tmp "__temp_construct_" (Procdesc.get_proc_name procdesc) in let class_type = CType_decl.get_type_from_expr_info ei context.CContext.tenv in - Cfg.Procdesc.append_locals procdesc [(Pvar.get_name pvar, class_type)]; + Procdesc.append_locals procdesc [(Pvar.get_name pvar, class_type)]; Exp.Lvar pvar, class_type in let this_type = Typ.Tptr (class_type, Typ.Pk_pointer) in let this_res_trans = { empty_res_trans with @@ -1067,7 +1067,7 @@ struct method_type trans_state_pri sil_loc subexpr_exprs with | Some res -> res | None -> - let procname = Cfg.Procdesc.get_proc_name context.CContext.procdesc in + let procname = Procdesc.get_proc_name context.CContext.procdesc in let callee_name, method_call_type = get_callee_objc_method context obj_c_message_expr_info subexpr_exprs in let res_trans_add_self = Self.add_self_parameter_for_super_instance context procname sil_loc @@ -1101,7 +1101,7 @@ struct and block_enumeration_trans trans_state stmt_info stmt_list ei = Logging.out_debug "\n Call to a block enumeration function treated as special case...\n@."; - let procname = Cfg.Procdesc.get_proc_name trans_state.context.CContext.procdesc in + let procname = Procdesc.get_proc_name trans_state.context.CContext.procdesc in let pvar = CFrontend_utils.General_utils.get_next_block_pvar procname in let transformed_stmt, _ = Ast_expressions.translate_block_enumerate (Pvar.to_string pvar) stmt_info stmt_list ei in @@ -1132,7 +1132,7 @@ struct let prune_nodes_t, prune_nodes_f = IList.partition is_true_prune_node prune_nodes in let prune_nodes' = if branch then prune_nodes_t else prune_nodes_f in IList.iter - (fun n -> Cfg.Procdesc.node_set_succs_exn context.procdesc n res_trans.root_nodes []) + (fun n -> Procdesc.node_set_succs_exn context.procdesc n res_trans.root_nodes []) prune_nodes' in (match stmt_list with | [cond; exp1; exp2] -> @@ -1140,10 +1140,10 @@ struct CType_decl.type_ptr_to_sil_type context.CContext.tenv expr_info.Clang_ast_t.ei_type_ptr in let var_typ = add_reference_if_glvalue typ expr_info in - let join_node = create_node (Cfg.Node.Join_node) [] sil_loc context in - Cfg.Procdesc.node_set_succs_exn context.procdesc join_node succ_nodes []; + let join_node = create_node (Procdesc.Node.Join_node) [] sil_loc context in + Procdesc.node_set_succs_exn context.procdesc join_node succ_nodes []; let pvar = mk_temp_sil_var procdesc "SIL_temp_conditional___" in - Cfg.Procdesc.append_locals procdesc [(Pvar.get_name pvar, var_typ)]; + Procdesc.append_locals procdesc [(Pvar.get_name pvar, var_typ)]; let continuation' = mk_cond_continuation trans_state.continuation in let trans_state' = { trans_state with continuation = continuation'; succ_nodes = [] } in let res_trans_cond = exec_with_priority_exception trans_state' cond cond_trans in @@ -1214,7 +1214,7 @@ struct let prune_t = mk_prune_node true e' instrs' in let prune_f = mk_prune_node false e' instrs' in IList.iter - (fun n' -> Cfg.Procdesc.node_set_succs_exn context.procdesc n' [prune_t; prune_f] []) + (fun n' -> Procdesc.node_set_succs_exn context.procdesc n' [prune_t; prune_f] []) res_trans_cond.leaf_nodes; let rnodes = if (IList.length res_trans_cond.root_nodes) = 0 then [prune_t; prune_f] @@ -1247,7 +1247,7 @@ struct | Binop.LOr -> prune_nodes_f, prune_nodes_t | _ -> assert false) in IList.iter - (fun n -> Cfg.Procdesc.node_set_succs_exn context.procdesc n res_trans_s2.root_nodes []) + (fun n -> Procdesc.node_set_succs_exn context.procdesc n res_trans_s2.root_nodes []) prune_to_s2; let root_nodes_to_parent = if (IList.length res_trans_s1.root_nodes) = 0 @@ -1287,8 +1287,8 @@ struct let context = trans_state.context in let succ_nodes = trans_state.succ_nodes in let sil_loc = CLocation.get_sil_location stmt_info context in - let join_node = create_node (Cfg.Node.Join_node) [] sil_loc context in - Cfg.Procdesc.node_set_succs_exn context.procdesc join_node succ_nodes []; + let join_node = create_node (Procdesc.Node.Join_node) [] sil_loc context in + Procdesc.node_set_succs_exn context.procdesc join_node succ_nodes []; let trans_state' = { trans_state with succ_nodes = [join_node] } in let do_branch branch stmt_branch prune_nodes = (* leaf nodes are ignored here as they will be already attached to join_node *) @@ -1296,13 +1296,14 @@ struct let nodes_branch = (match res_trans_b.root_nodes with | [] -> - [create_node (Cfg.Node.Stmt_node "IfStmt Branch") res_trans_b.instrs sil_loc context] + [create_node + (Procdesc.Node.Stmt_node "IfStmt Branch") res_trans_b.instrs sil_loc context] | _ -> res_trans_b.root_nodes) in let prune_nodes_t, prune_nodes_f = IList.partition is_true_prune_node prune_nodes in let prune_nodes' = if branch then prune_nodes_t else prune_nodes_f in IList.iter - (fun n -> Cfg.Procdesc.node_set_succs_exn context.procdesc n nodes_branch []) + (fun n -> Procdesc.node_set_succs_exn context.procdesc n nodes_branch []) prune_nodes' in (match stmt_list with | [_; decl_stmt; cond; stmt1; stmt2] -> @@ -1336,11 +1337,11 @@ struct let trans_state' ={ trans_state_pri with succ_nodes = []} in let res_trans_cond_tmp = instruction trans_state' cond in let switch_special_cond_node = - let node_kind = Cfg.Node.Stmt_node "Switch_stmt" in + let node_kind = Procdesc.Node.Stmt_node "Switch_stmt" in create_node node_kind res_trans_cond_tmp.instrs sil_loc context in IList.iter (fun n' -> - Cfg.Procdesc.node_set_succs_exn context.procdesc n' [switch_special_cond_node] []) + Procdesc.node_set_succs_exn context.procdesc n' [switch_special_cond_node] []) res_trans_cond_tmp.leaf_nodes; let root_nodes = if res_trans_cond_tmp.root_nodes <> [] then res_trans_cond_tmp.root_nodes @@ -1438,29 +1439,30 @@ struct let case_entry_point = connected_instruction (IList.rev case_content) last_nodes in (* connects between cases, then continuation has priority about breaks *) let prune_node_t, prune_node_f = create_prune_nodes_for_case case in - Cfg.Procdesc.node_set_succs_exn context.procdesc prune_node_t case_entry_point []; - Cfg.Procdesc.node_set_succs_exn context.procdesc prune_node_f last_prune_nodes []; + Procdesc.node_set_succs_exn context.procdesc prune_node_t case_entry_point []; + Procdesc.node_set_succs_exn context.procdesc prune_node_f last_prune_nodes []; case_entry_point, [prune_node_t; prune_node_f] | DefaultStmt(stmt_info, default_content) :: rest -> let sil_loc = CLocation.get_sil_location stmt_info context in let placeholder_entry_point = - create_node (Cfg.Node.Stmt_node "DefaultStmt_placeholder") [] sil_loc context in + create_node + (Procdesc.Node.Stmt_node "DefaultStmt_placeholder") [] sil_loc context in let last_nodes, last_prune_nodes = translate_and_connect_cases rest next_nodes [placeholder_entry_point] in let default_entry_point = connected_instruction (IList.rev default_content) last_nodes in - Cfg.Procdesc.node_set_succs_exn + Procdesc.node_set_succs_exn context.procdesc placeholder_entry_point default_entry_point []; default_entry_point, last_prune_nodes | _ -> assert false in let top_entry_point, top_prune_nodes = translate_and_connect_cases list_of_cases succ_nodes succ_nodes in let _ = connected_instruction (IList.rev pre_case_stmts) top_entry_point in - Cfg.Procdesc.node_set_succs_exn + Procdesc.node_set_succs_exn context.procdesc switch_special_cond_node top_prune_nodes []; let top_nodes = res_trans_decl.root_nodes in IList.iter - (fun n' -> Cfg.Node.append_instrs n' []) succ_nodes; + (fun n' -> Procdesc.Node.append_instrs n' []) succ_nodes; (* succ_nodes will remove the temps *) { empty_res_trans with root_nodes = top_nodes; leaf_nodes = succ_nodes } | _ -> assert false @@ -1480,7 +1482,7 @@ struct let context = trans_state.context in let succ_nodes = trans_state.succ_nodes in let sil_loc = CLocation.get_sil_location stmt_info context in - let join_node = create_node Cfg.Node.Join_node [] sil_loc context in + let join_node = create_node Procdesc.Node.Join_node [] sil_loc context in let continuation = Some { break = succ_nodes; continue = [join_node]; return_temp = false } in (* set the flat to inform that we are translating a condition of a if *) let continuation_cond = mk_cond_continuation outer_continuation in @@ -1538,12 +1540,12 @@ struct match loop_kind with | Loops.For _ | Loops.While _ -> res_trans_body.root_nodes | Loops.DoWhile _ -> [join_node] in - Cfg.Procdesc.node_set_succs_exn context.procdesc join_node join_succ_nodes []; + Procdesc.node_set_succs_exn context.procdesc join_node join_succ_nodes []; IList.iter - (fun n -> Cfg.Procdesc.node_set_succs_exn context.procdesc n prune_t_succ_nodes []) + (fun n -> Procdesc.node_set_succs_exn context.procdesc n prune_t_succ_nodes []) prune_nodes_t; IList.iter - (fun n -> Cfg.Procdesc.node_set_succs_exn context.procdesc n succ_nodes []) + (fun n -> Procdesc.node_set_succs_exn context.procdesc n succ_nodes []) prune_nodes_f; let root_nodes = match loop_kind with @@ -1719,7 +1721,7 @@ struct let open Clang_ast_t in let context = trans_state.context in let procdesc = context.CContext.procdesc in - let procname = Cfg.Procdesc.get_proc_name procdesc in + let procname = Procdesc.get_proc_name procdesc in let do_var_dec (di, var_name, qual_type, vdi) next_node = let var_decl = VarDecl (di, var_name, qual_type, vdi) in let pvar = CVar_decl.sil_var_of_decl context var_decl procname in @@ -1891,26 +1893,26 @@ struct let sil_loc = CLocation.get_sil_location stmt_info context in let trans_state_pri = PriorityNode.try_claim_priority_node trans_state stmt_info in let mk_ret_node instrs = - let ret_node = create_node (Cfg.Node.Stmt_node "Return Stmt") instrs sil_loc context in - Cfg.Procdesc.node_set_succs_exn + let ret_node = create_node (Procdesc.Node.Stmt_node "Return Stmt") instrs sil_loc context in + Procdesc.node_set_succs_exn context.procdesc - ret_node [(Cfg.Procdesc.get_exit_node context.CContext.procdesc)] []; + ret_node [(Procdesc.get_exit_node context.CContext.procdesc)] []; ret_node in let trans_result = (match stmt_list with | [stmt] -> (* return exp; *) let procdesc = context.CContext.procdesc in - let ret_type = Cfg.Procdesc.get_ret_type procdesc in + let ret_type = Procdesc.get_ret_type procdesc in let ret_exp, ret_typ, var_instrs = match context.CContext.return_param_typ with | Some ret_param_typ -> let name = CFrontend_config.return_param in - let procname = Cfg.Procdesc.get_proc_name procdesc in + let procname = Procdesc.get_proc_name procdesc in let pvar = Pvar.mk (Mangled.from_string name) procname in let id = Ident.create_fresh Ident.knormal in let instr = Sil.Load (id, Exp.Lvar pvar, ret_param_typ, sil_loc) in let ret_typ = match ret_param_typ with Typ.Tptr (t, _) -> t | _ -> assert false in Exp.Var id, ret_typ, [instr] | None -> - Exp.Lvar (Cfg.Procdesc.get_ret_var procdesc), ret_type, [] in + Exp.Lvar (Procdesc.get_ret_var procdesc), ret_type, [] in let trans_state' = { trans_state_pri with succ_nodes = []; var_exp_typ = Some (ret_exp, ret_typ) } in @@ -1926,7 +1928,7 @@ struct let instrs = var_instrs @ res_trans_stmt.instrs @ ret_instrs @ autorelease_instrs in let ret_node = mk_ret_node instrs in IList.iter - (fun n -> Cfg.Procdesc.node_set_succs_exn procdesc n [ret_node] []) + (fun n -> Procdesc.node_set_succs_exn procdesc n [ret_node] []) res_trans_stmt.leaf_nodes; let root_nodes_to_parent = if IList.length res_trans_stmt.root_nodes >0 @@ -2011,9 +2013,9 @@ struct Sil.Call (ret_id, (Exp.Const (Const.Cfun fname)), autorelease_pool_vars, sil_loc, CallFlags.default) in - let node_kind = Cfg.Node.Stmt_node ("Release the autorelease pool") in + let node_kind = Procdesc.Node.Stmt_node ("Release the autorelease pool") in let call_node = create_node node_kind [stmt_call] sil_loc context in - Cfg.Procdesc.node_set_succs_exn context.procdesc call_node trans_state.succ_nodes []; + Procdesc.node_set_succs_exn context.procdesc call_node trans_state.succ_nodes []; let trans_state'={ trans_state with continuation = None; succ_nodes =[call_node] } in instructions trans_state' stmts @@ -2029,7 +2031,7 @@ struct and blockExpr_trans trans_state stmt_info expr_info decl = let context = trans_state.context in - let procname = Cfg.Procdesc.get_proc_name context.CContext.procdesc in + let procname = Procdesc.get_proc_name context.CContext.procdesc in let loc = (match stmt_info.Clang_ast_t.si_source_range with (l1, _) -> CLocation.clang_to_sil_location context.CContext.translation_unit_context l1) in @@ -2099,7 +2101,7 @@ struct let type_ptr = expr_info.Clang_ast_t.ei_type_ptr in let context = trans_state.context in call_translation context decl; - let procname = Cfg.Procdesc.get_proc_name context.procdesc in + let procname = Procdesc.get_proc_name context.procdesc in let lambda_pname = CMethod_trans.get_procname_from_cpp_lambda context decl in let typ = CType_decl.type_ptr_to_sil_type context.tenv type_ptr in (* We need to set the explicit dependency between the newly created lambda and the *) @@ -2199,7 +2201,7 @@ struct let (pvar, typ) = mk_temp_sil_var_for_expr context.CContext.tenv procdesc "SIL_materialize_temp__" expr_info in let temp_exp = match stmt_list with [p] -> p | _ -> assert false in - Cfg.Procdesc.append_locals procdesc [(Pvar.get_name pvar, typ)]; + Procdesc.append_locals procdesc [(Pvar.get_name pvar, typ)]; let var_exp_typ = (Exp.Lvar pvar, typ) in let res_trans = init_expr_trans trans_state var_exp_typ stmt_info (Some temp_exp) in { res_trans with exps = [var_exp_typ] } diff --git a/infer/src/clang/cTrans_utils.ml b/infer/src/clang/cTrans_utils.ml index 058351e9b..4528901c9 100644 --- a/infer/src/clang/cTrans_utils.ml +++ b/infer/src/clang/cTrans_utils.ml @@ -35,26 +35,26 @@ let extract_exp_from_list el warning_string = module Nodes = struct - let prune_kind b = Cfg.Node.Prune_node(b, Sil.Ik_bexp , ((string_of_bool b)^" Branch")) + let prune_kind b = Procdesc.Node.Prune_node(b, Sil.Ik_bexp , ((string_of_bool b)^" Branch")) let is_join_node n = - match Cfg.Node.get_kind n with - | Cfg.Node.Join_node -> true + match Procdesc.Node.get_kind n with + | Procdesc.Node.Join_node -> true | _ -> false let is_prune_node n = - match Cfg.Node.get_kind n with - | Cfg.Node.Prune_node _ -> true + match Procdesc.Node.get_kind n with + | Procdesc.Node.Prune_node _ -> true | _ -> false let is_true_prune_node n = - match Cfg.Node.get_kind n with - | Cfg.Node.Prune_node(true, _, _) -> true + match Procdesc.Node.get_kind n with + | Procdesc.Node.Prune_node(true, _, _) -> true | _ -> false let create_node node_kind instrs loc context = let procdesc = CContext.get_procdesc context in - Cfg.Procdesc.create_node procdesc loc node_kind instrs + Procdesc.create_node procdesc loc node_kind instrs let create_prune_node branch e_cond instrs_cond loc ik context = let (e_cond', _) = extract_exp_from_list e_cond @@ -92,14 +92,14 @@ struct Hashtbl.find context.CContext.label_map label with Not_found -> let node_name = Format.sprintf "GotoLabel_%s" label in - let new_node = Nodes.create_node (Cfg.Node.Skip_node node_name) [] sil_loc context in + let new_node = Nodes.create_node (Procdesc.Node.Skip_node node_name) [] sil_loc context in Hashtbl.add context.CContext.label_map label new_node; new_node end type continuation = { - break: Cfg.Node.t list; - continue: Cfg.Node.t list; + break: Procdesc.Node.t list; + continue: Procdesc.Node.t list; return_temp : bool; (* true if temps should not be removed in the node but returned to ancestors *) } @@ -127,7 +127,7 @@ type priority_node = (* it need to carry on the tranlsation. *) type trans_state = { context: CContext.t; (* current context of the translation *) - succ_nodes: Cfg.Node.t list; (* successor nodes in the cfg *) + succ_nodes: Procdesc.Node.t list; (* successor nodes in the cfg *) continuation: continuation option; (* current continuation *) priority: priority_node; var_exp_typ: (Exp.t * Typ.t) option; @@ -137,8 +137,8 @@ type trans_state = { (* A translation result. It is returned by the translation function. *) type trans_result = { - root_nodes: Cfg.Node.t list; (* Top cfg nodes (root) created by the translation *) - leaf_nodes: Cfg.Node.t list; (* Bottom cfg nodes (leaf) created by the translate *) + root_nodes: Procdesc.Node.t list; (* Top cfg nodes (root) created by the translation *) + leaf_nodes: Procdesc.Node.t list; (* Bottom cfg nodes (leaf) created by the translate *) instrs: Sil.instr list; (* list of SIL instruction that need to be placed in cfg nodes of the parent*) exps: (Exp.t * Typ.t) list; (* SIL expressions resulting from translation of clang stmt *) initd_exps: Exp.t list; @@ -171,7 +171,7 @@ let collect_res_trans pdesc l = else rt.leaf_nodes in if rt'.root_nodes <> [] then IList.iter - (fun n -> Cfg.Procdesc.node_set_succs_exn pdesc n rt'.root_nodes []) + (fun n -> Procdesc.node_set_succs_exn pdesc n rt'.root_nodes []) rt.leaf_nodes; collect l' { root_nodes = root_nodes; @@ -244,11 +244,11 @@ struct let create_node = own_priority_node trans_state.priority stmt_info && res_state.instrs <> [] in if create_node then (* We need to create a node *) - let node_kind = Cfg.Node.Stmt_node (nd_name) in + let node_kind = Procdesc.Node.Stmt_node (nd_name) in let node = Nodes.create_node node_kind res_state.instrs loc trans_state.context in - Cfg.Procdesc.node_set_succs_exn trans_state.context.procdesc node trans_state.succ_nodes []; + Procdesc.node_set_succs_exn trans_state.context.procdesc node trans_state.succ_nodes []; IList.iter - (fun leaf -> Cfg.Procdesc.node_set_succs_exn trans_state.context.procdesc leaf [node] []) + (fun leaf -> Procdesc.node_set_succs_exn trans_state.context.procdesc leaf [node] []) res_state.leaf_nodes; (* Invariant: if root_nodes is empty then the params have not created a node.*) let root_nodes = (if res_state.root_nodes <> [] then res_state.root_nodes @@ -446,16 +446,16 @@ let trans_assertion_failure sil_loc (context : CContext.t) = let assert_fail_builtin = Exp.Const (Const.Cfun BuiltinDecl.__infer_fail) in let args = [Exp.Const (Const.Cstr Config.default_failure_name), Typ.Tvoid] in let call_instr = Sil.Call (None, assert_fail_builtin, args, sil_loc, CallFlags.default) in - let exit_node = Cfg.Procdesc.get_exit_node (CContext.get_procdesc context) + let exit_node = Procdesc.get_exit_node (CContext.get_procdesc context) and failure_node = - Nodes.create_node (Cfg.Node.Stmt_node "Assertion failure") [call_instr] sil_loc context in - Cfg.Procdesc.node_set_succs_exn context.procdesc failure_node [exit_node] []; + Nodes.create_node (Procdesc.Node.Stmt_node "Assertion failure") [call_instr] sil_loc context in + Procdesc.node_set_succs_exn context.procdesc failure_node [exit_node] []; { empty_res_trans with root_nodes = [failure_node]; } let trans_assume_false sil_loc (context : CContext.t) succ_nodes = let instrs_cond = [Sil.Prune (Exp.zero, sil_loc, true, Sil.Ik_land_lor)] in let prune_node = Nodes.create_node (Nodes.prune_kind true) instrs_cond sil_loc context in - Cfg.Procdesc.node_set_succs_exn context.procdesc prune_node succ_nodes []; + Procdesc.node_set_succs_exn context.procdesc prune_node succ_nodes []; { empty_res_trans with root_nodes = [prune_node]; leaf_nodes = [prune_node] } let trans_assertion trans_state sil_loc = diff --git a/infer/src/clang/cTrans_utils.mli b/infer/src/clang/cTrans_utils.mli index e2f18c495..aa81ae88a 100644 --- a/infer/src/clang/cTrans_utils.mli +++ b/infer/src/clang/cTrans_utils.mli @@ -12,8 +12,8 @@ open! Utils (** Utility methods to support the translation of clang ast constructs into sil instructions. *) type continuation = { - break: Cfg.Node.t list; - continue: Cfg.Node.t list; + break: Procdesc.Node.t list; + continue: Procdesc.Node.t list; return_temp : bool; (* true if temps should not be removed in the node but returned to ancestors *) } @@ -23,7 +23,7 @@ type priority_node = type trans_state = { context: CContext.t; - succ_nodes: Cfg.Node.t list; + succ_nodes: Procdesc.Node.t list; continuation: continuation option; priority: priority_node; var_exp_typ: (Exp.t * Typ.t) option; @@ -32,8 +32,8 @@ type trans_state = { } type trans_result = { - root_nodes: Cfg.Node.t list; - leaf_nodes: Cfg.Node.t list; + root_nodes: Procdesc.Node.t list; + leaf_nodes: Procdesc.Node.t list; instrs: Sil.instr list; exps: (Exp.t * Typ.t) list; initd_exps: Exp.t list; @@ -44,7 +44,7 @@ val empty_res_trans: trans_result val undefined_expression: unit -> Exp.t -val collect_res_trans : Cfg.Procdesc.t -> trans_result list -> trans_result +val collect_res_trans : Procdesc.t -> trans_result list -> trans_result val extract_var_exp_or_fail : trans_state -> Exp.t * Typ.t @@ -125,19 +125,20 @@ sig val need_unary_op_node : Clang_ast_t.unary_operator_info -> bool - val create_node : Cfg.Node.nodekind -> Sil.instr list -> Location.t -> CContext.t -> Cfg.Node.t + val create_node : + Procdesc.Node.nodekind -> Sil.instr list -> Location.t -> CContext.t -> Procdesc.Node.t - val is_join_node : Cfg.Node.t -> bool + val is_join_node : Procdesc.Node.t -> bool val create_prune_node : bool -> (Exp.t * Typ.t) list -> Sil.instr list -> Location.t -> Sil.if_kind -> - CContext.t -> Cfg.Node.t + CContext.t -> Procdesc.Node.t - val is_prune_node : Cfg.Node.t -> bool + val is_prune_node : Procdesc.Node.t -> bool - val is_true_prune_node : Cfg.Node.t -> bool + val is_true_prune_node : Procdesc.Node.t -> bool - val prune_kind : bool -> Cfg.Node.nodekind + val prune_kind : bool -> Procdesc.Node.nodekind end @@ -175,7 +176,7 @@ end (** Module for translating goto instructions by keeping a map of labels. *) module GotoLabel : sig - val find_goto_label : CContext.t -> string -> Location.t -> Cfg.Node.t + val find_goto_label : CContext.t -> string -> Location.t -> Procdesc.Node.t end (** Module that provides utility functions for translating different types of loops. *) diff --git a/infer/src/clang/cVar_decl.ml b/infer/src/clang/cVar_decl.ml index feae9f555..59079f8a5 100644 --- a/infer/src/clang/cVar_decl.ml +++ b/infer/src/clang/cVar_decl.ml @@ -59,11 +59,11 @@ let add_var_to_locals procdesc var_decl sil_typ pvar = match var_decl with | VarDecl (_, _, _, vdi) -> if not vdi.Clang_ast_t.vdi_is_global then - Cfg.Procdesc.append_locals procdesc [(Pvar.get_name pvar, sil_typ)] + Procdesc.append_locals procdesc [(Pvar.get_name pvar, sil_typ)] | _ -> assert false let rec compute_autorelease_pool_vars context stmts = - let procname = Cfg.Procdesc.get_proc_name context.CContext.procdesc in + let procname = Procdesc.get_proc_name context.CContext.procdesc in match stmts with | [] -> [] | Clang_ast_t.DeclRefExpr (_, _, _, drei):: stmts' -> @@ -86,7 +86,7 @@ let rec compute_autorelease_pool_vars context stmts = (* Returns a list of captured variables as sil variables. *) let captured_vars_from_block_info context cvl = - let procname = Cfg.Procdesc.get_proc_name context.CContext.procdesc in + let procname = Procdesc.get_proc_name context.CContext.procdesc in let sil_var_of_captured_var cv vars = match cv.Clang_ast_t.bcv_variable with | Some dr -> diff --git a/infer/src/clang/cVar_decl.mli b/infer/src/clang/cVar_decl.mli index 373160e29..075c19a23 100644 --- a/infer/src/clang/cVar_decl.mli +++ b/infer/src/clang/cVar_decl.mli @@ -16,7 +16,7 @@ val sil_var_of_decl : CContext.t -> Clang_ast_t.decl -> Procname.t -> Pvar.t val sil_var_of_decl_ref : CContext.t -> Clang_ast_t.decl_ref -> Procname.t -> Pvar.t -val add_var_to_locals : Cfg.Procdesc.t -> Clang_ast_t.decl -> Typ.t -> Pvar.t -> unit +val add_var_to_locals : Procdesc.t -> Clang_ast_t.decl -> Typ.t -> Pvar.t -> unit val compute_autorelease_pool_vars : CContext.t -> Clang_ast_t.stmt list -> (Exp.t * Typ.t) list diff --git a/infer/src/clang/printing.ml b/infer/src/clang/printing.ml index 4fb6b6534..3bf6b4448 100644 --- a/infer/src/clang/printing.ml +++ b/infer/src/clang/printing.ml @@ -57,14 +57,14 @@ let print_procedures cfg = let procs = Cfg.get_all_procs cfg in Logging.do_out "%s" (IList.to_string (fun pdesc -> - let pname = Cfg.Procdesc.get_proc_name pdesc in + let pname = Procdesc.get_proc_name pdesc in "name> "^ (Procname.to_string pname) ^ - " defined? " ^ (string_of_bool (Cfg.Procdesc.is_defined pdesc)) ^ "\n") + " defined? " ^ (string_of_bool (Procdesc.is_defined pdesc)) ^ "\n") procs) let print_nodes nodes = - IList.iter (fun node -> Logging.do_out "%s" (Cfg.Node.get_description pe_text node)) nodes + IList.iter (fun node -> Logging.do_out "%s" (Procdesc.Node.get_description pe_text node)) nodes let instrs_to_string instrs = let pp fmt () = Format.fprintf fmt "%a" (Sil.pp_instr_list pe_text) instrs in diff --git a/infer/src/clang/printing.mli b/infer/src/clang/printing.mli index 9c4be0fb6..681cda134 100644 --- a/infer/src/clang/printing.mli +++ b/infer/src/clang/printing.mli @@ -15,7 +15,7 @@ val print_tenv_struct_unions : Tenv.t -> unit val print_procedures : Cfg.cfg -> unit -val print_nodes : Cfg.Node.t list -> unit +val print_nodes : Procdesc.Node.t list -> unit val instrs_to_string : Sil.instr list -> string diff --git a/infer/src/eradicate/eradicate.ml b/infer/src/eradicate/eradicate.ml index c82687588..51cd50e6c 100644 --- a/infer/src/eradicate/eradicate.ml +++ b/infer/src/eradicate/eradicate.ml @@ -46,7 +46,7 @@ struct let update_summary proc_name proc_desc final_typestate_opt = match Specs.get_summary proc_name with | Some old_summ -> - let nodes = IList.map (fun n -> Cfg.Node.get_id n) (Cfg.Procdesc.get_nodes proc_desc) in + let nodes = IList.map (fun n -> Procdesc.Node.get_id n) (Procdesc.get_nodes proc_desc) in let method_annotation = (Specs.pdesc_resolve_attributes proc_desc).ProcAttributes.method_annotation in let new_summ = @@ -58,7 +58,7 @@ struct Specs.attributes = { old_summ.Specs.attributes with - ProcAttributes.loc = Cfg.Procdesc.get_loc proc_desc; + ProcAttributes.loc = Procdesc.get_loc proc_desc; method_annotation; }; } in @@ -82,7 +82,7 @@ struct (* Check the nullable flag computed for the return value and report inconsistencies. *) let check_return find_canonical_duplicate exit_node final_typestate ret_ia ret_type loc : unit = - let ret_pvar = Cfg.Procdesc.get_ret_var curr_pdesc in + let ret_pvar = Procdesc.get_ret_var curr_pdesc in let ret_range = TypeState.lookup_pvar ret_pvar final_typestate in let typ_found_opt = match ret_range with | Some (typ_found, _, _) -> Some typ_found @@ -106,7 +106,7 @@ struct (TypeState.pp Extension.ext) initial_typestate in let do_after_dataflow find_canonical_duplicate final_typestate = - let exit_node = Cfg.Procdesc.get_exit_node curr_pdesc in + let exit_node = Procdesc.get_exit_node curr_pdesc in let ia, ret_type = annotated_signature.Annotations.ret in check_return find_canonical_duplicate exit_node final_typestate ia ret_type proc_loc in @@ -124,7 +124,7 @@ struct IList.iter (fun typestate_succ -> L.stdout "Typestate After Node %a@\n%a@." - Cfg.Node.pp node + Procdesc.Node.pp node (TypeState.pp Extension.ext) typestate_succ) typestates_succ; typestates_succ, typestates_exn @@ -133,7 +133,7 @@ struct let initial_typestate = get_initial_typestate () in do_before_dataflow initial_typestate; let transitions = DFTypeCheck.run tenv curr_pdesc initial_typestate in - match transitions (Cfg.Procdesc.get_exit_node curr_pdesc) with + match transitions (Procdesc.get_exit_node curr_pdesc) with | DFTypeCheck.Transition (final_typestate, _, _) -> do_after_dataflow find_canonical_duplicate final_typestate; !calls_this, Some final_typestate @@ -155,7 +155,7 @@ struct let find_duplicate_nodes = State.mk_find_duplicate_nodes curr_pdesc in let find_canonical_duplicate node = let duplicate_nodes = find_duplicate_nodes node in - try Cfg.NodeSet.min_elt duplicate_nodes with + try Procdesc.NodeSet.min_elt duplicate_nodes with | Not_found -> node in let typecheck_proc do_checks pname pdesc proc_details_opt = @@ -164,8 +164,8 @@ struct (ann_sig, loc, idenv_pn) | None -> let ann_sig = - Models.get_modelled_annotated_signature (Cfg.Procdesc.get_attributes pdesc) in - let loc = Cfg.Procdesc.get_loc pdesc in + Models.get_modelled_annotated_signature (Procdesc.get_attributes pdesc) in + let loc = Procdesc.get_loc pdesc in let idenv_pn = Idenv.create_from_idenv idenv pdesc in (ann_sig, loc, idenv_pn) in let checks', calls_this' = @@ -181,7 +181,7 @@ struct pname pdesc ann_sig linereader loc in let module Initializers = struct - type init = Procname.t * Cfg.Procdesc.t + type init = Procname.t * Procdesc.t let final_typestates initializers_current_class = (* Get the private methods, from the same class, directly called by the initializers. *) @@ -294,7 +294,7 @@ struct let do_final_typestate typestate_opt calls_this = let do_typestate typestate = - let start_node = Cfg.Procdesc.get_start_node curr_pdesc in + let start_node = Procdesc.get_start_node curr_pdesc in if not calls_this && (* if 'this(...)' is called, no need to check initialization *) check_field_initialization && checks.TypeCheck.eradicate @@ -346,7 +346,7 @@ struct match filter_special_cases () with | None -> () | Some annotated_signature -> - let loc = Cfg.Procdesc.get_loc proc_desc in + let loc = Procdesc.get_loc proc_desc in let linereader = Printer.LineReader.create () in if Config.eradicate_verbose then L.stdout "%a@." @@ -404,7 +404,7 @@ let callback_eradicate Main.callback checks { callback_args with Callbacks.idenv = idenv_pname; - proc_name = (Cfg.Procdesc.get_proc_name pdesc); + proc_name = (Procdesc.get_proc_name pdesc); proc_desc = pdesc; } in { Ondemand.analyze_ondemand; diff --git a/infer/src/eradicate/eradicateChecks.ml b/infer/src/eradicate/eradicateChecks.ml index e1c09ab1f..342279e13 100644 --- a/infer/src/eradicate/eradicateChecks.ml +++ b/infer/src/eradicate/eradicateChecks.ml @@ -112,7 +112,7 @@ let check_condition tenv case_zero find_canonical_duplicate curr_pdesc let contains_instanceof_throwable pdesc node = (* Check if the current procedure has a catch Throwable. *) (* That always happens in the bytecode generated by try-with-resources. *) - let loc = Cfg.Node.get_loc node in + let loc = Procdesc.Node.get_loc node in let throwable_found = ref false in let typ_is_throwable = function | Typ.Tstruct (TN_csu (Class Java, _) as name) -> @@ -124,9 +124,9 @@ let check_condition tenv case_zero find_canonical_duplicate curr_pdesc throwable_found := true | _ -> () in let do_node n = - if Location.equal loc (Cfg.Node.get_loc n) - then IList.iter do_instr (Cfg.Node.get_instrs n) in - Cfg.Procdesc.iter_nodes do_node pdesc; + if Location.equal loc (Procdesc.Node.get_loc n) + then IList.iter do_instr (Procdesc.Node.get_instrs n) in + Procdesc.iter_nodes do_node pdesc; !throwable_found in let from_try_with_resources () : bool = @@ -168,7 +168,7 @@ let check_nonzero tenv find_canonical_duplicate = check_condition tenv false fin let check_field_assignment tenv find_canonical_duplicate curr_pdesc node instr_ref typestate exp_lhs exp_rhs typ loc fname t_ia_opt typecheck_expr : unit = - let curr_pname = Cfg.Procdesc.get_proc_name curr_pdesc in + let curr_pname = Procdesc.get_proc_name curr_pdesc in let (t_lhs, ta_lhs, _) = typecheck_expr node instr_ref curr_pdesc typestate exp_lhs (typ, TypeAnnotation.const Annotations.Nullable false TypeOrigin.ONone, [loc]) loc in @@ -233,7 +233,7 @@ let check_constructor_initialization tenv State.set_node start_node; if Procname.is_constructor curr_pname then begin - match PatternMatch.get_this_type (Cfg.Procdesc.get_attributes curr_pdesc) with + match PatternMatch.get_this_type (Procdesc.get_attributes curr_pdesc) with | Some (Tptr (Tstruct name as ts, _)) -> ( match Tenv.lookup tenv name with | Some { fields } -> @@ -332,7 +332,7 @@ let spec_make_return_nullable curr_pname = let check_return_annotation tenv find_canonical_duplicate curr_pdesc ret_range ret_ia ret_implicitly_nullable loc : unit = - let curr_pname = Cfg.Procdesc.get_proc_name curr_pdesc in + let curr_pname = Procdesc.get_proc_name curr_pdesc in let ret_annotated_nullable = Annotations.ia_is_nullable ret_ia in let ret_annotated_present = Annotations.ia_is_present ret_ia in let ret_annotated_nonnull = Annotations.ia_is_nonnull ret_ia in @@ -493,8 +493,8 @@ let check_call_parameters tenv implemented interfaces *) let check_overridden_annotations find_canonical_duplicate tenv proc_name proc_desc annotated_signature = - let start_node = Cfg.Procdesc.get_start_node proc_desc in - let loc = Cfg.Node.get_loc start_node in + let start_node = Procdesc.get_start_node proc_desc in + let loc = Procdesc.Node.get_loc start_node in let check_return overriden_proc_name overriden_signature = let ret_is_nullable = diff --git a/infer/src/eradicate/typeCheck.ml b/infer/src/eradicate/typeCheck.ml index 012c66ad0..cf9debb06 100644 --- a/infer/src/eradicate/typeCheck.ml +++ b/infer/src/eradicate/typeCheck.ml @@ -142,9 +142,9 @@ module ComplexExpressions = struct end (* ComplexExpressions *) type check_return_type = - Procname.t -> Cfg.Procdesc.t -> Typ.t -> Typ.t option -> Location.t -> unit + Procname.t -> Procdesc.t -> Typ.t -> Typ.t option -> Location.t -> unit -type find_canonical_duplicate = Cfg.Node.t -> Cfg.Node.t +type find_canonical_duplicate = Procdesc.Node.t -> Procdesc.Node.t type get_proc_desc = TypeState.get_proc_desc @@ -157,7 +157,7 @@ type checks = (** Typecheck an expression. *) let rec typecheck_expr - find_canonical_duplicate visited checks tenv node instr_ref (curr_pdesc : Cfg.Procdesc.t) + find_canonical_duplicate visited checks tenv node instr_ref (curr_pdesc : Procdesc.t) typestate e tr_default loc : TypeState.range = match e with | Exp.Lvar pvar -> (match TypeState.lookup_pvar pvar typestate with @@ -236,11 +236,11 @@ let rec typecheck_expr (** Typecheck an instruction. *) let typecheck_instr - tenv ext calls_this checks (node: Cfg.Node.t) idenv get_proc_desc curr_pname + tenv ext calls_this checks (node: Procdesc.Node.t) idenv get_proc_desc curr_pname curr_pdesc find_canonical_duplicate annotated_signature instr_ref linereader typestate instr = (* let print_current_state () = *) (* L.stdout "Current Typestate in node %a@\n%a@." *) - (* Cfg.Node.pp (TypeErr.InstrRef.get_node instr_ref) *) + (* Procdesc.Node.pp (TypeErr.InstrRef.get_node instr_ref) *) (* (TypeState.pp ext) typestate; *) (* L.stdout " %a@." (Sil.pp_instr pe_text) instr in *) @@ -429,7 +429,7 @@ let typecheck_instr annotated_signature.Annotations.params in let is_return pvar = - let ret_pvar = Cfg.Procdesc.get_ret_var curr_pdesc in + let ret_pvar = Procdesc.get_ret_var curr_pdesc in Pvar.equal pvar ret_pvar in (* Apply a function to a pvar and its associated content if front-end generated. *) @@ -702,7 +702,7 @@ let typecheck_instr | _ -> () end | _ -> () in - IList.iter do_instr (Cfg.Node.get_instrs cond_node) in + IList.iter do_instr (Procdesc.Node.get_instrs cond_node) in let handle_optional_isPresent node' e = match convert_complex_exp_to_pvar node' false e typestate' loc with | Exp.Lvar pvar', _ -> @@ -718,7 +718,9 @@ let typecheck_instr (* In foo(cond1 && cond2), the node that sets the result to false has all the negated conditions as parents. *) | Some boolean_assignment_node -> - IList.iter handle_negated_condition (Cfg.Node.get_preds boolean_assignment_node); + IList.iter + handle_negated_condition + (Procdesc.Node.get_preds boolean_assignment_node); !res_typestate | None -> begin @@ -1018,7 +1020,7 @@ let typecheck_instr (* Handle assigment fron a temp pvar in a condition. This recognizes the handling of temp variables in ((x = ...) != null) *) let handle_assignment_in_condition pvar = - match Cfg.Node.get_preds node with + match Procdesc.Node.get_preds node with | [prev_node] -> let found = ref None in let do_instr i = match i with @@ -1026,7 +1028,7 @@ let typecheck_instr when Exp.equal (Exp.Lvar pvar) (Idenv.expand_expr idenv e') -> found := Some e | _ -> () in - IList.iter do_instr (Cfg.Node.get_instrs prev_node); + IList.iter do_instr (Procdesc.Node.get_instrs prev_node); !found | _ -> None in @@ -1060,7 +1062,7 @@ let typecheck_node tenv ext calls_this checks idenv get_proc_desc curr_pname curr_pdesc find_canonical_duplicate annotated_signature typestate node linereader = - let instrs = Cfg.Node.get_instrs node in + let instrs = Procdesc.Node.get_instrs node in let instr_ref_gen = TypeErr.InstrRef.create_generator node in let typestates_exn = ref [] in @@ -1077,7 +1079,7 @@ let typecheck_node typestates_exn := typestate :: !typestates_exn | Sil.Store (Exp.Lvar pv, _, _, _) when Pvar.is_return pv && - Cfg.Node.get_kind node = Cfg.Node.throw_kind -> + Procdesc.Node.get_kind node = Procdesc.Node.throw_kind -> (* throw instruction *) typestates_exn := typestate :: !typestates_exn | _ -> () in @@ -1099,6 +1101,6 @@ let typecheck_node TypeErr.node_reset_forall canonical_node; let typestate_succ = IList.fold_left (do_instruction ext) typestate instrs in - if Cfg.Node.get_kind node = Cfg.Node.exn_sink_kind + if Procdesc.Node.get_kind node = Procdesc.Node.exn_sink_kind then [], [] (* don't propagate exceptions to exit node *) else [typestate_succ], !typestates_exn diff --git a/infer/src/eradicate/typeCheck.mli b/infer/src/eradicate/typeCheck.mli index 888765f51..2fa2db06a 100644 --- a/infer/src/eradicate/typeCheck.mli +++ b/infer/src/eradicate/typeCheck.mli @@ -13,9 +13,9 @@ open! Utils (** Module type for the type checking functions. *) type check_return_type = - Procname.t -> Cfg.Procdesc.t -> Typ.t -> Typ.t option -> Location.t -> unit + Procname.t -> Procdesc.t -> Typ.t -> Typ.t option -> Location.t -> unit -type find_canonical_duplicate = Cfg.Node.t -> Cfg.Node.t +type find_canonical_duplicate = Procdesc.Node.t -> Procdesc.Node.t type get_proc_desc = TypeState.get_proc_desc @@ -29,6 +29,6 @@ type checks = val typecheck_node : Tenv.t -> 'a TypeState.ext -> bool ref -> checks -> Idenv.t -> - get_proc_desc -> Procname.t -> Cfg.Procdesc.t -> + get_proc_desc -> Procname.t -> Procdesc.t -> find_canonical_duplicate -> Annotations.annotated_signature -> 'a TypeState.t -> - Cfg.Node.t -> Printer.LineReader.t -> 'a TypeState.t list * 'a TypeState.t list + Procdesc.Node.t -> Printer.LineReader.t -> 'a TypeState.t list * 'a TypeState.t list diff --git a/infer/src/eradicate/typeErr.ml b/infer/src/eradicate/typeErr.ml index 167c05473..94dacfd4b 100644 --- a/infer/src/eradicate/typeErr.ml +++ b/infer/src/eradicate/typeErr.ml @@ -20,23 +20,23 @@ module type InstrRefT = sig type t type generator - val create_generator : Cfg.Node.t -> generator + val create_generator : Procdesc.Node.t -> generator val equal : t -> t -> bool val gen : generator -> t - val get_node : t -> Cfg.Node.t + val get_node : t -> Procdesc.Node.t val hash : t -> int - val replace_node : t -> Cfg.Node.t -> t + val replace_node : t -> Procdesc.Node.t -> t end (* InstrRefT *) (** Per-node instruction reference. *) module InstrRef : InstrRefT = struct - type t = Cfg.Node.t * int - type generator = Cfg.Node.t * int ref + type t = Procdesc.Node.t * int + type generator = Procdesc.Node.t * int ref let equal (n1, i1) (n2, i2) = - Cfg.Node.equal n1 n2 && i1 = i2 - let hash (n, i) = Hashtbl.hash (Cfg.Node.hash n, i) + Procdesc.Node.equal n1 n2 && i1 = i2 + let hash (n, i) = Hashtbl.hash (Procdesc.Node.hash n, i) let get_node (n, _) = n let replace_node (_, i) n' = (n', i) let create_generator n = (n, ref 0) @@ -227,7 +227,7 @@ let node_reset_forall node = match instr_ref_opt, get_forall err_instance with | Some instr_ref, is_forall -> let node' = InstrRef.get_node instr_ref in - if is_forall && Cfg.Node.equal node node' then err_state.always <- false + if is_forall && Procdesc.Node.equal node node' then err_state.always <- false | None, _ -> () in H.iter iter err_tbl @@ -293,7 +293,7 @@ end (* Strict *) type st_report_error = Procname.t -> - Cfg.Procdesc.t -> + Procdesc.t -> string -> Location.t -> ?advice: string option -> @@ -307,7 +307,7 @@ type st_report_error = (** Report an error right now. *) let report_error_now tenv (st_report_error : st_report_error) err_instance loc pdesc : unit = - let pname = Cfg.Procdesc.get_proc_name pdesc in + let pname = Procdesc.get_proc_name pdesc in let demo_mode = true in let do_print_base ew_string kind_s s = let mname = match pname with diff --git a/infer/src/eradicate/typeErr.mli b/infer/src/eradicate/typeErr.mli index 7a03dcf19..d04c76d46 100644 --- a/infer/src/eradicate/typeErr.mli +++ b/infer/src/eradicate/typeErr.mli @@ -17,12 +17,12 @@ module type InstrRefT = sig type t type generator - val create_generator : Cfg.Node.t -> generator + val create_generator : Procdesc.Node.t -> generator val equal : t -> t -> bool val gen : generator -> t - val get_node : t -> Cfg.Node.t + val get_node : t -> Procdesc.Node.t val hash : t -> int - val replace_node : t -> Cfg.Node.t -> t + val replace_node : t -> Procdesc.Node.t -> t end (* InstrRefT *) module InstrRef : InstrRefT @@ -64,11 +64,11 @@ type err_instance = | Return_over_annotated of Procname.t -val node_reset_forall : Cfg.Node.t -> unit +val node_reset_forall : Procdesc.Node.t -> unit type st_report_error = Procname.t -> - Cfg.Procdesc.t -> + Procdesc.t -> string -> Location.t -> ?advice: string option -> @@ -81,10 +81,10 @@ type st_report_error = val report_error : Tenv.t -> st_report_error -> - (Cfg.Node.t -> Cfg.Node.t) -> + (Procdesc.Node.t -> Procdesc.Node.t) -> err_instance -> InstrRef.t option -> Location.t -> - Cfg.Procdesc.t -> unit + Procdesc.t -> unit -val report_forall_checks_and_reset : Tenv.t -> st_report_error -> Cfg.Procdesc.t -> unit +val report_forall_checks_and_reset : Tenv.t -> st_report_error -> Procdesc.t -> unit val reset : unit -> unit diff --git a/infer/src/eradicate/typeState.ml b/infer/src/eradicate/typeState.ml index 848cb05fa..1a5a1a888 100644 --- a/infer/src/eradicate/typeState.ml +++ b/infer/src/eradicate/typeState.ml @@ -18,7 +18,7 @@ module P = Printf (** Parameters of a call. *) type parameters = (Exp.t * Typ.t) list -type get_proc_desc = Procname.t -> Cfg.Procdesc.t option +type get_proc_desc = Procname.t -> Procdesc.t option (** Extension to a typestate with values of type 'a. *) type 'a ext = @@ -26,7 +26,7 @@ type 'a ext = empty : 'a; (** empty extension *) check_instr : Tenv.t -> get_proc_desc -> Procname.t -> - Cfg.Procdesc.t -> 'a -> Sil.instr -> parameters -> + Procdesc.t -> 'a -> Sil.instr -> parameters -> 'a; (** check the extension for an instruction *) join : 'a -> 'a -> 'a; (** join two extensions *) pp : Format.formatter -> 'a -> unit (** pretty print an extension *) diff --git a/infer/src/eradicate/typeState.mli b/infer/src/eradicate/typeState.mli index 3468df77c..cf275a23d 100644 --- a/infer/src/eradicate/typeState.mli +++ b/infer/src/eradicate/typeState.mli @@ -14,7 +14,7 @@ open! Utils (** Parameters of a call. *) type parameters = (Exp.t * Typ.t) list -type get_proc_desc = Procname.t -> Cfg.Procdesc.t option +type get_proc_desc = Procname.t -> Procdesc.t option (** Extension to a typestate with values of type 'a. *) type 'a ext = @@ -22,7 +22,7 @@ type 'a ext = empty : 'a; (** empty extension *) check_instr : Tenv.t -> get_proc_desc -> Procname.t -> - Cfg.Procdesc.t ->'a -> Sil.instr -> parameters -> + Procdesc.t ->'a -> Sil.instr -> parameters -> 'a; (** check the extension for an instruction *) join : 'a -> 'a -> 'a; (** join two extensions *) pp : Format.formatter -> 'a -> unit (** pretty print an extension *) diff --git a/infer/src/harness/inhabit.ml b/infer/src/harness/inhabit.ml index 881133176..4a6c6cdc6 100644 --- a/infer/src/harness/inhabit.ml +++ b/infer/src/harness/inhabit.ml @@ -41,7 +41,7 @@ let procdesc_from_name cfg pname = let formals_from_name cfg pname = match procdesc_from_name cfg pname with - | Some pdesc -> Cfg.Procdesc.get_formals pdesc + | Some pdesc -> Procdesc.get_formals pdesc | None -> [] (** add an instruction to the env, update tmp_vars, and bump the pc *) @@ -172,7 +172,7 @@ and inhabit_constructor tenv constr_name (allocated_obj, obj_type) cfg env = let inhabit_call_with_args procname procdesc args env = let retval = - let ret_typ = Cfg.Procdesc.get_ret_type procdesc in + let ret_typ = Procdesc.get_ret_type procdesc in let is_void = ret_typ = Typ.Tvoid in if is_void then None else Some (Ident.create_fresh Ident.knormal, ret_typ) in let call_instr = @@ -188,7 +188,7 @@ let inhabit_call tenv (procname, receiver) cfg env = match procdesc_from_name cfg procname with | Some procdesc -> (* swap the type of the 'this' formal with the receiver type, if there is one *) - let formals = match (Cfg.Procdesc.get_formals procdesc, receiver) with + let formals = match (Procdesc.get_formals procdesc, receiver) with | ((name, _) :: formals, Some receiver) -> (name, receiver) :: formals | (formals, None) -> formals | ([], Some _) -> @@ -230,7 +230,7 @@ let add_harness_to_cg harness_name harness_node cg = Cg.add_defined_node cg (Procname.Java harness_name); IList.iter (fun p -> Cg.add_edge cg (Procname.Java harness_name) p) - (Cfg.Node.get_callees harness_node) + (Procdesc.Node.get_callees harness_node) (** create and fill the appropriate nodes and add them to the harness cfg. also add the harness * proc to the cg *) @@ -248,18 +248,18 @@ let setup_harness_cfg harness_name env cg cfg = let harness_node = (* important to reverse the list or there will be scoping issues! *) let instrs = (IList.rev env.instrs) in - let nodekind = Cfg.Node.Stmt_node "method_body" in - Cfg.Procdesc.create_node procdesc env.pc nodekind instrs in + let nodekind = Procdesc.Node.Stmt_node "method_body" in + Procdesc.create_node procdesc env.pc nodekind instrs in let (start_node, exit_node) = - let create_node kind = Cfg.Procdesc.create_node procdesc env.pc kind [] in - let start_kind = Cfg.Node.Start_node procname in - let exit_kind = Cfg.Node.Exit_node procname in + let create_node kind = Procdesc.create_node procdesc env.pc kind [] in + let start_kind = Procdesc.Node.Start_node procname in + let exit_kind = Procdesc.Node.Exit_node procname in (create_node start_kind, create_node exit_kind) in - Cfg.Procdesc.set_start_node procdesc start_node; - Cfg.Procdesc.set_exit_node procdesc exit_node; - Cfg.Node.add_locals_ret_declaration start_node proc_attributes []; - Cfg.Procdesc.node_set_succs_exn procdesc start_node [harness_node] [exit_node]; - Cfg.Procdesc.node_set_succs_exn procdesc harness_node [exit_node] [exit_node]; + Procdesc.set_start_node procdesc start_node; + Procdesc.set_exit_node procdesc exit_node; + Procdesc.Node.add_locals_ret_declaration start_node proc_attributes []; + Procdesc.node_set_succs_exn procdesc start_node [harness_node] [exit_node]; + Procdesc.node_set_succs_exn procdesc harness_node [exit_node] [exit_node]; add_harness_to_cg harness_name harness_node cg (** create a procedure named harness_name that calls each of the methods in trace in the specified diff --git a/infer/src/java/jContext.ml b/infer/src/java/jContext.ml index 507d14243..c368af6fa 100644 --- a/infer/src/java/jContext.ml +++ b/infer/src/java/jContext.ml @@ -13,7 +13,7 @@ open! Utils open Javalib_pack open Sawja_pack -module NodeTbl = Cfg.NodeHash +module NodeTbl = Procdesc.NodeHash type jump_kind = | Next @@ -29,7 +29,7 @@ type icfg = { type t = { icfg : icfg; - procdesc : Cfg.Procdesc.t; + procdesc : Procdesc.t; impl : JBir.t; mutable var_map : (Pvar.t * Typ.t * Typ.t) JBir.VarMap.t; if_jumps : int NodeTbl.t; @@ -67,7 +67,7 @@ let get_or_set_pvar_type context var typ = else set_var_map context (JBir.VarMap.add var (pvar, typ, typ) var_map); (pvar, typ) with Not_found -> - let procname = (Cfg.Procdesc.get_proc_name context.procdesc) in + let procname = (Procdesc.get_proc_name context.procdesc) in let varname = Mangled.from_string (JBir.var_name_g var) in let pvar = Pvar.mk varname procname in set_var_map context (JBir.VarMap.add var (pvar, typ, typ) var_map); @@ -119,10 +119,10 @@ let exn_node_table = Procname.Hash.create 100 let reset_exn_node_table () = Procname.Hash.clear exn_node_table -let add_exn_node procname (exn_node : Cfg.Node.t) = +let add_exn_node procname (exn_node : Procdesc.Node.t) = Procname.Hash.add exn_node_table procname exn_node let get_exn_node procdesc = try - Some (Procname.Hash.find exn_node_table (Cfg.Procdesc.get_proc_name procdesc)) + Some (Procname.Hash.find exn_node_table (Procdesc.get_proc_name procdesc)) with Not_found -> None diff --git a/infer/src/java/jContext.mli b/infer/src/java/jContext.mli index 71a18f1ee..7a0e39e6e 100644 --- a/infer/src/java/jContext.mli +++ b/infer/src/java/jContext.mli @@ -22,7 +22,7 @@ type jump_kind = (** Hastable for storing nodes that correspond to if-instructions. These are used when adding the edges in the contrl flow graph. *) -module NodeTbl : Hashtbl.S with type key = Cfg.Node.t +module NodeTbl : Hashtbl.S with type key = Procdesc.Node.t (** data structure for saving the three structures tht contain the intermediate @@ -37,7 +37,7 @@ type icfg = { (** data structure for storing the context elements. *) type t = private { icfg : icfg; - procdesc : Cfg.Procdesc.t; + procdesc : Procdesc.t; impl : JBir.t; mutable var_map : (Pvar.t * Typ.t * Typ.t) JBir.VarMap.t; if_jumps : int NodeTbl.t; @@ -51,7 +51,7 @@ type t = private (** cretes a context for a given method. *) val create_context : icfg -> - Cfg.Procdesc.t -> + Procdesc.t -> JBir.t -> JBasics.class_name -> DB.source_file -> @@ -68,10 +68,10 @@ val get_cg : t -> Cg.t val get_cfg : t -> Cfg.cfg (** adds to the context the line that an if-node will jump to *) -val add_if_jump : t -> Cfg.Node.t -> int -> unit +val add_if_jump : t -> Procdesc.Node.t -> int -> unit (** returns whether the given node corresponds to an if-instruction *) -val get_if_jump : t -> Cfg.Node.t -> int option +val get_if_jump : t -> Procdesc.Node.t -> int option (** adds to the context the line that the node in the given line will jump to. *) val add_goto_jump : t -> int -> jump_kind -> unit @@ -96,7 +96,7 @@ val reset_pvar_type : t -> unit val reset_exn_node_table : unit -> unit (** adds the exception node for a given method *) -val add_exn_node : Procname.t -> Cfg.Node.t -> unit +val add_exn_node : Procname.t -> Procdesc.Node.t -> unit (** returns the exception node of a given method *) -val get_exn_node : Cfg.Procdesc.t -> Cfg.Node.t option +val get_exn_node : Procdesc.t -> Procdesc.Node.t option diff --git a/infer/src/java/jFrontend.ml b/infer/src/java/jFrontend.ml index 1c5eece75..fbe59a7bf 100644 --- a/infer/src/java/jFrontend.ml +++ b/infer/src/java/jFrontend.ml @@ -48,7 +48,7 @@ let add_edges if super_call then (fun _ -> exit_nodes) else JTransExn.create_exception_handlers context [exn_node] get_body_nodes impl in let connect node pc = - Cfg.Procdesc.node_set_succs_exn + Procdesc.node_set_succs_exn context.procdesc node (get_succ_nodes node pc) (get_exn_nodes pc) in let connect_nodes pc translated_instruction = match translated_instruction with @@ -58,7 +58,7 @@ let add_edges connect node_true pc; connect node_false pc | JTrans.Loop (join_node, node_true, node_false) -> - Cfg.Procdesc.node_set_succs_exn context.procdesc join_node [node_true; node_false] []; + Procdesc.node_set_succs_exn context.procdesc join_node [node_true; node_false] []; connect node_true pc; connect node_false pc in let first_nodes = @@ -66,11 +66,11 @@ let add_edges direct_successors (-1) in (* the exceptions edges here are going directly to the exit node *) - Cfg.Procdesc.node_set_succs_exn context.procdesc start_node first_nodes exit_nodes; + Procdesc.node_set_succs_exn context.procdesc start_node first_nodes exit_nodes; if not super_call then (* the exceptions node is just before the exit node *) - Cfg.Procdesc.node_set_succs_exn context.procdesc exn_node exit_nodes exit_nodes; + Procdesc.node_set_succs_exn context.procdesc exn_node exit_nodes exit_nodes; Array.iteri connect_nodes method_body_nodes @@ -80,8 +80,8 @@ let add_cmethod source_file program linereader icfg cm proc_name = match JTrans.create_cm_procdesc source_file program linereader icfg cm proc_name with | None -> () | Some (procdesc, impl) -> - let start_node = Cfg.Procdesc.get_start_node procdesc in - let exit_node = Cfg.Procdesc.get_exit_node procdesc in + let start_node = Procdesc.get_start_node procdesc in + let exit_node = Procdesc.get_exit_node procdesc in let exn_node = match JContext.get_exn_node procdesc with | Some node -> node diff --git a/infer/src/java/jTrans.ml b/infer/src/java/jTrans.ml index d06ad877f..2f9d349ba 100644 --- a/infer/src/java/jTrans.ml +++ b/infer/src/java/jTrans.ml @@ -235,7 +235,7 @@ let trans_access = function | `Private -> PredSymb.Private | `Protected -> PredSymb.Protected -let create_am_procdesc program icfg am proc_name : Cfg.Procdesc.t = +let create_am_procdesc program icfg am proc_name : Procdesc.t = let cfg = icfg.JContext.cfg in let tenv = icfg.JContext.tenv in let m = Javalib.AbstractMethod am in @@ -258,13 +258,13 @@ let create_am_procdesc program icfg am proc_name : Cfg.Procdesc.t = ret_type = JTransType.return_type program tenv ms; } in Cfg.create_proc_desc cfg proc_attributes in - let start_kind = Cfg.Node.Start_node proc_name in - let start_node = Cfg.Procdesc.create_node procdesc Location.dummy start_kind [] in - let exit_kind = (Cfg.Node.Exit_node proc_name) in - let exit_node = Cfg.Procdesc.create_node procdesc Location.dummy exit_kind [] in - Cfg.Procdesc.node_set_succs_exn procdesc start_node [exit_node] [exit_node]; - Cfg.Procdesc.set_start_node procdesc start_node; - Cfg.Procdesc.set_exit_node procdesc exit_node; + let start_kind = Procdesc.Node.Start_node proc_name in + let start_node = Procdesc.create_node procdesc Location.dummy start_kind [] in + let exit_kind = (Procdesc.Node.Exit_node proc_name) in + let exit_node = Procdesc.create_node procdesc Location.dummy exit_kind [] in + Procdesc.node_set_succs_exn procdesc start_node [exit_node] [exit_node]; + Procdesc.set_start_node procdesc start_node; + Procdesc.set_exit_node procdesc exit_node; procdesc let create_native_procdesc program icfg cm proc_name = @@ -323,16 +323,16 @@ let create_cm_procdesc source_file program linereader icfg cm proc_name = } in let procdesc = Cfg.create_proc_desc cfg proc_attributes in - let start_kind = Cfg.Node.Start_node proc_name in - let start_node = Cfg.Procdesc.create_node procdesc loc_start start_kind [] in - let exit_kind = (Cfg.Node.Exit_node proc_name) in - let exit_node = Cfg.Procdesc.create_node procdesc loc_exit exit_kind [] in - let exn_kind = Cfg.Node.exn_sink_kind in - let exn_node = Cfg.Procdesc.create_node procdesc loc_exit exn_kind [] in + let start_kind = Procdesc.Node.Start_node proc_name in + let start_node = Procdesc.create_node procdesc loc_start start_kind [] in + let exit_kind = (Procdesc.Node.Exit_node proc_name) in + let exit_node = Procdesc.create_node procdesc loc_exit exit_kind [] in + let exn_kind = Procdesc.Node.exn_sink_kind in + let exn_node = Procdesc.create_node procdesc loc_exit exn_kind [] in JContext.add_exn_node proc_name exn_node; - Cfg.Procdesc.set_start_node procdesc start_node; - Cfg.Procdesc.set_exit_node procdesc exit_node; - Cfg.Node.add_locals_ret_declaration start_node proc_attributes locals; + Procdesc.set_start_node procdesc start_node; + Procdesc.set_exit_node procdesc exit_node; + Procdesc.Node.add_locals_ret_declaration start_node proc_attributes locals; procdesc in Some (procdesc, impl) with JBir.Subroutine -> @@ -371,7 +371,7 @@ let rec expression (context : JContext.t) pc expr = match c with (* We use the constant internally to mean a variable. *) | `String s when (JBasics.jstr_pp s) = JConfig.field_cst -> let varname = JConfig.field_st in - let procname = (Cfg.Procdesc.get_proc_name context.procdesc) in + let procname = (Procdesc.get_proc_name context.procdesc) in let pvar = Pvar.mk varname procname in trans_var pvar | _ -> ([], Exp.Const (get_constant c), type_of_expr) @@ -616,9 +616,9 @@ let detect_loop entry_pc impl = type translation = | Skip - | Instr of Cfg.Node.t - | Prune of Cfg.Node.t * Cfg.Node.t - | Loop of Cfg.Node.t * Cfg.Node.t * Cfg.Node.t + | Instr of Procdesc.Node.t + | Prune of Procdesc.Node.t * Procdesc.Node.t + | Loop of Procdesc.Node.t * Procdesc.Node.t * Procdesc.Node.t (* TODO: unclear if this corresponds to what JControlFlow.resolve_method'*) (* is trying to do. Normally, this implementation below goes deeper into *) @@ -705,14 +705,14 @@ let rec instruction (context : JContext.t) pc instr : translation = let tenv = JContext.get_tenv context in let cg = JContext.get_cg context in let program = context.program in - let proc_name = Cfg.Procdesc.get_proc_name context.procdesc in + let proc_name = Procdesc.get_proc_name context.procdesc in let ret_var = Pvar.get_ret_pvar proc_name in - let ret_type = Cfg.Procdesc.get_ret_type context.procdesc in + let ret_type = Procdesc.get_ret_type context.procdesc in let loc = get_location context.source_file context.impl pc in let file = loc.Location.file in let match_never_null = Inferconfig.never_return_null_matcher in let create_node node_kind sil_instrs = - Cfg.Procdesc.create_node context.procdesc loc node_kind sil_instrs in + Procdesc.create_node context.procdesc loc node_kind sil_instrs in let return_not_null () = match_never_null loc.Location.file proc_name in let trans_monitor_enter_exit context expr pc loc builtin node_desc = @@ -723,7 +723,7 @@ let rec instruction (context : JContext.t) pc instr : translation = | Typ.Tptr (typ, _) -> typ | _ -> sil_type in let deref_instr = create_sil_deref sil_expr typ_no_ptr loc in - let node_kind = Cfg.Node.Stmt_node node_desc in + let node_kind = Procdesc.Node.Stmt_node node_desc in Instr (create_node node_kind (instrs @ [deref_instr; instr] )) in try match instr with @@ -731,11 +731,11 @@ let rec instruction (context : JContext.t) pc instr : translation = let (stml, sil_expr, sil_type) = expression context pc expr in let pvar = (JContext.set_pvar context var sil_type) in let sil_instr = Sil.Store (Exp.Lvar pvar, sil_type, sil_expr, loc) in - let node_kind = Cfg.Node.Stmt_node "method_body" in + let node_kind = Procdesc.Node.Stmt_node "method_body" in let node = create_node node_kind (stml @ [sil_instr]) in Instr node | JBir.Return expr_option -> - let node_kind = Cfg.Node.Stmt_node "method_body" in + let node_kind = Procdesc.Node.Stmt_node "method_body" in let node = match expr_option with | None -> @@ -759,7 +759,7 @@ let rec instruction (context : JContext.t) pc instr : translation = Sil.Store ( Exp.Lindex (sil_expr_array, sil_expr_index), value_typ, sil_expr_value, loc) in let final_instrs = instrs_array @ instrs_index @ instrs_value @ [sil_instr] in - let node_kind = Cfg.Node.Stmt_node "method_body" in + let node_kind = Procdesc.Node.Stmt_node "method_body" in let node = create_node node_kind final_instrs in Instr node | JBir.AffectField (e_lhs, cn, fs, e_rhs) -> @@ -770,7 +770,7 @@ let rec instruction (context : JContext.t) pc instr : translation = let type_of_the_root_of_e_lhs = type_of_the_surrounding_class in let expr_off = Exp.Lfield(sil_expr_lhs, field_name, type_of_the_surrounding_class) in let sil_instr = Sil.Store (expr_off, type_of_the_root_of_e_lhs, sil_expr_rhs, loc) in - let node_kind = Cfg.Node.Stmt_node "method_body" in + let node_kind = Procdesc.Node.Stmt_node "method_body" in let node = create_node node_kind (stml1 @ stml2 @ [sil_instr]) in Instr node | JBir.AffectStaticField (cn, fs, e_rhs) -> @@ -785,7 +785,7 @@ let rec instruction (context : JContext.t) pc instr : translation = let type_of_the_root_of_e_lhs = type_of_the_surrounding_class in let expr_off = Exp.Lfield(sil_expr_lhs, field_name, type_of_the_surrounding_class) in let sil_instr = Sil.Store (expr_off, type_of_the_root_of_e_lhs, sil_expr_rhs, loc) in - let node_kind = Cfg.Node.Stmt_node "method_body" in + let node_kind = Procdesc.Node.Stmt_node "method_body" in let node = create_node node_kind (stml1 @ stml2 @ [sil_instr]) in Instr node | JBir.Goto goto_pc -> @@ -801,14 +801,14 @@ let rec instruction (context : JContext.t) pc instr : translation = let sil_test_true = Exp.UnOp(Unop.LNot, sil_test_false, None) in let sil_instrs_true = Sil.Prune (sil_test_true, loc, true, Sil.Ik_if) in let sil_instrs_false = Sil.Prune (sil_test_false, loc, false, Sil.Ik_if) in - let node_kind_true = Cfg.Node.Prune_node (true, Sil.Ik_if, "method_body") in - let node_kind_false = Cfg.Node.Prune_node (false, Sil.Ik_if, "method_body") in + let node_kind_true = Procdesc.Node.Prune_node (true, Sil.Ik_if, "method_body") in + let node_kind_false = Procdesc.Node.Prune_node (false, Sil.Ik_if, "method_body") in let prune_node_true = create_node node_kind_true (instrs1 @ instrs2 @ [sil_instrs_true]) and prune_node_false = create_node node_kind_false (instrs1 @ instrs2 @ [sil_instrs_false]) in JContext.add_if_jump context prune_node_false if_pc; if detect_loop pc context.impl then - let join_node_kind = Cfg.Node.Join_node in + let join_node_kind = Procdesc.Node.Join_node in let join_node = create_node join_node_kind [] in Loop (join_node, prune_node_true, prune_node_false) else @@ -817,7 +817,7 @@ let rec instruction (context : JContext.t) pc instr : translation = let (instrs, sil_expr, _) = expression context pc expr in let sil_exn = Exp.Exn sil_expr in let sil_instr = Sil.Store (Exp.Lvar ret_var, ret_type, sil_exn, loc) in - let node = create_node Cfg.Node.throw_kind (instrs @ [sil_instr]) in + let node = create_node Procdesc.Node.throw_kind (instrs @ [sil_instr]) in JContext.add_goto_jump context pc JContext.Exit; Instr node | JBir.New (var, cn, constr_type_list, constr_arg_list) -> @@ -837,9 +837,9 @@ let rec instruction (context : JContext.t) pc instr : translation = let pvar = JContext.set_pvar context var class_type in let set_instr = Sil.Store (Exp.Lvar pvar, class_type, Exp.Var ret_id, loc) in let instrs = (new_instr :: call_instrs) @ [set_instr] in - let node_kind = Cfg.Node.Stmt_node ("Call "^(Procname.to_string constr_procname)) in + let node_kind = Procdesc.Node.Stmt_node ("Call "^(Procname.to_string constr_procname)) in let node = create_node node_kind instrs in - let caller_procname = (Cfg.Procdesc.get_proc_name context.procdesc) in + let caller_procname = (Procdesc.get_proc_name context.procdesc) in Cg.add_edge cg caller_procname constr_procname; Instr node | JBir.NewArray (var, vt, expr_list) -> @@ -854,7 +854,7 @@ let rec instruction (context : JContext.t) pc instr : translation = Sil.Call (Some (ret_id, array_type), builtin_new_array, call_args, loc, CallFlags.default) in let set_instr = Sil.Store (Exp.Lvar array_name, array_type, Exp.Var ret_id, loc) in - let node_kind = Cfg.Node.Stmt_node "method_body" in + let node_kind = Procdesc.Node.Stmt_node "method_body" in let node = create_node node_kind (instrs @ [call_instr; set_instr]) in Instr node | JBir.InvokeStatic (var_opt, cn, ms, args) -> @@ -868,20 +868,20 @@ let rec instruction (context : JContext.t) pc instr : translation = | _ -> None, args, [] in let callee_procname, call_instrs = method_invocation context loc pc var_opt cn ms sil_obj_opt args I_Static Procname.Static in - let node_kind = Cfg.Node.Stmt_node ("Call "^(Procname.to_string callee_procname)) in + let node_kind = Procdesc.Node.Stmt_node ("Call "^(Procname.to_string callee_procname)) in let call_node = create_node node_kind (instrs @ call_instrs) in - let caller_procname = (Cfg.Procdesc.get_proc_name context.procdesc) in + let caller_procname = (Procdesc.get_proc_name context.procdesc) in Cg.add_edge cg caller_procname callee_procname; Instr call_node | JBir.InvokeVirtual (var_opt, obj, call_kind, ms, args) -> - let caller_procname = (Cfg.Procdesc.get_proc_name context.procdesc) in + let caller_procname = (Procdesc.get_proc_name context.procdesc) in let (instrs, sil_obj_expr, sil_obj_type) = expression context pc obj in let create_call_node cn invoke_kind = let callee_procname, call_instrs = let ret_opt = Some (sil_obj_expr, sil_obj_type) in method_invocation context loc pc var_opt cn ms ret_opt args invoke_kind Procname.Non_Static in - let node_kind = Cfg.Node.Stmt_node ("Call "^(Procname.to_string callee_procname)) in + let node_kind = Procdesc.Node.Stmt_node ("Call "^(Procname.to_string callee_procname)) in let call_node = create_node node_kind (instrs @ call_instrs) in Cg.add_edge cg caller_procname callee_procname; call_node in @@ -911,10 +911,10 @@ let rec instruction (context : JContext.t) pc instr : translation = let (instrs, sil_obj_expr, sil_obj_type) = expression context pc obj in let callee_procname, call_instrs = method_invocation context loc pc var_opt cn ms (Some (sil_obj_expr, sil_obj_type)) args I_Special Procname.Non_Static in - let node_kind = Cfg.Node.Stmt_node ("Call "^(Procname.to_string callee_procname)) in + let node_kind = Procdesc.Node.Stmt_node ("Call "^(Procname.to_string callee_procname)) in let call_node = create_node node_kind (instrs @ call_instrs) in let procdesc = context.procdesc in - let caller_procname = (Cfg.Procdesc.get_proc_name procdesc) in + let caller_procname = (Procdesc.get_proc_name procdesc) in Cg.add_edge cg caller_procname callee_procname; Instr call_node @@ -924,7 +924,7 @@ let rec instruction (context : JContext.t) pc instr : translation = let (instrs, sil_expr, _) = expression context pc expr in let this_not_null_node = create_node - (Cfg.Node.Stmt_node "this not null") (instrs @ [assume_not_null loc sil_expr]) in + (Procdesc.Node.Stmt_node "this not null") (instrs @ [assume_not_null loc sil_expr]) in Instr this_not_null_node | JBir.Check (JBir.CheckNullPointer expr) when Config.report_runtime_exceptions -> @@ -932,12 +932,12 @@ let rec instruction (context : JContext.t) pc instr : translation = let not_null_node = let sil_not_null = Exp.BinOp (Binop.Ne, sil_expr, Exp.null) in let sil_prune_not_null = Sil.Prune (sil_not_null, loc, true, Sil.Ik_if) - and not_null_kind = Cfg.Node.Prune_node (true, Sil.Ik_if, "Not null") in + and not_null_kind = Procdesc.Node.Prune_node (true, Sil.Ik_if, "Not null") in create_node not_null_kind (instrs @ [sil_prune_not_null]) in let throw_npe_node = let sil_is_null = Exp.BinOp (Binop.Eq, sil_expr, Exp.null) in let sil_prune_null = Sil.Prune (sil_is_null, loc, true, Sil.Ik_if) - and npe_kind = Cfg.Node.Stmt_node "Throw NPE" + and npe_kind = Procdesc.Node.Stmt_node "Throw NPE" and npe_cn = JBasics.make_cn JConfig.npe_cl in let class_type = JTransType.get_class_type program tenv npe_cn and class_type_np = JTransType.get_class_type_no_pointer program tenv npe_cn in @@ -970,7 +970,7 @@ let rec instruction (context : JContext.t) pc instr : translation = let in_bound_node = let in_bound_node_kind = - Cfg.Node.Prune_node (true, Sil.Ik_if, "In bound") in + Procdesc.Node.Prune_node (true, Sil.Ik_if, "In bound") in let sil_assume_in_bound = let sil_in_bound = let sil_positive_index = @@ -983,7 +983,7 @@ let rec instruction (context : JContext.t) pc instr : translation = and throw_out_of_bound_node = let out_of_bound_node_kind = - Cfg.Node.Stmt_node "Out of bound" in + Procdesc.Node.Stmt_node "Out of bound" in let sil_assume_out_of_bound = let sil_out_of_bound = let sil_negative_index = @@ -1026,12 +1026,12 @@ let rec instruction (context : JContext.t) pc instr : translation = let is_instance_node = let check_is_false = Exp.BinOp (Binop.Ne, res_ex, Exp.zero) in let asssume_instance_of = Sil.Prune (check_is_false, loc, true, Sil.Ik_if) - and instance_of_kind = Cfg.Node.Prune_node (true, Sil.Ik_if, "Is instance") in + and instance_of_kind = Procdesc.Node.Prune_node (true, Sil.Ik_if, "Is instance") in create_node instance_of_kind (instrs @ [call; asssume_instance_of]) and throw_cast_exception_node = let check_is_true = Exp.BinOp (Binop.Ne, res_ex, Exp.one) in let asssume_not_instance_of = Sil.Prune (check_is_true, loc, true, Sil.Ik_if) - and throw_cast_exception_kind = Cfg.Node.Stmt_node "Class cast exception" + and throw_cast_exception_kind = Procdesc.Node.Stmt_node "Class cast exception" and cce_cn = JBasics.make_cn JConfig.cce_cl in let class_type = JTransType.get_class_type program tenv cce_cn and class_type_np = JTransType.get_class_type_no_pointer program tenv cce_cn in diff --git a/infer/src/java/jTrans.mli b/infer/src/java/jTrans.mli index bfc4867aa..d856f98de 100644 --- a/infer/src/java/jTrans.mli +++ b/infer/src/java/jTrans.mli @@ -16,15 +16,15 @@ open Sawja_pack (** Data structure for storing the results of the translation of an instruction. *) type translation = | Skip - | Instr of Cfg.Node.t - | Prune of Cfg.Node.t * Cfg.Node.t - | Loop of Cfg.Node.t * Cfg.Node.t * Cfg.Node.t + | Instr of Procdesc.Node.t + | Prune of Procdesc.Node.t * Procdesc.Node.t + | Loop of Procdesc.Node.t * Procdesc.Node.t * Procdesc.Node.t val is_java_native : JCode.jcode Javalib.concrete_method -> bool (** Create the procedure description for an abstract method *) val create_am_procdesc : - JClasspath.program -> JContext.icfg -> Javalib.abstract_method -> Procname.t -> Cfg.Procdesc.t + JClasspath.program -> JContext.icfg -> Javalib.abstract_method -> Procname.t -> Procdesc.t (** Create the procedure description for a concrete method *) val create_native_procdesc : @@ -32,7 +32,7 @@ val create_native_procdesc : JContext.icfg -> JCode.jcode Javalib.concrete_method -> Procname.t -> - Cfg.Procdesc.t + Procdesc.t (** [create_procdesc source_file program linereader icfg cm proc_name] creates a procedure description for the concrete method cm and adds it to cfg *) @@ -43,7 +43,7 @@ val create_cm_procdesc : JContext.icfg -> JCode.jcode Javalib.concrete_method -> Procname.t -> - (Cfg.Procdesc.t * JBir.t) option + (Procdesc.t * JBir.t) option (** translates an instruction into a statement node or prune nodes in the cfg *) val instruction : JContext.t -> int -> JBir.instr -> translation diff --git a/infer/src/java/jTransExn.ml b/infer/src/java/jTransExn.ml index b01413fe7..a433b1f6f 100644 --- a/infer/src/java/jTransExn.ml +++ b/infer/src/java/jTransExn.ml @@ -30,9 +30,9 @@ let translate_exceptions (context : JContext.t) exit_nodes get_body_nodes handle let catch_block_table = Hashtbl.create 1 in let exn_message = "exception handler" in let procdesc = context.procdesc in - let create_node loc node_kind instrs = Cfg.Procdesc.create_node procdesc loc node_kind instrs in - let ret_var = Cfg.Procdesc.get_ret_var procdesc in - let ret_type = Cfg.Procdesc.get_ret_type procdesc in + let create_node loc node_kind instrs = Procdesc.create_node procdesc loc node_kind instrs in + let ret_var = Procdesc.get_ret_var procdesc in + let ret_type = Procdesc.get_ret_type procdesc in let id_ret_val = Ident.create_fresh Ident.knormal in (* this is removed in the true branches, and in the false branch of the last handler *) let id_exn_val = Ident.create_fresh Ident.knormal in @@ -46,7 +46,7 @@ let translate_exceptions (context : JContext.t) exit_nodes get_body_nodes handle CallFlags.default) in create_node loc - Cfg.Node.exn_handler_kind + Procdesc.Node.exn_handler_kind [instr_get_ret_val; instr_deactivate_exn; instr_unwrap_ret_val] in let create_entry_block handler_list = try @@ -55,7 +55,7 @@ let translate_exceptions (context : JContext.t) exit_nodes get_body_nodes handle let collect succ_nodes rethrow_exception handler = let catch_nodes = get_body_nodes handler.JBir.e_handler in let loc = match catch_nodes with - | n:: _ -> Cfg.Node.get_loc n + | n:: _ -> Procdesc.Node.get_loc n | [] -> Location.dummy in let exn_type = let class_name = @@ -83,16 +83,16 @@ let translate_exceptions (context : JContext.t) exit_nodes get_body_nodes handle Sil.Store (Exp.Lvar catch_var, ret_type, Exp.Var id_exn_val, loc) in let instr_rethrow_exn = Sil.Store (Exp.Lvar ret_var, ret_type, Exp.Exn (Exp.Var id_exn_val), loc) in - let node_kind_true = Cfg.Node.Prune_node (true, if_kind, exn_message) in - let node_kind_false = Cfg.Node.Prune_node (false, if_kind, exn_message) in + let node_kind_true = Procdesc.Node.Prune_node (true, if_kind, exn_message) in + let node_kind_false = Procdesc.Node.Prune_node (false, if_kind, exn_message) in let node_true = let instrs_true = [instr_call_instanceof; instr_prune_true; instr_set_catch_var] in create_node loc node_kind_true instrs_true in let node_false = let instrs_false = [instr_call_instanceof; instr_prune_false] @ (if rethrow_exception then [instr_rethrow_exn] else []) in create_node loc node_kind_false instrs_false in - Cfg.Procdesc.node_set_succs_exn procdesc node_true catch_nodes exit_nodes; - Cfg.Procdesc.node_set_succs_exn procdesc node_false succ_nodes exit_nodes; + Procdesc.node_set_succs_exn procdesc node_true catch_nodes exit_nodes; + Procdesc.node_set_succs_exn procdesc node_false succ_nodes exit_nodes; let is_finally = handler.JBir.e_catch_type = None in if is_finally then [node_true] (* TODO (#4759480): clean up the translation so prune nodes are not created at all *) @@ -106,10 +106,10 @@ let translate_exceptions (context : JContext.t) exit_nodes get_body_nodes handle let nodes_first_handler = IList.fold_left process_handler exit_nodes (IList.rev handler_list) in let loc = match nodes_first_handler with - | n:: _ -> Cfg.Node.get_loc n + | n:: _ -> Procdesc.Node.get_loc n | [] -> Location.dummy in let entry_node = create_entry_node loc in - Cfg.Procdesc.node_set_succs_exn procdesc entry_node nodes_first_handler exit_nodes; + Procdesc.node_set_succs_exn procdesc entry_node nodes_first_handler exit_nodes; Hashtbl.add catch_block_table handler_list [entry_node] in Hashtbl.iter (fun _ handler_list -> create_entry_block handler_list) handler_table; catch_block_table diff --git a/infer/src/java/jTransExn.mli b/infer/src/java/jTransExn.mli index 6f1cb2b0f..692d236a2 100644 --- a/infer/src/java/jTransExn.mli +++ b/infer/src/java/jTransExn.mli @@ -13,4 +13,6 @@ open! Utils open Sawja_pack -val create_exception_handlers : JContext.t -> Cfg.Node.t list -> (int -> Cfg.Node.t list) -> JBir.t -> int -> Cfg.Node.t list +val create_exception_handlers : + JContext.t -> Procdesc.Node.t list -> (int -> Procdesc.Node.t list) -> + JBir.t -> int -> Procdesc.Node.t list diff --git a/infer/src/quandary/TaintAnalysis.ml b/infer/src/quandary/TaintAnalysis.ml index 7bf44d5ca..606b993e2 100644 --- a/infer/src/quandary/TaintAnalysis.ml +++ b/infer/src/quandary/TaintAnalysis.ml @@ -99,7 +99,7 @@ module Make (TaintSpec : TaintSpec.S) = struct | Some _ as node_opt -> node_opt | None when is_rooted_in_environment access_path proc_data.extras -> - let call_site = CallSite.make (Cfg.Procdesc.get_proc_name proc_data.ProcData.pdesc) loc in + let call_site = CallSite.make (Procdesc.get_proc_name proc_data.ProcData.pdesc) loc in let trace = TraceDomain.of_source (TraceDomain.Source.make_footprint access_path call_site) in Some (TaintDomain.make_normal_leaf trace) @@ -173,7 +173,7 @@ module Make (TaintSpec : TaintSpec.S) = struct trace | paths -> let report_error path = - let caller_pname = Cfg.Procdesc.get_proc_name proc_data.pdesc in + let caller_pname = Procdesc.get_proc_name proc_data.pdesc in let msg = Localise.to_string Localise.quandary_taint_error in let trace_str = F.asprintf "%a" pp_path_short path in let exn = Exceptions.Checkers (msg, Localise.verbatim_desc trace_str) in @@ -326,7 +326,7 @@ module Make (TaintSpec : TaintSpec.S) = struct failwithf "Assignment to unexpected lhs expression %a in proc %a at loc %a" Exp.pp lhs_exp - Procname.pp (Cfg.Procdesc.get_proc_name (proc_data.pdesc)) + Procname.pp (Procdesc.get_proc_name (proc_data.pdesc)) Location.pp loc in let astate' = analyze_assignment @@ -357,7 +357,7 @@ module Make (TaintSpec : TaintSpec.S) = struct failwithf "Unexpected cast %a in procedure %a at line %a" (Sil.pp_instr pe_text) instr - Procname.pp (Cfg.Procdesc.get_proc_name (proc_data.pdesc)) + Procname.pp (Procdesc.get_proc_name (proc_data.pdesc)) Location.pp loc else astate @@ -516,8 +516,8 @@ module Make (TaintSpec : TaintSpec.S) = struct let checker { Callbacks.get_proc_desc; proc_name; proc_desc; tenv; } = let analyze_ondemand _ pdesc = let make_formal_access_paths pdesc = - let pname = Cfg.Procdesc.get_proc_name pdesc in - let attrs = Cfg.Procdesc.get_attributes pdesc in + let pname = Procdesc.get_proc_name pdesc in + let attrs = Procdesc.get_attributes pdesc in let formals_with_nums = IList.mapi (fun index (name, typ) -> @@ -530,7 +530,7 @@ module Make (TaintSpec : TaintSpec.S) = struct formals_with_nums in let has_body pdesc = - let attrs = Cfg.Procdesc.get_attributes pdesc in + let attrs = Procdesc.get_attributes pdesc in attrs.is_defined && not attrs.is_abstract in if has_body pdesc then @@ -541,9 +541,9 @@ module Make (TaintSpec : TaintSpec.S) = struct match Analyzer.compute_post proc_data with | Some { access_tree; } -> let summary = make_summary formals access_tree in - Summary.write_summary (Cfg.Procdesc.get_proc_name pdesc) summary; + Summary.write_summary (Procdesc.get_proc_name pdesc) summary; | None -> - if Cfg.Node.get_succs (Cfg.Procdesc.get_start_node pdesc) = [] + if Procdesc.Node.get_succs (Procdesc.get_start_node pdesc) = [] then () else failwith "Couldn't compute post" end in diff --git a/infer/src/unit/analyzerTester.ml b/infer/src/unit/analyzerTester.ml index a93643654..a262ac7dc 100644 --- a/infer/src/unit/analyzerTester.ml +++ b/infer/src/unit/analyzerTester.ml @@ -156,7 +156,7 @@ module StructuredSil = struct end module Make - (CFG : ProcCfg.S with type node = Cfg.Node.t) + (CFG : ProcCfg.S with type node = Procdesc.Node.t) (S : Scheduler.Make) (T : TransferFunctions.Make) = struct @@ -171,16 +171,16 @@ module Make let cfg = Cfg.create_cfg () in let pdesc = Cfg.create_proc_desc cfg (ProcAttributes.default test_pname !Config.curr_language) in - let pname = Cfg.Procdesc.get_proc_name pdesc in + let pname = Procdesc.get_proc_name pdesc in let create_node kind cmds = - Cfg.Procdesc.create_node pdesc dummy_loc kind cmds in + Procdesc.create_node pdesc dummy_loc kind cmds in let set_succs cur_node succs ~exn_handlers= - Cfg.Procdesc.node_set_succs_exn pdesc cur_node succs exn_handlers in + Procdesc.node_set_succs_exn pdesc cur_node succs exn_handlers in let mk_prune_nodes_for_cond cond_exp if_kind = let mk_prune_node cond_exp if_kind true_branch = let prune_instr = Sil.Prune (cond_exp, dummy_loc, true_branch, if_kind) in - create_node (Cfg.Node.Prune_node (true_branch, if_kind, "")) [prune_instr] in + create_node (Procdesc.Node.Prune_node (true_branch, if_kind, "")) [prune_instr] in let true_prune_node = mk_prune_node cond_exp if_kind true in let false_prune_node = let negated_cond_exp = Exp.UnOp (Unop.LNot, cond_exp, None) in @@ -189,7 +189,7 @@ module Make let rec structured_instr_to_node (last_node, assert_map) exn_handlers = function | Cmd cmd -> - let node = create_node (Cfg.Node.Stmt_node "") [cmd] in + let node = create_node (Procdesc.Node.Stmt_node "") [cmd] in set_succs last_node [node] ~exn_handlers; node, assert_map | If (exp, then_instrs, else_instrs) -> @@ -199,34 +199,34 @@ module Make structured_instrs_to_node then_prune_node assert_map exn_handlers then_instrs in let else_branch_end_node, assert_map'' = structured_instrs_to_node else_prune_node assert_map' exn_handlers else_instrs in - let join_node = create_node Cfg.Node.Join_node [] in + let join_node = create_node Procdesc.Node.Join_node [] in set_succs then_branch_end_node [join_node] ~exn_handlers; set_succs else_branch_end_node [join_node] ~exn_handlers; join_node, assert_map'' | While (exp, body_instrs) -> - let loop_head_join_node = create_node Cfg.Node.Join_node [] in + let loop_head_join_node = create_node Procdesc.Node.Join_node [] in set_succs last_node [loop_head_join_node] ~exn_handlers; let true_prune_node, false_prune_node = mk_prune_nodes_for_cond exp Sil.Ik_while in set_succs loop_head_join_node [true_prune_node; false_prune_node] ~exn_handlers; let loop_body_end_node, assert_map' = structured_instrs_to_node true_prune_node assert_map exn_handlers body_instrs in - let loop_exit_node = create_node (Cfg.Node.Skip_node "") [] in + let loop_exit_node = create_node (Procdesc.Node.Skip_node "") [] in set_succs loop_body_end_node [loop_head_join_node] ~exn_handlers; set_succs false_prune_node [loop_exit_node] ~exn_handlers; loop_exit_node, assert_map' | Try (try_instrs, catch_instrs, finally_instrs) -> - let catch_start_node = create_node (Cfg.Node.Skip_node "exn_handler") [] in + let catch_start_node = create_node (Procdesc.Node.Skip_node "exn_handler") [] in (* use [catch_start_node] as the exn handler *) let try_end_node, assert_map' = structured_instrs_to_node last_node assert_map [catch_start_node] try_instrs in let catch_end_node, assert_map'' = structured_instrs_to_node catch_start_node assert_map' exn_handlers catch_instrs in - let finally_start_node = create_node (Cfg.Node.Skip_node "finally") [] in + let finally_start_node = create_node (Procdesc.Node.Skip_node "finally") [] in set_succs try_end_node [finally_start_node] ~exn_handlers; set_succs catch_end_node [finally_start_node] ~exn_handlers; structured_instrs_to_node finally_start_node assert_map'' exn_handlers finally_instrs | Invariant (inv_str, inv_label) -> - let node = create_node (Cfg.Node.Stmt_node "Invariant") [] in + let node = create_node (Procdesc.Node.Stmt_node "Invariant") [] in set_succs last_node [node] ~exn_handlers; (* add the assertion to be checked after analysis converges *) node, M.add (CFG.id node) (inv_str, inv_label) assert_map @@ -235,14 +235,14 @@ module Make (fun acc instr -> structured_instr_to_node acc exn_handlers instr) (last_node, assert_map) instrs in - let start_node = create_node (Cfg.Node.Start_node pname) [] in - Cfg.Procdesc.set_start_node pdesc start_node; + let start_node = create_node (Procdesc.Node.Start_node pname) [] in + Procdesc.set_start_node pdesc start_node; let no_exn_handlers = [] in let last_node, assert_map = structured_instrs_to_node start_node M.empty no_exn_handlers program in - let exit_node = create_node (Cfg.Node.Exit_node pname) [] in + let exit_node = create_node (Procdesc.Node.Exit_node pname) [] in set_succs last_node [exit_node] ~exn_handlers:no_exn_handlers; - Cfg.Procdesc.set_exit_node pdesc exit_node; + Procdesc.set_exit_node pdesc exit_node; pdesc, assert_map let create_test test_program extras pp_opt test_pname _ = diff --git a/infer/src/unit/procCfgTests.ml b/infer/src/unit/procCfgTests.ml index 2f9df7ef6..e37c0271b 100644 --- a/infer/src/unit/procCfgTests.ml +++ b/infer/src/unit/procCfgTests.ml @@ -28,18 +28,18 @@ let tests = let instrs3 = [dummy_instr4] in let instrs4 = [] in let create_node instrs = - Cfg.Procdesc.create_node test_pdesc Location.dummy (Cfg.Node.Stmt_node "") instrs in + Procdesc.create_node test_pdesc Location.dummy (Procdesc.Node.Stmt_node "") instrs in let n1 = create_node instrs1 in let n2 = create_node instrs2 in let n3 = create_node instrs3 in let n4 = create_node instrs4 in - Cfg.Procdesc.set_start_node test_pdesc n1; + Procdesc.set_start_node test_pdesc n1; (* let -> represent normal transitions and -*-> represent exceptional transitions *) (* creating graph n1 -> n2, n1 -*-> n3, n2 -> n4, n2 -*-> n3, n3 -> n4 , n3 -*> n4 *) - Cfg.Procdesc.node_set_succs_exn test_pdesc n1 [n2] [n3]; - Cfg.Procdesc.node_set_succs_exn test_pdesc n2 [n4] [n3]; - Cfg.Procdesc.node_set_succs_exn test_pdesc n3 [n4] [n4]; + Procdesc.node_set_succs_exn test_pdesc n1 [n2] [n3]; + Procdesc.node_set_succs_exn test_pdesc n2 [n4] [n3]; + Procdesc.node_set_succs_exn test_pdesc n3 [n4] [n4]; let normal_proc_cfg = ProcCfg.Normal.from_pdesc test_pdesc in let exceptional_proc_cfg = ProcCfg.Exceptional.from_pdesc test_pdesc in @@ -48,11 +48,11 @@ let tests = let open OUnit2 in let cmp l1 l2 = - let sort = IList.sort Cfg.Node.compare in - IList.equal Cfg.Node.compare (sort l1) (sort l2) in + let sort = IList.sort Procdesc.Node.compare in + IList.equal Procdesc.Node.compare (sort l1) (sort l2) in let pp_diff fmt (actual, expected) = let pp_sep fmt _ = F.pp_print_char fmt ',' in - let pp_node_list fmt l = F.pp_print_list ~pp_sep Cfg.Node.pp fmt l in + let pp_node_list fmt l = F.pp_print_list ~pp_sep Procdesc.Node.pp fmt l in F.fprintf fmt "Expected output %a but got %a" pp_node_list expected pp_node_list actual in let create_test input expected _ = assert_equal ~cmp ~pp_diff input expected in diff --git a/infer/src/unit/schedulerTests.ml b/infer/src/unit/schedulerTests.ml index 067381a21..805bf58bd 100644 --- a/infer/src/unit/schedulerTests.ml +++ b/infer/src/unit/schedulerTests.ml @@ -24,7 +24,7 @@ module MockNode = struct let id n = n let loc _ = assert false let underlying_id _ = assert false - let kind _ = Cfg.Node.Stmt_node "" + let kind _ = Procdesc.Node.Stmt_node "" let id_compare = int_compare let pp_id fmt i = F.fprintf fmt "%i" i