diff --git a/infer/src/IR/Procdesc.ml b/infer/src/IR/Procdesc.ml index a7350c326..ba20c75c0 100644 --- a/infer/src/IR/Procdesc.ml +++ b/infer/src/IR/Procdesc.ml @@ -17,10 +17,51 @@ module Node = struct let equal_id = [%compare.equal : id] + type stmt_nodekind = + | AssertionFailure + | BetweenJoinAndExit + | BinaryConditionalStmtInit + | BinaryOperatorStmt of string + | Call of string + | CallObjCNew + | ClassCastException + | ConditionalStmtBranch + | ConstructorInit + | CXXDynamicCast + | CXXNewExpr + | CXXStdInitializerListExpr + | CXXTypeidExpr + | DeclStmt + | DefineBody + | Destruction + | ExceptionHandler + | ExceptionsSink + | FallbackNode + | FinallyBranch + | GCCAsmStmt + | GenericSelectionExpr + | IfStmtBranch + | InitializeDynamicArrayLength + | InitListExp + | MessageCall of string + | MethodBody + | MonitorEnter + | MonitorExit + | ObjCCPPThrow + | OutOfBound + | ReturnStmt + | Skip of string + | SwitchStmt + | ThisNotNull + | Throw + | ThrowNPE + | UnaryOperator + [@@deriving compare] + type nodekind = | Start_node of Typ.Procname.t | Exit_node of Typ.Procname.t - | Stmt_node of string + | Stmt_node of stmt_nodekind | Join_node | Prune_node of bool * Sil.if_kind * string (** (true/false branch, if_kind, comment) *) | Skip_node of string @@ -40,11 +81,11 @@ module Node = struct ; pname_opt: Typ.Procname.t option (** name of the procedure the node belongs to *) ; mutable succs: t list (** successor nodes in the cfg *) } - let exn_handler_kind = Stmt_node "exception handler" + let exn_handler_kind = Stmt_node ExceptionHandler - let exn_sink_kind = Stmt_node "exceptions sink" + let exn_sink_kind = Stmt_node ExceptionsSink - let throw_kind = Stmt_node "throw" + let throw_kind = Stmt_node Throw let dummy pname_opt = { id= 0 @@ -175,6 +216,85 @@ module Node = struct node.instrs <- Instrs.prepend_one instr node.instrs + let pp_stmt fmt = function + | AssertionFailure -> + F.pp_print_string fmt "Assertion failure" + | BetweenJoinAndExit -> + F.pp_print_string fmt "between_join_and_exit" + | BinaryConditionalStmtInit -> + F.pp_print_string fmt "BinaryConditionalStmt Init" + | BinaryOperatorStmt bop -> + F.fprintf fmt "BinaryOperatorStmt: %s" bop + | Call call -> + F.fprintf fmt "Call %s" call + | CallObjCNew -> + F.pp_print_string fmt "Call objC new" + | ClassCastException -> + F.pp_print_string fmt "Class cast exception" + | ConditionalStmtBranch -> + F.pp_print_string fmt "ConditionalStmt Branch" + | ConstructorInit -> + F.pp_print_string fmt "Constructor Init" + | CXXDynamicCast -> + F.pp_print_string fmt "CxxDynamicCast" + | CXXNewExpr -> + F.pp_print_string fmt "CXXNewExpr" + | CXXStdInitializerListExpr -> + F.pp_print_string fmt "CXXStdInitializerListExpr" + | CXXTypeidExpr -> + F.pp_print_string fmt "CXXTypeidExpr" + | DeclStmt -> + F.pp_print_string fmt "DeclStmt" + | DefineBody -> + F.pp_print_string fmt "define_body" + | Destruction -> + F.pp_print_string fmt "Destruction" + | ExceptionHandler -> + F.pp_print_string fmt "exception handler" + | ExceptionsSink -> + F.pp_print_string fmt "exceptions sink" + | FallbackNode -> + F.pp_print_string fmt "Fallback node" + | FinallyBranch -> + F.pp_print_string fmt "Finally branch" + | GCCAsmStmt -> + F.pp_print_string fmt "GCCAsmStmt" + | GenericSelectionExpr -> + F.pp_print_string fmt "GenericSelectionExpr" + | IfStmtBranch -> + F.pp_print_string fmt "IfStmt Branch" + | InitializeDynamicArrayLength -> + F.pp_print_string fmt "Initialize dynamic array length" + | InitListExp -> + F.pp_print_string fmt "InitListExp" + | MessageCall selector -> + F.fprintf fmt "Message Call: %s" selector + | MethodBody -> + F.pp_print_string fmt "method_body" + | MonitorEnter -> + F.pp_print_string fmt "MonitorEnter" + | MonitorExit -> + F.pp_print_string fmt "MonitorExit" + | ObjCCPPThrow -> + F.pp_print_string fmt "ObjCCPPThrow" + | OutOfBound -> + F.pp_print_string fmt "Out of bound" + | ReturnStmt -> + F.pp_print_string fmt "Return Stmt" + | Skip reason -> + F.pp_print_string fmt reason + | SwitchStmt -> + F.pp_print_string fmt "SwitchStmt" + | ThisNotNull -> + F.pp_print_string fmt "this not null" + | Throw -> + F.pp_print_string fmt "throw" + | ThrowNPE -> + F.pp_print_string fmt "Throw NPE" + | UnaryOperator -> + F.pp_print_string fmt "UnaryOperator" + + (** Print extended instructions for the node, highlighting the given subinstruction if present *) let pp_instrs pe0 ~sub_instrs ~instro fmt node = @@ -188,7 +308,7 @@ module Node = struct let () = match get_kind node with | Stmt_node s -> - F.fprintf fmt "statements (%s)" s + F.fprintf fmt "statements (%a)" pp_stmt s | Prune_node (_, _, descr) -> F.fprintf fmt "assume %s" descr | Exit_node _ -> @@ -409,7 +529,7 @@ let create_node pdesc loc kind instrs = create_node_internal pdesc loc kind (Ins let node_set_succs_exn pdesc (node: Node.t) succs exn = match (node.kind, succs) with | Join_node, [({Node.kind= Exit_node _} as exit_node)] -> - let kind = Node.Stmt_node "between_join_and_exit" in + let kind = Node.Stmt_node BetweenJoinAndExit in let node' = create_node_internal pdesc node.loc kind node.instrs in set_succs_exn_base node [node'] exn ; set_succs_exn_base node' [exit_node] exn @@ -892,7 +1012,7 @@ let is_connected proc_desc = let is_exit_node n = match Node.get_kind n with Node.Exit_node _ -> true | _ -> false in let is_between_join_and_exit_node n = match Node.get_kind n with - | Node.Stmt_node "between_join_and_exit" | Node.Stmt_node "Destruction" -> ( + | Node.Stmt_node BetweenJoinAndExit | Node.Stmt_node Destruction -> ( match Node.get_succs n with [n'] when is_exit_node n' -> true | _ -> false ) | _ -> false diff --git a/infer/src/IR/Procdesc.mli b/infer/src/IR/Procdesc.mli index 6f754fd91..b82134f89 100644 --- a/infer/src/IR/Procdesc.mli +++ b/infer/src/IR/Procdesc.mli @@ -18,11 +18,52 @@ module Node : sig val equal_id : id -> id -> bool + (** kind of statement node *) + type stmt_nodekind = + | AssertionFailure + | BetweenJoinAndExit + | BinaryConditionalStmtInit + | BinaryOperatorStmt of string + | Call of string + | CallObjCNew + | ClassCastException + | ConditionalStmtBranch + | ConstructorInit + | CXXDynamicCast + | CXXNewExpr + | CXXStdInitializerListExpr + | CXXTypeidExpr + | DeclStmt + | DefineBody + | Destruction + | ExceptionHandler + | ExceptionsSink + | FallbackNode + | FinallyBranch + | GCCAsmStmt + | GenericSelectionExpr + | IfStmtBranch + | InitializeDynamicArrayLength + | InitListExp + | MessageCall of string + | MethodBody + | MonitorEnter + | MonitorExit + | ObjCCPPThrow + | OutOfBound + | ReturnStmt + | Skip of string + | SwitchStmt + | ThisNotNull + | Throw + | ThrowNPE + | UnaryOperator + (** kind of cfg node *) type nodekind = | Start_node of Typ.Procname.t | Exit_node of Typ.Procname.t - | Stmt_node of string + | Stmt_node of stmt_nodekind | Join_node | Prune_node of bool * Sil.if_kind * string (** (true/false branch, if_kind, comment) *) | Skip_node of string @@ -102,6 +143,8 @@ module Node : sig val pp_id : Format.formatter -> id -> unit (** Pretty print a node id *) + val pp_stmt : Format.formatter -> stmt_nodekind -> unit + val pp_instrs : Pp.env -> sub_instrs:bool -> instro:Sil.instr option -> Format.formatter -> t -> unit (** Print extended instructions for the node, diff --git a/infer/src/backend/dotty.ml b/infer/src/backend/dotty.ml index e505b3f3f..8a213df70 100644 --- a/infer/src/backend/dotty.ml +++ b/infer/src/backend/dotty.ml @@ -1113,7 +1113,7 @@ let pp_cfgnodelabel pdesc fmt (n: Procdesc.Node.t) = | Procdesc.Node.Prune_node (is_true_branch, if_kind, _) -> Format.fprintf fmt "Prune (%b branch, %s)" is_true_branch (Sil.if_kind_to_string if_kind) | Procdesc.Node.Stmt_node s -> - Format.fprintf fmt " %s" s + Format.fprintf fmt " %a" Procdesc.Node.pp_stmt s | Procdesc.Node.Skip_node s -> Format.fprintf fmt "Skip %s" s in diff --git a/infer/src/clang/cTrans.ml b/infer/src/clang/cTrans.ml index bb4a56e5e..c9dcd10a2 100644 --- a/infer/src/clang/cTrans.ml +++ b/infer/src/clang/cTrans.ml @@ -122,7 +122,7 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s CLocation.location_of_stmt_info trans_state.context.translation_unit_context.source_file stmt_info' in - PriorityNode.compute_result_to_parent trans_state_pri sil_loc ~node_name:"Fallback node" + PriorityNode.compute_result_to_parent trans_state_pri sil_loc ~node_name:FallbackNode stmt_info' res_trans else res_trans @@ -924,7 +924,7 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s let context = trans_state.context in let trans_state_pri = PriorityNode.try_claim_priority_node trans_state stmt_info in let node_name = - "BinaryOperatorStmt: " ^ CArithmetic_trans.bin_op_to_string binary_operator_info + Procdesc.Node.BinaryOperatorStmt (CArithmetic_trans.bin_op_to_string binary_operator_info) in let trans_state' = {trans_state_pri with succ_nodes= []} in let sil_loc = @@ -1055,7 +1055,7 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s create_call_instr trans_state function_type sil_fe act_params sil_loc call_flags ~is_objc_method:false ~is_inherited_ctor:false in - let node_name = "Call " ^ Exp.to_string sil_fe in + let node_name = Procdesc.Node.Call (Exp.to_string sil_fe) in let all_res_trans = res_trans_callee :: (result_trans_params @ [res_trans_call]) in PriorityNode.compute_results_to_parent trans_state_pri sil_loc ~node_name si ~return:res_trans_call.return all_res_trans @@ -1091,7 +1091,7 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s create_call_instr trans_state_pri function_type sil_method actual_params sil_loc call_flags ~is_objc_method:false ~is_inherited_ctor in - let node_name = "Call " ^ Exp.to_string sil_method in + let node_name = Procdesc.Node.Call (Exp.to_string sil_method) in let all_res_trans = result_trans_params @ res_trans_call :: Option.to_list extra_res_trans in @@ -1303,7 +1303,7 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s ~is_objc_method:true ~is_inherited_ctor:false in let selector = obj_c_message_expr_info.Clang_ast_t.omei_selector in - let node_name = "Message Call: " ^ selector in + let node_name = Procdesc.Node.MessageCall selector in let assertion_trans_opt = if CTrans_models.is_handleFailureInMethod selector then Some (CTrans_utils.trans_assertion trans_state sil_loc) @@ -1357,7 +1357,7 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s CLocation.location_of_stmt_info context.translation_unit_context.source_file stmt_info_loc in Some - (PriorityNode.compute_results_to_parent trans_state_pri sil_loc ~node_name:"Destruction" + (PriorityNode.compute_results_to_parent trans_state_pri sil_loc ~node_name:Destruction stmt_info_loc ~return:(mk_fresh_void_exp_typ ()) all_res_trans) @@ -1412,7 +1412,7 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s CLocation.location_of_stmt_info context.translation_unit_context.source_file stmt_info in Some - (PriorityNode.compute_results_to_parent trans_state_pri sil_loc ~node_name:"Destruction" + (PriorityNode.compute_results_to_parent trans_state_pri sil_loc ~node_name:Destruction stmt_info' ~return:(mk_fresh_void_exp_typ ()) all_res_trans) @@ -1459,7 +1459,7 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s CLocation.location_of_stmt_info context.translation_unit_context.source_file stmt_info in Some - (PriorityNode.compute_results_to_parent trans_state_pri sil_loc ~node_name:"Destruction" + (PriorityNode.compute_results_to_parent trans_state_pri sil_loc ~node_name:Destruction stmt_info' ~return:(mk_fresh_void_exp_typ ()) all_res_trans) @@ -1521,7 +1521,7 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s let all_res_trans = [res_trans_b; tmp_var_res_trans] in let res_trans = PriorityNode.compute_results_to_parent trans_state'' sil_loc - ~node_name:"ConditionalStmt Branch" stmt_info ~return:temp_return all_res_trans + ~node_name:ConditionalStmtBranch stmt_info ~return:temp_return all_res_trans in let prune_nodes_t, prune_nodes_f = List.partition_tf ~f:is_true_prune_node prune_nodes in let prune_nodes' = if branch then prune_nodes_t else prune_nodes_f in @@ -1593,7 +1593,7 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s let trans_state'' = {trans_state_cond with succ_nodes= op_res_trans.control.root_nodes} in let init_res_trans' = PriorityNode.compute_result_to_parent trans_state'' sil_loc - ~node_name:"BinaryConditionalStmt Init" stmt_info init_res_trans + ~node_name:BinaryConditionalStmtInit stmt_info init_res_trans in let root_nodes = init_res_trans'.control.root_nodes in if root_nodes <> [] then {op_res_trans with control= {op_res_trans.control with root_nodes}} @@ -1745,8 +1745,8 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s let nodes_branch = match res_trans_b.control.root_nodes with | [] -> - [ Procdesc.create_node context.procdesc sil_loc - (Procdesc.Node.Stmt_node "IfStmt Branch") res_trans_b.control.instrs ] + [ Procdesc.create_node context.procdesc sil_loc (Procdesc.Node.Stmt_node IfStmtBranch) + res_trans_b.control.instrs ] | _ -> res_trans_b.control.root_nodes in @@ -1804,7 +1804,7 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s let trans_state' = {trans_state_pri with succ_nodes= []} in let res_trans_cond_tmp = instruction trans_state' condition in let switch_node = - let node_kind = Procdesc.Node.Stmt_node "SwitchStmt" in + let node_kind = Procdesc.Node.Stmt_node SwitchStmt in Procdesc.create_node context.procdesc sil_loc node_kind res_trans_cond_tmp.control.instrs in List.iter @@ -1913,7 +1913,7 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s List.iter ~f:(fun try_end -> match Procdesc.Node.get_kind try_end with - | Procdesc.Node.Stmt_node "Return Stmt" -> + | Procdesc.Node.Stmt_node ReturnStmt -> () | _ -> Procdesc.set_succs_exn_only try_end catch_start_nodes ) @@ -2174,10 +2174,9 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s CFrontend_config.unimplemented __POS__ stmt_info.Clang_ast_t.si_source_range "InitListExp for var %a of type %a" Exp.pp var_exp (Typ.pp Pp.text) var_typ in - let node_name = "InitListExp" in let res_trans = - PriorityNode.compute_results_to_parent trans_state_pri sil_loc ~node_name stmt_info - ~return:(var_exp, var_typ) all_res_trans + PriorityNode.compute_results_to_parent trans_state_pri sil_loc ~node_name:InitListExp + stmt_info ~return:(var_exp, var_typ) all_res_trans in {res_trans with control= {res_trans.control with initd_exps= [var_exp]}} @@ -2202,7 +2201,7 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s in let call_trans_control = {empty_control with instrs= [call_instr]} in PriorityNode.compute_controls_to_parent trans_state_pri sil_loc - ~node_name:"Initialize dynamic array length" dynlength_stmt_info + ~node_name:InitializeDynamicArrayLength dynlength_stmt_info [dynlength_trans_result.control; call_trans_control] |> mk_trans_result ret_exp_typ @@ -2249,7 +2248,7 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s Some {empty_control with instrs= [Sil.Store (var_exp, ie_typ, sil_e1', sil_loc)]} in let all_res_trans = res_trans_ie.control :: Option.to_list assign_trans_control_opt in - PriorityNode.compute_controls_to_parent trans_state_pri sil_loc ~node_name:"DeclStmt" + PriorityNode.compute_controls_to_parent trans_state_pri sil_loc ~node_name:DeclStmt var_stmt_info all_res_trans |> mk_trans_result var_exp_typ @@ -2458,7 +2457,7 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s in let unary_op_control = {empty_control with instrs= instr_op} in let all_control = [res_trans_stmt.control; unary_op_control] in - PriorityNode.compute_controls_to_parent trans_state_pri sil_loc ~node_name:"UnaryOperator" + PriorityNode.compute_controls_to_parent trans_state_pri sil_loc ~node_name:UnaryOperator stmt_info all_control |> mk_trans_result (exp_op, ret_typ) @@ -2500,7 +2499,7 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s check_destructor_translation destructor_res ; let instrs_of = function Some {control= {instrs}} -> instrs | None -> [] in let ret_node = - Procdesc.create_node context.procdesc sil_loc (Procdesc.Node.Stmt_node "Return Stmt") + Procdesc.create_node context.procdesc sil_loc (Procdesc.Node.Stmt_node ReturnStmt) (instrs @ instrs_of destr_trans_result @ instrs_of destructor_res) in Procdesc.node_set_succs_exn context.procdesc ret_node @@ -2838,8 +2837,7 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s Option.to_list control_size @ [res_trans_placement_control; res_trans_new.control] @ List.map ~f:(fun {control} -> control) res_trans_init in - let node_name = "CXXNewExpr" in - PriorityNode.compute_controls_to_parent trans_state_pri sil_loc ~node_name stmt_info + PriorityNode.compute_controls_to_parent trans_state_pri sil_loc ~node_name:CXXNewExpr stmt_info all_res_trans |> mk_trans_result res_trans_new.return @@ -2885,7 +2883,7 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s (* --- END OF DEAD CODE --- *) else [result_trans_param; call_res_trans] in - PriorityNode.compute_results_to_parent trans_state_pri sil_loc ~node_name:"Call delete" + PriorityNode.compute_results_to_parent trans_state_pri sil_loc ~node_name:(Call "delete") stmt_info ~return:call_return all_res_trans @@ -2944,7 +2942,7 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s let res_ex = Exp.Var ret_id in let res_trans_dynamic_cast = {empty_control with instrs= [call]} in let all_res_trans = [res_trans_stmt.control; res_trans_dynamic_cast] in - PriorityNode.compute_controls_to_parent trans_state_pri sil_loc ~node_name:"CxxDynamicCast" + PriorityNode.compute_controls_to_parent trans_state_pri sil_loc ~node_name:CXXDynamicCast stmt_info all_res_trans |> mk_trans_result (res_ex, cast_type) @@ -2981,17 +2979,19 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s and gccAsmStmt_trans trans_state stmt_info stmts = let pname = Typ.Procname.from_string_c_fun CFrontend_config.infer_skip_gcc_asm_stmt in - call_function_with_args "GCCAsmStmt" pname trans_state stmt_info (Typ.mk Tvoid) stmts + call_function_with_args Procdesc.Node.GCCAsmStmt pname trans_state stmt_info (Typ.mk Tvoid) + stmts and genericSelectionExprUnknown_trans trans_state stmt_info stmts = let pname = Typ.Procname.from_string_c_fun CFrontend_config.infer_generic_selection_expr in - call_function_with_args "GenericSelectionExpr" pname trans_state stmt_info (Typ.mk Tvoid) stmts + call_function_with_args Procdesc.Node.GenericSelectionExpr pname trans_state stmt_info + (Typ.mk Tvoid) stmts and objc_cxx_throw_trans trans_state stmt_info stmts = - call_function_with_args "ObjCCPPThrow" BuiltinDecl.objc_cpp_throw trans_state stmt_info - (Typ.mk Tvoid) stmts + call_function_with_args Procdesc.Node.ObjCCPPThrow BuiltinDecl.objc_cpp_throw trans_state + stmt_info (Typ.mk Tvoid) stmts and cxxPseudoDestructorExpr_trans () = @@ -3043,7 +3043,7 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s | None -> [res_control] in - PriorityNode.compute_controls_to_parent trans_state_pri sil_loc ~node_name:"CXXTypeidExpr" + PriorityNode.compute_controls_to_parent trans_state_pri sil_loc ~node_name:CXXTypeidExpr stmt_info all_res_trans |> mk_trans_result (ret_exp, typ) @@ -3070,7 +3070,7 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s in let all_res_trans = res_trans_subexpr_list @ [res_trans_call] in PriorityNode.compute_results_to_parent trans_state_pri sil_loc - ~node_name:"CXXStdInitializerListExpr" stmt_info ~return:res_trans_call.return all_res_trans + ~node_name:CXXStdInitializerListExpr stmt_info ~return:res_trans_call.return all_res_trans and binaryOperator_trans_with_cond trans_state stmt_info stmt_list expr_info binop_info = @@ -3152,7 +3152,8 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s (** no-op translated for unsupported instructions that will at least translate subexpressions *) and skip_unimplemented ~reason trans_state stmt_info ret_typ stmts = - call_function_with_args reason BuiltinDecl.__infer_skip trans_state stmt_info ret_typ stmts + call_function_with_args (Procdesc.Node.Skip reason) BuiltinDecl.__infer_skip trans_state + stmt_info ret_typ stmts (** Translates a clang instruction into SIL instructions. It takes a a [trans_state] containing @@ -3590,7 +3591,7 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s let var_exp_typ = var_res_trans.return in let init_expr = ctor_init.Clang_ast_t.xci_init_expr in let init_res_trans = init_expr_trans trans_state' var_exp_typ child_stmt_info init_expr in - PriorityNode.compute_results_to_parent trans_state' sil_loc ~node_name:"Constructor Init" + PriorityNode.compute_results_to_parent trans_state' sil_loc ~node_name:ConstructorInit this_stmt_info ~return:init_res_trans.return [var_res_trans; init_res_trans] diff --git a/infer/src/clang/cTrans_utils.ml b/infer/src/clang/cTrans_utils.ml index de796c3a6..94aaa375f 100644 --- a/infer/src/clang/cTrans_utils.ml +++ b/infer/src/clang/cTrans_utils.ml @@ -361,7 +361,7 @@ let create_alloc_instrs ~alloc_builtin ?size_exp ?placement_args_exps sil_loc fu let alloc_trans trans_state ~alloc_builtin loc stmt_info function_type = let function_type, instrs, exp = create_alloc_instrs ~alloc_builtin loc function_type in let control_tmp = {empty_control with instrs} in - PriorityNode.compute_control_to_parent trans_state loc ~node_name:"Call alloc" stmt_info + PriorityNode.compute_control_to_parent trans_state loc ~node_name:(Call "alloc") stmt_info control_tmp |> mk_trans_result (exp, function_type) @@ -387,7 +387,7 @@ let objc_new_trans trans_state ~alloc_builtin loc stmt_info cls_name function_ty in let instrs = alloc_stmt_call @ [init_stmt_call] in let res_trans_tmp = {empty_control with instrs} in - let node_name = "Call objC new" in + let node_name = Procdesc.Node.CallObjCNew in PriorityNode.compute_control_to_parent trans_state loc ~node_name stmt_info res_trans_tmp |> mk_trans_result (Exp.Var init_ret_id, alloc_ret_type) @@ -509,7 +509,7 @@ let trans_assertion_failure sil_loc (context: CContext.t) = let exit_node = Procdesc.get_exit_node context.procdesc and failure_node = Procdesc.create_node context.CContext.procdesc sil_loc - (Procdesc.Node.Stmt_node "Assertion failure") [call_instr] + (Procdesc.Node.Stmt_node AssertionFailure) [call_instr] in Procdesc.node_set_succs_exn context.procdesc failure_node [exit_node] [] ; mk_trans_result (Exp.Var ret_id, ret_typ) {empty_control with root_nodes= [failure_node]} diff --git a/infer/src/clang/cTrans_utils.mli b/infer/src/clang/cTrans_utils.mli index 78afd7945..3d98d0ef6 100644 --- a/infer/src/clang/cTrans_utils.mli +++ b/infer/src/clang/cTrans_utils.mli @@ -138,20 +138,20 @@ module PriorityNode : sig val own_priority_node : t -> Clang_ast_t.stmt_info -> bool val compute_controls_to_parent : - trans_state -> Location.t -> node_name:string -> Clang_ast_t.stmt_info -> control list - -> control + trans_state -> Location.t -> node_name:Procdesc.Node.stmt_nodekind -> Clang_ast_t.stmt_info + -> control list -> control (** Used by translation functions to handle potential cfg nodes. It connects nodes returned by the translation of stmt children and deals with creating or not a cfg node depending of owning the priority_node. It returns the [control] that should be passed to the parent. *) val compute_results_to_parent : - trans_state -> Location.t -> node_name:string -> Clang_ast_t.stmt_info -> return:Exp.t * Typ.t - -> trans_result list -> trans_result + trans_state -> Location.t -> node_name:Procdesc.Node.stmt_nodekind -> Clang_ast_t.stmt_info + -> return:Exp.t * Typ.t -> trans_result list -> trans_result (** convenience wrapper around [compute_controls_to_parent] *) val compute_result_to_parent : - trans_state -> Location.t -> node_name:string -> Clang_ast_t.stmt_info -> trans_result - -> trans_result + trans_state -> Location.t -> node_name:Procdesc.Node.stmt_nodekind -> Clang_ast_t.stmt_info + -> trans_result -> trans_result (** convenience function like [compute_results_to_parent] when there is a single [trans_result] to consider *) end diff --git a/infer/src/java/jTrans.ml b/infer/src/java/jTrans.ml index 44a28b240..7e8f36312 100644 --- a/infer/src/java/jTrans.ml +++ b/infer/src/java/jTrans.ml @@ -848,8 +848,8 @@ let instruction (context: JContext.t) pc instr : translation = Instr (create_node node_kind (instrs @ [deref_instr; instr])) in let create_node_kind procname = - let desc = "Call " ^ Typ.Procname.to_string procname in - Procdesc.Node.Stmt_node desc + let procname_string = Typ.Procname.to_string procname in + Procdesc.Node.Stmt_node (Call procname_string) in try match instr with @@ -857,11 +857,11 @@ let 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 = Procdesc.Node.Stmt_node "method_body" in + let node_kind = Procdesc.Node.Stmt_node MethodBody in let node = create_node node_kind (stml @ [sil_instr]) in Instr node | JBir.Return expr_option -> - let node_kind = Procdesc.Node.Stmt_node "method_body" in + let node_kind = Procdesc.Node.Stmt_node MethodBody in let node = match expr_option with | None -> @@ -885,7 +885,7 @@ let 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 = Procdesc.Node.Stmt_node "method_body" in + let node_kind = Procdesc.Node.Stmt_node MethodBody in let node = create_node node_kind final_instrs in Instr node | JBir.AffectField (e_lhs, cn, fs, e_rhs) -> @@ -896,7 +896,7 @@ let 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 = Procdesc.Node.Stmt_node "method_body" in + let node_kind = Procdesc.Node.Stmt_node MethodBody in let node = create_node node_kind (stml1 @ stml2 @ [sil_instr]) in Instr node | JBir.AffectStaticField (cn, fs, e_rhs) -> @@ -912,7 +912,7 @@ let 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 = Procdesc.Node.Stmt_node "method_body" in + let node_kind = Procdesc.Node.Stmt_node MethodBody in let node = create_node node_kind (stml1 @ stml2 @ [sil_instr]) in Instr node | JBir.Goto goto_pc -> @@ -985,7 +985,7 @@ let instruction (context: JContext.t) pc instr : translation = Sil.Call ((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 = Procdesc.Node.Stmt_node "method_body" in + let node_kind = Procdesc.Node.Stmt_node MethodBody in let node = create_node node_kind (instrs @ [call_instr; set_instr]) in Instr node | JBir.InvokeStatic (var_opt, cn, ms, args) -> @@ -1055,7 +1055,7 @@ let instruction (context: JContext.t) pc instr : translation = (* TODO #6509339: refactor the boilerplate code in the translation of JVM checks *) let instrs, sil_expr, _ = expression context pc expr in let this_not_null_node = - create_node (Procdesc.Node.Stmt_node "this not null") + create_node (Procdesc.Node.Stmt_node ThisNotNull) (instrs @ [assume_not_null loc sil_expr]) in Instr this_not_null_node @@ -1070,7 +1070,7 @@ let instruction (context: JContext.t) pc instr : translation = 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 = Procdesc.Node.Stmt_node "Throw NPE" + and npe_kind = Procdesc.Node.Stmt_node ThrowNPE 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 @@ -1117,7 +1117,7 @@ let instruction (context: JContext.t) pc instr : translation = in create_node in_bound_node_kind (instrs @ [sil_assume_in_bound]) and throw_out_of_bound_node = - let out_of_bound_node_kind = Procdesc.Node.Stmt_node "Out of bound" in + let out_of_bound_node_kind = Procdesc.Node.Stmt_node OutOfBound in let sil_assume_out_of_bound = let sil_out_of_bound = let sil_negative_index = @@ -1173,7 +1173,7 @@ let instruction (context: JContext.t) pc instr : translation = 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 = Procdesc.Node.Stmt_node "Class cast exception" + and throw_cast_exception_kind = Procdesc.Node.Stmt_node ClassCastException 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 @@ -1201,10 +1201,10 @@ let instruction (context: JContext.t) pc instr : translation = Prune (is_instance_node, throw_cast_exception_node) | JBir.MonitorEnter expr -> trans_monitor_enter_exit context expr pc loc BuiltinDecl.__set_locked_attribute - "MonitorEnter" + MonitorEnter | JBir.MonitorExit expr -> trans_monitor_enter_exit context expr pc loc BuiltinDecl.__delete_locked_attribute - "MonitorExit" + MonitorExit | _ -> Skip with Frontend_error s -> diff --git a/infer/src/java/jTransExn.ml b/infer/src/java/jTransExn.ml index 13ff79f57..ed64bd702 100644 --- a/infer/src/java/jTransExn.ml +++ b/infer/src/java/jTransExn.ml @@ -60,7 +60,7 @@ let translate_exceptions (context: JContext.t) exit_nodes get_body_nodes handler in match handler.JBir.e_catch_type with | None -> - let finally_node = create_node loc (Procdesc.Node.Stmt_node "Finally branch") [] in + let finally_node = create_node loc (Procdesc.Node.Stmt_node FinallyBranch) [] in Procdesc.node_set_succs_exn procdesc finally_node catch_nodes exit_nodes ; [finally_node] | Some exn_class_name -> diff --git a/infer/src/unit/analyzerTester.ml b/infer/src/unit/analyzerTester.ml index a95c285c2..b2897219d 100644 --- a/infer/src/unit/analyzerTester.ml +++ b/infer/src/unit/analyzerTester.ml @@ -177,7 +177,7 @@ struct in let rec structured_instr_to_node (last_node, assert_map) exn_handlers = function | Cmd cmd -> - let node = create_node (Procdesc.Node.Stmt_node "") [cmd] in + let node = create_node (Procdesc.Node.Stmt_node (Skip "")) [cmd] in set_succs last_node [node] ~exn_handlers ; (node, assert_map) | If (exp, then_instrs, else_instrs) -> @@ -219,7 +219,7 @@ struct 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 (Procdesc.Node.Stmt_node "Invariant") [] in + let node = create_node (Procdesc.Node.Stmt_node (Skip "Invariant")) [] in set_succs last_node [node] ~exn_handlers ; (* add the assertion to be checked after analysis converges *) (node, M.add (CFG.Node.id node) (inv_str, inv_label) assert_map) diff --git a/infer/src/unit/procCfgTests.ml b/infer/src/unit/procCfgTests.ml index bc6219c7c..ada3d4912 100644 --- a/infer/src/unit/procCfgTests.ml +++ b/infer/src/unit/procCfgTests.ml @@ -26,7 +26,7 @@ let tests = let instrs3 = [dummy_instr4] in let instrs4 = [] in let create_node instrs = - Procdesc.create_node test_pdesc Location.dummy (Procdesc.Node.Stmt_node "") instrs + Procdesc.create_node test_pdesc Location.dummy (Procdesc.Node.Stmt_node (Skip "")) instrs in let n1 = create_node instrs1 in let n2 = create_node instrs2 in diff --git a/infer/src/unit/schedulerTests.ml b/infer/src/unit/schedulerTests.ml index af17c3a14..9db07c119 100644 --- a/infer/src/unit/schedulerTests.ml +++ b/infer/src/unit/schedulerTests.ml @@ -24,7 +24,7 @@ module MockNode = struct let of_underlying_node _ = assert false - let kind _ = Procdesc.Node.Stmt_node "" + let kind _ = Procdesc.Node.Stmt_node (Skip "") let compare_id = Int.compare