diff --git a/infer/src/clang/cArithmetic_trans.ml b/infer/src/clang/cArithmetic_trans.ml index ac90a030b..2f44f9332 100644 --- a/infer/src/clang/cArithmetic_trans.ml +++ b/infer/src/clang/cArithmetic_trans.ml @@ -85,7 +85,7 @@ let binary_operation_instruction context boi e1 typ e2 loc rhs_owning_method = (* These should be treated by compound_assignment_binary_operation_instruction*) | bok -> Printing.log_stats - ~fmt:"\nWARNING: Missing translation for Binary Operator Kind %s. Construct ignored...\n" + "\nWARNING: Missing translation for Binary Operator Kind %s. Construct ignored...\n" (Clang_ast_j.string_of_binary_operator_kind bok); (Sil.exp_minus_one, [], []) @@ -128,7 +128,7 @@ let compound_assignment_binary_operation_instruction boi e1 typ e2 loc = (e1, [Sil.Set (e1, typ, e1_xor_e2, loc)]) | bok -> Printing.log_stats - ~fmt:"\nWARNING: Missing translation for CompoundAssignment Binary Operator Kind %s. Construct ignored...\n" + "\nWARNING: Missing translation for CompoundAssignment Binary Operator Kind %s. Construct ignored...\n" (Clang_ast_j.string_of_binary_operator_kind bok); (Sil.exp_minus_one, []) in ([id], e_res, instr1:: instr_op) @@ -168,7 +168,7 @@ let unary_operation_instruction uoi e typ loc = | `AddrOf -> ([], e, []) | `Real | `Imag | `Extension -> Printing.log_stats - ~fmt:"\nWARNING: Missing translation for Unary Operator Kind %s. The construct has been ignored...\n" uok; + "\nWARNING: Missing translation for Unary Operator Kind %s. The construct has been ignored...\n" uok; ([], e, []) let bin_op_to_string boi = diff --git a/infer/src/clang/cContext.ml b/infer/src/clang/cContext.ml index 57a6f4f51..256f833d5 100644 --- a/infer/src/clang/cContext.ml +++ b/infer/src/clang/cContext.ml @@ -81,7 +81,7 @@ struct let var_name = Mangled.from_string name in let global_var = CGlobal_vars.find var_name in let var = CGlobal_vars.var_get_name global_var in - Printing.log_out ~fmt:" ...Variable '%s' found in globals!!\n" (Sil.pvar_to_string var); + Printing.log_out " ...Variable '%s' found in globals!!@\n" (Sil.pvar_to_string var); let typ = CGlobal_vars.var_get_typ global_var in var, typ @@ -99,36 +99,36 @@ struct let print_stack var_name stack = Stack.iter (fun (var_name, typ, level) -> - Printing.log_out ~fmt:"var item %s:" (Mangled.to_string var_name); - Printing.log_out ~fmt:"%s" (Sil.typ_to_string typ); - Printing.log_out ~fmt:"- %s \n%!" (string_of_int level)) stack in - Printing.log_out "LOCAL VARS:%s\n"; + Printing.log_out "var item %s:" (Mangled.to_string var_name); + Printing.log_out "%s" (Sil.typ_to_string typ); + Printing.log_out "- %s @." (string_of_int level)) stack in + Printing.log_out "LOCAL VARS:@\n"; StringMap.iter print_stack context.local_vars_stack let print_pointer_vars context = let print_pointer_var pointer var = - Printing.log_out ~fmt:"%s ->" pointer; - Printing.log_out ~fmt:" %s\n" (Sil.pvar_to_string var) in - Printing.log_out "POINTER VARS:\n"; + Printing.log_out "%s ->" pointer; + Printing.log_out " %s@\n" (Sil.pvar_to_string var) in + Printing.log_out "POINTER VARS:@\n"; StringMap.iter print_pointer_var context.local_vars_pointer let add_pointer_var pointer var context = - Printing.log_out ~fmt:" ...Adding pointer '%s' " pointer; - Printing.log_out ~fmt:"to the map with variable '%s'\n%!" (Sil.pvar_to_string var); + Printing.log_out " ...Adding pointer '%s' " pointer; + Printing.log_out "to the map with variable '%s'@." (Sil.pvar_to_string var); context.local_vars_pointer <- StringMap.add pointer var context.local_vars_pointer let find_var_with_pointer context pointer = try StringMap.find pointer context.local_vars_pointer with Not_found -> - (Printing.log_err ~fmt:" ...Variable for pointer %s not found!!\n%!" pointer); + (Printing.log_err " ...Variable for pointer %s not found!!\n%!" pointer); print_pointer_vars context; assert false let lookup_var_locals context procname var_name = let stack = lookup_var_map context var_name in let (var_name, typ, level) = Stack.top stack in - Printing.log_out ~fmt:" ...Variable %s found in locals!!\n%!" (Mangled.to_string var_name); + Printing.log_out " ...Variable %s found in locals!!@." (Mangled.to_string var_name); (Sil.mk_pvar var_name procname), typ let lookup_var context pointer var_name kind = @@ -144,7 +144,7 @@ struct try (* if it's a captured variable we need to look at the parameters list*) Some (fst (lookup_var_formals context procname var_name)) with Not_found -> - Printing.log_err ~fmt:"Variable %s not found!!\n%!" var_name; + Printing.log_err "Variable %s not found!!\n%!" var_name; print_locals context; None else None @@ -153,19 +153,19 @@ struct Some (fst (lookup_var_formals context procname var_name)) with Not_found -> let list_to_string = list_to_string (fun (a, typ) -> a^":"^(Sil.typ_to_string typ)) in - Printing.log_err ~fmt:"Warning: Parameter %s not found!!\n%!" var_name; - Printing.log_err ~fmt:"Formals of procdesc %s" (Procname.to_string procname); - Printing.log_err ~fmt:" are %s\n%!" (list_to_string (Cfg.Procdesc.get_formals context.procdesc)); + Printing.log_err "Warning: Parameter %s not found!!\n%!" var_name; + Printing.log_err "Formals of procdesc %s" (Procname.to_string procname); + Printing.log_err " are %s\n%!" (list_to_string (Cfg.Procdesc.get_formals context.procdesc)); Printing.print_failure_info pointer; assert false else if (kind = `Function || kind = `ImplicitParam) then ( (* ImplicitParam are 'self' and '_cmd'. These are never defined but they can be referred to in the code. *) - Printing.log_err ~fmt:"Creating a variable for '%s' \n%!" var_name; + Printing.log_err "Creating a variable for '%s' \n%!" var_name; Some (Sil.mk_pvar (Mangled.from_string var_name) procname)) else if (kind = `EnumConstant) then (Printing.print_failure_info pointer; assert false) - else (Printing.log_err ~fmt:"WARNING: In lookup_var kind %s not handled. Giving up!\n%!" (Clang_ast_j.string_of_decl_kind kind); + else (Printing.log_err "WARNING: In lookup_var kind %s not handled. Giving up!\n%!" (Clang_ast_j.string_of_decl_kind kind); Printing.print_failure_info pointer; assert false) @@ -173,8 +173,8 @@ struct Mangled.mangled name ((string_of_int(Block.depth ()))) let add_local_var context var_name typ pointer is_static = - Printing.log_out ~fmt:" ...Creating var %s" var_name; - Printing.log_out ~fmt:" with pointer %s\n" pointer; + Printing.log_out " ...Creating var %s" var_name; + Printing.log_out " with pointer %s@\n" pointer; if not (is_global_var context var_name) || is_static then let var = get_variable_name var_name in context.local_vars <- context.local_vars@[(var, typ, is_static)] ; diff --git a/infer/src/clang/cEnum_decl.ml b/infer/src/clang/cEnum_decl.ml index 4f20c4df7..c1466c654 100644 --- a/infer/src/clang/cEnum_decl.ml +++ b/infer/src/clang/cEnum_decl.ml @@ -45,7 +45,7 @@ let rec get_enum_constants context decl_list v = | [] -> [] | EnumConstantDecl(decl_info, name, qual_type, enum_constant_decl_info) :: decl_list' -> (match enum_constant_decl_info.Clang_ast_t.ecdi_init_expr with - | None -> Printing.log_out (" ...Defining Enum Constant ("^name^", "^(string_of_int v)); + | None -> Printing.log_out "%s" (" ...Defining Enum Constant ("^name^", "^(string_of_int v)); (Mangled.from_string name, Sil.Cint (Sil.Int.of_int v)) :: get_enum_constants context decl_list' (v + 1) | Some stmt -> @@ -55,13 +55,13 @@ let rec get_enum_constants context decl_list v = | Sil.Const c -> c | _ -> (* This is a hack to avoid failing in some strange definition of Enum *) Sil.Cint Sil.Int.zero) in - Printing.log_out ~fmt:" ...Defining Enum Constant ('%s', " name; - Printing.log_out ~fmt:"'%s')\n" (Sil.exp_to_string (Sil.Const const)); + Printing.log_out " ...Defining Enum Constant ('%s', " name; + Printing.log_out "'%s')\n" (Sil.exp_to_string (Sil.Const const)); (Mangled.from_string name, const) :: get_enum_constants context decl_list' v) | _ -> assert false let enum_decl name tenv cfg cg namespace decl_list opt_type = - Printing.log_out ~fmt:"ADDING: EnumDecl '%s'\n" name; + Printing.log_out "ADDING: EnumDecl '%s'\n" name; let context' = CContext.create_context tenv cg cfg !global_procdesc namespace CContext.ContextNoCls false [] false in @@ -72,5 +72,5 @@ let enum_decl name tenv cfg cg namespace decl_list opt_type = (* Here we could give "enum "^name but I want to check that this the type is always defined *) let typename = Sil.TN_enum (Mangled.from_string name) in let typ = Sil.Tenum enum_constants in - Printing.log_out ~fmt:" TN_typename('%s')\n" (Sil.typename_to_string typename); + Printing.log_out " TN_typename('%s')\n" (Sil.typename_to_string typename); Sil.tenv_add tenv typename typ diff --git a/infer/src/clang/cField_decl.ml b/infer/src/clang/cField_decl.ml index 86ebe9105..a9fb9d8da 100644 --- a/infer/src/clang/cField_decl.ml +++ b/infer/src/clang/cField_decl.ml @@ -16,7 +16,7 @@ let mk_class_field_name class_name field_name = Ident.create_fieldname (Mangled.mangled field_name (class_name^"_"^field_name)) 0 let rec get_fields_super_classes tenv super_class = - Printing.log_out ~fmt:" ... Getting fields of superclass '%s'\n" (Sil.typename_to_string super_class); + Printing.log_out " ... Getting fields of superclass '%s'\n" (Sil.typename_to_string super_class); match Sil.tenv_lookup tenv super_class with | None -> [] | Some Sil.Tstruct (fields, _, _, _, (Sil.Class, sc):: _, _, _) -> @@ -37,8 +37,8 @@ let get_field_www name_field fl = let rec scan_fields nn ll = match ll with | [] -> [] - | (n, t, _):: ll' -> Printing.log_out ~fmt:">>>>>Searching for field '%s'." (Ident.fieldname_to_string n); - Printing.log_out ~fmt:" Seen '%s'.\n" nn; + | (n, t, _):: ll' -> Printing.log_out ">>>>>Searching for field '%s'." (Ident.fieldname_to_string n); + Printing.log_out " Seen '%s'.\n" nn; if (Ident.fieldname_to_string n) = nn then [(n, t)] else scan_fields nn ll' in @@ -58,15 +58,15 @@ let rec build_sil_field tenv class_name field_name qual_type prop_atts = let ivar_property curr_class ivar = match ObjcProperty_decl.Property.find_property_name_from_ivar curr_class ivar with | Some pname' -> - (Printing.log_out ~fmt: "Found property name from ivar: '%s'" pname'; + (Printing.log_out "Found property name from ivar: '%s'" pname'; try let _, atts, _, _, _, _ = ObjcProperty_decl.Property.find_property curr_class pname' in let atts_str = list_map Clang_ast_j.string_of_property_attribute atts in Some atts_str with Not_found -> - Printing.log_out ~fmt: "Didn't find property for pname '%s'" pname'; + Printing.log_out "Didn't find property for pname '%s'" pname'; None) - | None -> Printing.log_out ~fmt: "Didn't find property for ivar '%s'" ivar; + | None -> Printing.log_out "Didn't find property for ivar '%s'" ivar; None (* Given a list of declarations in an interface returns a list of fields *) @@ -78,12 +78,12 @@ let rec get_fields tenv curr_class decl_list = let fields = get_fields tenv curr_class decl_list' in (* Doing a post visit here. Adding Ivar after all the declaration have been visited so that *) (* ivar names will be added in the property list. *) - Printing.log_out ~fmt:" ...Adding Instance Variable '%s' \n" field_name; + Printing.log_out " ...Adding Instance Variable '%s' \n" field_name; let prop_attributes = ivar_property curr_class field_name in let (fname, typ, ia) = build_sil_field tenv class_name field_name qual_type prop_attributes in - Printing.log_out ~fmt:" ...Resulting sil field: (%s) with attributes:\n" ((Ident.fieldname_to_string fname) ^":"^(Sil.typ_to_string typ)); + Printing.log_out " ...Resulting sil field: (%s) with attributes:\n" ((Ident.fieldname_to_string fname) ^":"^(Sil.typ_to_string typ)); list_iter (fun (ia', _) -> - list_iter (fun a -> Printing.log_out ~fmt: " '%s' \n" a) ia'.Sil.parameters) ia; + list_iter (fun a -> Printing.log_out " '%s' \n" a) ia'.Sil.parameters) ia; (fname, typ, ia):: fields | ObjCPropertyImplDecl(decl_info, property_impl_decl_info):: decl_list' -> diff --git a/infer/src/clang/cFrontend.ml b/infer/src/clang/cFrontend.ml index 769919f8c..578861ada 100644 --- a/infer/src/clang/cFrontend.ml +++ b/infer/src/clang/cFrontend.ml @@ -75,7 +75,7 @@ let rec translate_one_declaration tenv cg cfg namespace dec = | EmptyDecl _ -> Printing.log_out "Passing from EmptyDecl. Treated as skip\n"; | dec -> - Printing.log_stats ~fmt:"\nWARNING: found Declaration %s skipped\n" (Ast_utils.string_of_decl dec) + Printing.log_stats "\nWARNING: found Declaration %s skipped\n" (Ast_utils.string_of_decl dec) (** Preprocess declarations to create method signatures of function declarations. *) let preprocess_one_declaration tenv cg cfg dec = @@ -117,10 +117,10 @@ let do_source_file source_file ast = init_global_state source_file; CLocation.init_curr_source_file source_file; Config.nLOC := FileLOC.file_get_loc (DB.source_file_to_string source_file); - Printing.log_out ~fmt:"\n Start building call/cfg graph for '%s'....\n" + Printing.log_out "\n Start building call/cfg graph for '%s'....\n" (DB.source_file_to_string source_file); let call_graph, cfg = compute_icfg tenv (DB.source_file_to_string source_file) ast in - Printing.log_out ~fmt:"\n End building call/cfg graph for '%s'.\n" + Printing.log_out "\n End building call/cfg graph for '%s'.\n" (DB.source_file_to_string source_file); (* This part below is a boilerplate in every frontends. *) (* This could be moved in the cfg_infer module *) diff --git a/infer/src/clang/cFrontend_utils.ml b/infer/src/clang/cFrontend_utils.ml index 760e76213..a08bcec00 100644 --- a/infer/src/clang/cFrontend_utils.ml +++ b/infer/src/clang/cFrontend_utils.ml @@ -14,27 +14,20 @@ module F = Format module Printing = struct - let log_out ?fmt s = - if !CFrontend_config.debug_mode then - match fmt with - | Some fmt' -> - Format.printf fmt' s - | None -> Format.printf "%s" s - - let log_err ?fmt s = - if !CFrontend_config.debug_mode then - match fmt with - | Some fmt' -> - Format.eprintf fmt' s - | None -> Format.eprintf "%s" s - - let log_stats ?fmt s = - if !CFrontend_config.stats_mode || - !CFrontend_config.debug_mode then - match fmt with - | Some fmt' -> - Format.printf fmt' s - | None -> Format.eprintf "%s" s + let log_out fmt = + let pp = if !CFrontend_config.debug_mode then Format.fprintf else Format.ifprintf in + pp Format.std_formatter fmt + + let log_err fmt = + let pp = if !CFrontend_config.debug_mode then Format.fprintf else Format.ifprintf in + pp Format.err_formatter fmt + + let log_stats fmt = + let pp = + if !CFrontend_config.stats_mode || !CFrontend_config.debug_mode + then Format.fprintf else Format.ifprintf in + pp Format.std_formatter fmt + let print_tenv tenv = Sil.tenv_iter (fun typname typ -> @@ -237,10 +230,10 @@ struct pointer_counter := !pointer_counter + 1; CFrontend_config.pointer_prefix^(string_of_int (!pointer_counter)) -let type_from_unary_expr_or_type_trait_expr_info info = - match info.uttei_qual_type with - | Some qt -> Some qt - | None -> None + let type_from_unary_expr_or_type_trait_expr_info info = + match info.uttei_qual_type with + | Some qt -> Some qt + | None -> None end @@ -309,8 +302,8 @@ struct | Some sc -> sc = CFrontend_config.static | _ -> false -let block_procname_with_index defining_proc i = - Config.anonymous_block_prefix^(Procname.to_string defining_proc)^Config.anonymous_block_num_sep^(string_of_int i) + let block_procname_with_index defining_proc i = + Config.anonymous_block_prefix^(Procname.to_string defining_proc)^Config.anonymous_block_num_sep^(string_of_int i) (* Makes a fresh name for a block defined inside the defining procedure.*) (* It updates the global block_counter *) @@ -318,8 +311,8 @@ let block_procname_with_index defining_proc i = let name = block_procname_with_index defining_proc (get_fresh_block_index ()) in Procname.mangled_objc_block name - (* Returns the next fresh name for a block defined inside the defining procedure *) - (* It does not update the global block_counter *) + (* Returns the next fresh name for a block defined inside the defining procedure *) + (* It does not update the global block_counter *) let get_next_block_pvar defining_proc = let name = block_procname_with_index defining_proc (!block_counter +1) in Sil.mk_pvar (Mangled.from_string (CFrontend_config.temp_var^"_"^name)) defining_proc diff --git a/infer/src/clang/cFrontend_utils.mli b/infer/src/clang/cFrontend_utils.mli index c054a3d86..7bb6a41b4 100644 --- a/infer/src/clang/cFrontend_utils.mli +++ b/infer/src/clang/cFrontend_utils.mli @@ -10,11 +10,11 @@ open Clang_ast_t module Printing : sig - val log_out : ?fmt: (string -> unit, Format.formatter, unit) format -> string -> unit + val log_out : ('a, Format.formatter, unit) format -> 'a - val log_err : ?fmt: (string -> unit, Format.formatter, unit) format -> string -> unit + val log_err : ('a, Format.formatter, unit) format -> 'a - val log_stats : ?fmt: (string -> unit, Format.formatter, unit) format -> string -> unit + val log_stats : ('a, Format.formatter, unit) format -> 'a val print_failure_info : string -> unit diff --git a/infer/src/clang/cGlobal_vars.ml b/infer/src/clang/cGlobal_vars.ml index 21c94f912..762574d79 100644 --- a/infer/src/clang/cGlobal_vars.ml +++ b/infer/src/clang/cGlobal_vars.ml @@ -32,7 +32,7 @@ let make_var name typ = let add name typ = let name = (Mangled.from_string name) in let pvar = Sil.mk_pvar_global name in - Printing.log_out ~fmt:"Adding global variable %s !!\n%!" (Sil.pvar_to_string pvar); + Printing.log_out "Adding global variable %s !!@." (Sil.pvar_to_string pvar); let var_el = make_var pvar typ in varMap := MangledMap.add name var_el !varMap diff --git a/infer/src/clang/cLocation.ml b/infer/src/clang/cLocation.ml index 723b6db95..cf8ec1a6c 100644 --- a/infer/src/clang/cLocation.ml +++ b/infer/src/clang/cLocation.ml @@ -122,7 +122,7 @@ let check_source_file source_file = let extensions_allowed = [".m"; ".mm"; ".c"; ".cc"; ".cpp"; ".h"] in let allowed = list_exists (fun ext -> Filename.check_suffix source_file ext) extensions_allowed in if not allowed then - (Printing.log_stats + (Printing.log_stats "%s" ("\nThe source file "^source_file^ " should end with "^(Utils.list_to_string (fun x -> x) extensions_allowed)^"\n\n"); assert false) diff --git a/infer/src/clang/cMain.ml b/infer/src/clang/cMain.ml index e97ca33b8..0c5a006f4 100644 --- a/infer/src/clang/cMain.ml +++ b/infer/src/clang/cMain.ml @@ -101,8 +101,8 @@ let do_run source_path ast_path = | None -> "stdin of " ^ source_path, validate_decl_from_stdin () in let ast_decl' = CAstProcessor.preprocess_ast_decl ast_decl in - L.stdout "Original AST@.%a@." CAstProcessor.pp_ast_decl ast_decl; - L.stdout "AST with explicit locations:@.%a@." CAstProcessor.pp_ast_decl ast_decl'; + Printing.log_out "Original AST@.%a@." CAstProcessor.pp_ast_decl ast_decl; + Printing.log_out "AST with explicit locations:@.%a@." CAstProcessor.pp_ast_decl ast_decl'; CFrontend_config.json := ast_filename; @@ -112,7 +112,7 @@ let do_run source_path ast_path = CFrontend.do_source_file source_file ast_decl'; print_endline ("End translation AST file " ^ !CFrontend_config.json ^ "... OK!") with - (Yojson.Json_error s) as exc -> Printing.log_err ~fmt:"%s\n" s; + (Yojson.Json_error s) as exc -> Printing.log_err "%s\n" s; raise exc let _ = diff --git a/infer/src/clang/cMethod_decl.ml b/infer/src/clang/cMethod_decl.ml index faa7edf0c..68fe27db6 100644 --- a/infer/src/clang/cMethod_decl.ml +++ b/infer/src/clang/cMethod_decl.ml @@ -48,8 +48,8 @@ struct let par_to_ms_par par = match par with | ParmVarDecl(decl_info, name, qtype, var_decl_info) -> - Printing.log_out ~fmt:"Adding param '%s' " name; - Printing.log_out ~fmt:"with pointer %s@." decl_info.Clang_ast_t.di_pointer; + Printing.log_out "Adding param '%s' " name; + Printing.log_out "with pointer %s@." decl_info.Clang_ast_t.di_pointer; (name, CTypes.get_type qtype) | _ -> assert false in match function_method_decl_info with @@ -93,7 +93,7 @@ struct let add_method tenv cg cfg class_decl_opt procname namespace instrs is_objc_method is_instance captured_vars is_anonym_block = Printing.log_out - ~fmt:"\n\n>>---------- ADDING METHOD: '%s' ---------<<\n" (Procname.to_string procname); + "\n\n>>---------- ADDING METHOD: '%s' ---------<<\n" (Procname.to_string procname); try (match Cfg.Procdesc.find_from_name cfg procname with | Some procdesc -> @@ -108,7 +108,7 @@ struct Cfg.Procdesc.append_locals procdesc local_vars; Cfg.Node.add_locals_ret_declaration start_node local_vars; Printing.log_out - ~fmt:"\n\n>>---------- Start translating the function: '%s' ---------<<" + "\n\n>>---------- Start translating the function: '%s' ---------<<" (Procname.to_string procname); let meth_body_nodes = T.instructions_trans context instrs exit_node in if (not is_anonym_block) then CContext.LocalVars.reset_block (); @@ -127,7 +127,7 @@ struct () let function_decl tenv cfg cg namespace is_instance di name qt fdecl_info captured_vars anonym_block_opt curr_class = - Printing.log_out ~fmt:"\nFound FunctionDecl '%s'. Processing...\n" name; + Printing.log_out "\nFound FunctionDecl '%s'. Processing...\n" name; Printing.log_out "\nResetting the goto_labels hashmap...\n"; CTrans_utils.GotoLabel.reset_all_labels (); (* C Language Std 6.8.6.1-1 *) match create_function_signature di fdecl_info name qt is_instance anonym_block_opt with @@ -147,7 +147,7 @@ struct let procname = CMethod_trans.mk_procname_from_method class_name method_name in let method_decl = Meth_decl_info (method_decl_info, class_name) in let ms = build_method_signature decl_info procname method_decl false false in - Printing.log_out ~fmt:" ....Processing implementation for method '%s'\n" (Procname.to_string procname); + Printing.log_out " ....Processing implementation for method '%s'\n" (Procname.to_string procname); (match method_body_to_translate decl_info ms method_decl_info.Clang_ast_t.omdi_body with | Some body -> let is_instance = CMethod_signature.ms_is_instance ms in @@ -167,7 +167,7 @@ struct | EmptyDecl _ | ObjCIvarDecl _ -> () | d -> Printing.log_err - ~fmt:"\nWARNING: found Method Declaration '%s' skipped. NEED TO BE FIXED\n\n" (Ast_utils.string_of_decl d); + "\nWARNING: found Method Declaration '%s' skipped. NEED TO BE FIXED\n\n" (Ast_utils.string_of_decl d); () let process_methods tenv cg cfg curr_class namespace decl_list = diff --git a/infer/src/clang/cMethod_trans.ml b/infer/src/clang/cMethod_trans.ml index 7128e3833..245159e9f 100644 --- a/infer/src/clang/cMethod_trans.ml +++ b/infer/src/clang/cMethod_trans.ml @@ -49,12 +49,12 @@ let resolve_method tenv class_name method_name = let get_superclass_curr_class context = let retrive_super cname super_opt = let iname = Sil.TN_csu (Sil.Class, Mangled.from_string cname) in - Printing.log_out ~fmt:"Checking for superclass = '%s'\n\n%!" (Sil.typename_to_string iname); + Printing.log_out "Checking for superclass = '%s'\n\n%!" (Sil.typename_to_string iname); match Sil.tenv_lookup (CContext.get_tenv context) iname with | Some Sil.Tstruct(_, _, _, _, (_, super_name):: _, _, _) -> Mangled.to_string super_name | _ -> - Printing.log_err ~fmt:"NOT FOUND superclass = '%s'\n\n%!" (Sil.typename_to_string iname); + Printing.log_err "NOT FOUND superclass = '%s'\n\n%!" (Sil.typename_to_string iname); (match super_opt with | Some super -> super | _ -> assert false) in @@ -105,7 +105,7 @@ let captured_vars_from_block_info context cvl = let find lv n = try list_find (fun (n', _, _) -> Mangled.to_string n' = n) lv - with Not_found -> Printing.log_err ~fmt:"Trying to find variable %s@." n; assert false in + with Not_found -> Printing.log_err "Trying to find variable %s@." n; assert false in let rec f cvl' = match cvl' with | [] -> [] @@ -117,7 +117,7 @@ let captured_vars_from_block_info context cvl = if n = CFrontend_config.self && not context.is_instance then [] else (let procdesc_formals = Cfg.Procdesc.get_formals context.procdesc in - (Printing.log_err ~fmt:"formals are %s@." (Utils.list_to_string (fun (x, _) -> x) procdesc_formals)); + (Printing.log_err "formals are %s@." (Utils.list_to_string (fun (x, _) -> x) procdesc_formals)); let formals = list_map formal2captured procdesc_formals in [find (context.local_vars @ formals) n]) | _ -> assert false) @@ -140,7 +140,7 @@ let create_local_procdesc cfg tenv ms fbody captured is_objc_inst_method = (* Captured variables for blocks are treated as parameters *) let formals = captured_str @formals in let source_range = CMethod_signature.ms_get_loc ms in - Printing.log_out ~fmt: + Printing.log_out "\n\n>>------------------------- Start creating a new procdesc for function: '%s' ---------<<\n" pname; let loc_start = CLocation.get_sil_location_from_range source_range true in let loc_exit = CLocation.get_sil_location_from_range source_range false in @@ -183,7 +183,7 @@ let create_local_procdesc cfg tenv ms fbody captured is_objc_inst_method = Cfg.Procdesc.set_exit_node procdesc exit_node) in match Cfg.Procdesc.find_from_name cfg procname with | Some prevoius_procdesc -> - Printing.log_err ~fmt:"\n\n!!!WARNING: procdesc for %s already defined \n" pname; + Printing.log_err "\n\n!!!WARNING: procdesc for %s already defined \n" pname; if defined && not (Cfg.Procdesc.is_defined prevoius_procdesc) then (Cfg.Procdesc.remove cfg (Cfg.Procdesc.get_proc_name prevoius_procdesc) true; create_new_procdesc ()) diff --git a/infer/src/clang/cTrans.ml b/infer/src/clang/cTrans.ml index 197d98e0e..a82389a0f 100644 --- a/infer/src/clang/cTrans.ml +++ b/infer/src/clang/cTrans.ml @@ -75,9 +75,9 @@ struct let item_annot = Sil.item_annotation_empty in fname, typ, item_annot in let fields = list_map mk_field_from_captured_var captured_vars in - Printing.log_out ~fmt:"Block %s field:\n" block_name; + Printing.log_out "Block %s field:\n" block_name; list_iter (fun (fn, ft, _) -> - Printing.log_out ~fmt:"-----> field: '%s'\n" (Ident.fieldname_to_string fn)) fields; + Printing.log_out "-----> field: '%s'\n" (Ident.fieldname_to_string fn)) fields; let mblock = Mangled.from_string block_name in let block_type = Sil.Tstruct(fields, [], Sil.Class, Some mblock, [], [], []) in let block_name = Sil.TN_csu(Sil.Class, mblock) in @@ -173,7 +173,7 @@ struct | _ -> assert false let stringLiteral_trans trans_state stmt_info expr_info str = - Printing.log_out ~fmt:"Passing from StringLiteral '%s'\n" stmt_info.Clang_ast_t.si_pointer; + Printing.log_out "Passing from StringLiteral '%s'\n" stmt_info.Clang_ast_t.si_pointer; let typ = CTypes_decl.get_type_from_expr_info expr_info trans_state.context.tenv in let exp = Sil.Const (Sil.Cstr (str)) in { empty_res_trans with exps = [(exp, typ)]} @@ -183,7 +183,7 @@ struct (* extension is typically only used by system headers, which define NULL as __null in C++ rather than using 0 *) (* (which is an integer that may not match the size of a pointer)". So we implement it as the constant zero *) let gNUNullExpr_trans trans_state stmt_info expr_info = - Printing.log_out ~fmt:"Passing from GNUNullExpr '%s'\n" stmt_info.Clang_ast_t.si_pointer; + Printing.log_out "Passing from GNUNullExpr '%s'\n" stmt_info.Clang_ast_t.si_pointer; let typ = CTypes_decl.get_type_from_expr_info expr_info trans_state.context.tenv in let exp = Sil.Const (Sil.Cint (Sil.Int.zero)) in { empty_res_trans with exps = [(exp, typ)]} @@ -192,24 +192,24 @@ struct stringLiteral_trans trans_state stmt_info expr_info selector let objCEncodeExpr_trans trans_state stmt_info expr_info qual_type = - Printing.log_out ~fmt:"Passing from ObjCEncodeExpr '%s'\n" stmt_info.Clang_ast_t.si_pointer; + Printing.log_out "Passing from ObjCEncodeExpr '%s'\n" stmt_info.Clang_ast_t.si_pointer; stringLiteral_trans trans_state stmt_info expr_info (CTypes.get_type qual_type) let objCProtocolExpr_trans trans_state stmt_info expr_info decl_ref = - Printing.log_out ~fmt:"Passing from ObjCProtocolExpr '%s'\n" stmt_info.Clang_ast_t.si_pointer; + Printing.log_out "Passing from ObjCProtocolExpr '%s'\n" stmt_info.Clang_ast_t.si_pointer; let name = (match decl_ref.Clang_ast_t.dr_name with | Some s -> s | _ -> "") in stringLiteral_trans trans_state stmt_info expr_info name let characterLiteral_trans trans_state stmt_info expr_info n = - Printing.log_out ~fmt:"Passing from CharacterLiteral '%s'\n" stmt_info.Clang_ast_t.si_pointer; + Printing.log_out "Passing from CharacterLiteral '%s'\n" stmt_info.Clang_ast_t.si_pointer; let typ = CTypes_decl.get_type_from_expr_info expr_info trans_state.context.tenv in let exp = Sil.Const (Sil.Cint (Sil.Int.of_int n)) in { empty_res_trans with exps = [(exp, typ)]} let floatingLiteral_trans trans_state stmt_info expr_info float_string = - Printing.log_out ~fmt:"Passing from FloatingLiteral '%s'\n" stmt_info.Clang_ast_t.si_pointer; + Printing.log_out "Passing from FloatingLiteral '%s'\n" stmt_info.Clang_ast_t.si_pointer; let typ = CTypes_decl.get_type_from_expr_info expr_info trans_state.context.tenv in let exp = Sil.Const (Sil.Cfloat (float_of_string float_string)) in { empty_res_trans with exps = [(exp, typ)]} @@ -217,7 +217,7 @@ struct (* Note currently we don't have support for different qual *) (* type like long, unsigned long, etc *) and integerLiteral_trans trans_state stmt_info expr_info integer_literal_info = - Printing.log_out ~fmt:"Passing from IntegerLiteral '%s'\n" stmt_info.Clang_ast_t.si_pointer; + Printing.log_out "Passing from IntegerLiteral '%s'\n" stmt_info.Clang_ast_t.si_pointer; let typ = CTypes_decl.get_type_from_expr_info expr_info trans_state.context.tenv in let i = try int_of_string (integer_literal_info.Clang_ast_t.ili_value) @@ -227,12 +227,12 @@ struct { empty_res_trans with exps = [(exp, typ)]} let nullStmt_trans succ_nodes stmt_info = - Printing.log_out ~fmt:"Passing from NullStmt '%s'.\n" stmt_info.Clang_ast_t.si_pointer; + Printing.log_out "Passing from NullStmt '%s'.\n" stmt_info.Clang_ast_t.si_pointer; { empty_res_trans with root_nodes = succ_nodes } (* The stmt seems to be always empty *) let unaryExprOrTypeTraitExpr_trans trans_state stmt_info expr_info unary_expr_or_type_trait_expr_info = - Printing.log_out ~fmt:"Passing from UnaryExprOrTypeTraitExpr '%s' \n" stmt_info.Clang_ast_t.si_pointer; + Printing.log_out "Passing from UnaryExprOrTypeTraitExpr '%s' \n" stmt_info.Clang_ast_t.si_pointer; let typ = CTypes_decl.qual_type_to_sil_type trans_state.context.tenv expr_info.Clang_ast_t.ei_qual_type in match unary_expr_or_type_trait_expr_info.Clang_ast_t.uttei_kind with | `SizeOf -> @@ -243,20 +243,20 @@ struct | None -> typ in (* Some default type since the type is missing *) { empty_res_trans with exps = [(Sil.Sizeof(sizeof_typ, Sil.Subtype.exact), sizeof_typ)]} | k -> Printing.log_stats - ~fmt:"\nWARNING: Missing translation of Uniry_Expression_Or_Trait of kind: %s . Expression ignored, returned -1... \n" + "\nWARNING: Missing translation of Uniry_Expression_Or_Trait of kind: %s . Expression ignored, returned -1... \n" (Clang_ast_j.string_of_unary_expr_or_type_trait_kind k); { empty_res_trans with exps =[(Sil.exp_minus_one, typ)]} (* search the label into the hashtbl - create a fake node eventually *) (* connect that node with this stmt *) let gotoStmt_trans trans_state stmt_info label_name = - Printing.log_out ~fmt:"\nPassing from `GotoStmt '%s'\n" stmt_info.Clang_ast_t.si_pointer; + Printing.log_out "\nPassing from `GotoStmt '%s'\n" stmt_info.Clang_ast_t.si_pointer; let sil_loc = get_sil_location stmt_info trans_state.parent_line_number trans_state.context in let root_node' = GotoLabel.find_goto_label trans_state.context label_name sil_loc in { empty_res_trans with root_nodes = [root_node']; leaf_nodes = trans_state.succ_nodes } let declRefExpr_trans trans_state stmt_info expr_info decl_ref_expr_info d = - Printing.log_out ~fmt:"Passing from DeclRefExpr '%s' \n" stmt_info.Clang_ast_t.si_pointer; + Printing.log_out "Passing from DeclRefExpr '%s' \n" stmt_info.Clang_ast_t.si_pointer; let context = trans_state.context in let typ = CTypes_decl.qual_type_to_sil_type context.tenv expr_info.Clang_ast_t.ei_qual_type in let name = get_name_decl_ref_exp_info decl_ref_expr_info stmt_info in @@ -269,11 +269,11 @@ struct let const_exp = (match CTypes.search_enum_type_by_name context.tenv name with | Some v -> let ce = Sil.Const v in - Printing.log_out ~fmt:" ....Found enum constant '%s', " name; - Printing.log_out ~fmt:"replacing with integer '%s' \n" (Sil.exp_to_string ce); ce + Printing.log_out " ....Found enum constant '%s', " name; + Printing.log_out "replacing with integer '%s' \n" (Sil.exp_to_string ce); ce | None -> Printing.log_stats - ~fmt:" WARNING: Found enum constant '%s', but its value was not found in the tenv. Returning 0.\n" name; + " WARNING: Found enum constant '%s', but its value was not found in the tenv. Returning 0.\n" name; (Sil.Const(Sil.Cint Sil.Int.zero))) in { root_nodes = []; leaf_nodes = []; ids = []; instrs = []; exps = [(const_exp, typ)]} ) else if is_function then ( @@ -321,12 +321,12 @@ struct (CTypes_decl.get_type_curr_class context.tenv (CContext.get_curr_class context)) in [(e, typ)] else [(e, typ)] in - Printing.log_out ~fmt:"\n\n PVAR ='%s'\n\n" (Sil.pvar_to_string pvar); + Printing.log_out "\n\n PVAR ='%s'\n\n" (Sil.pvar_to_string pvar); { empty_res_trans with exps = exps } ) let rec labelStmt_trans trans_state stmt_info stmt_list label_name = - Printing.log_out ~fmt:"\nPassing from `LabelStmt '%s' \n" stmt_info.Clang_ast_t.si_pointer; + Printing.log_out "\nPassing from `LabelStmt '%s' \n" stmt_info.Clang_ast_t.si_pointer; (* go ahead with the translation *) let res_trans = match stmt_list with | [stmt] -> @@ -340,7 +340,7 @@ struct and arraySubscriptExpr_trans trans_state stmt_info expr_info stmt_list = Printing.log_out - ~fmt:"Passing from ArraySubscriptExpr '%s' \n" stmt_info.Clang_ast_t.si_pointer; + "Passing from ArraySubscriptExpr '%s' \n" stmt_info.Clang_ast_t.si_pointer; let typ = CTypes_decl.get_type_from_expr_info expr_info trans_state.context.tenv in let array_stmt, idx_stmt = (match stmt_list with | [a; i] -> a, i (* Assumption: the statement list contains 2 elements, @@ -382,9 +382,9 @@ struct and binaryOperator_trans trans_state binary_operator_info stmt_info expr_info stmt_list = let bok = (Clang_ast_j.string_of_binary_operator_kind binary_operator_info.Clang_ast_t.boi_kind) in - Printing.log_out ~fmt:"Passing from BinaryOperator '%s' " bok; - Printing.log_out ~fmt:"pointer = '%s' " stmt_info.Clang_ast_t.si_pointer; - Printing.log_out ~fmt:"priority node free = '%s'.\n" (string_of_bool (PriorityNode.is_priority_free trans_state)); + Printing.log_out "Passing from BinaryOperator '%s' " bok; + Printing.log_out "pointer = '%s' " stmt_info.Clang_ast_t.si_pointer; + Printing.log_out "priority node free = '%s'.\n" (string_of_bool (PriorityNode.is_priority_free trans_state)); let context = trans_state.context in let parent_line_number = trans_state.parent_line_number in let succ_nodes = trans_state.succ_nodes in @@ -473,14 +473,14 @@ struct else if e2_has_nodes then res_trans_e2.leaf_nodes else res_trans_e1.leaf_nodes in - Printing.log_out ~fmt:"....BinaryOperator '%s' " bok; - Printing.log_out ~fmt:"has ids_to_ancestor |ids_to_ancestor|=%s " + Printing.log_out "....BinaryOperator '%s' " bok; + Printing.log_out "has ids_to_ancestor |ids_to_ancestor|=%s " (string_of_int (list_length ids_to_ancestor)); - Printing.log_out ~fmt:" |nodes_e1|=%s .\n" + Printing.log_out " |nodes_e1|=%s .\n" (string_of_int (list_length res_trans_e1.root_nodes)); - Printing.log_out ~fmt:" |nodes_e2|=%s .\n" + Printing.log_out " |nodes_e2|=%s .\n" (string_of_int (list_length res_trans_e2.root_nodes)); - list_iter (fun id -> Printing.log_out ~fmt:" ... '%s'\n" + list_iter (fun id -> Printing.log_out " ... '%s'\n" (Ident.to_string id)) ids_to_ancestor; { root_nodes = root_nodes_to_ancestor; leaf_nodes = leaf_nodes_to_ancestor; @@ -493,7 +493,7 @@ struct let pln = trans_state.parent_line_number in let context = trans_state.context in let function_type = CTypes_decl.get_type_from_expr_info expr_info context.tenv in - Printing.log_out ~fmt:"Passing from CallExpr '%s'.\n" si.Clang_ast_t.si_pointer; + Printing.log_out "Passing from CallExpr '%s'.\n" si.Clang_ast_t.si_pointer; let procname = Cfg.Procdesc.get_proc_name context.procdesc in let sil_loc = get_sil_location si pln context in let fun_exp_stmt, params_stmt = (match stmt_list with (* First stmt is the function expr and the rest are params*) @@ -573,14 +573,14 @@ struct | _ -> assert false) (* by construction of red_id, we cannot be in this case *) and objCMessageExpr_trans trans_state si obj_c_message_expr_info stmt_list expr_info = - Printing.log_out ~fmt:"Passing from ObjMessageExpr '%s'.\n" si.Clang_ast_t.si_pointer; + Printing.log_out "Passing from ObjMessageExpr '%s'.\n" si.Clang_ast_t.si_pointer; let context = trans_state.context in let parent_line_number = trans_state.parent_line_number in let sil_loc = get_sil_location si parent_line_number context in let selector, receiver_kind = get_selector_receiver obj_c_message_expr_info in let is_alloc_or_new = (selector = CFrontend_config.alloc) || (selector = CFrontend_config.new_str) in - Printing.log_out ~fmt:"\n!!!!!!! Calling with selector = '%s' " selector; - Printing.log_out ~fmt:" receiver_kind= '%s'\n\n" (Clang_ast_j.string_of_receiver_kind receiver_kind); + Printing.log_out "\n!!!!!!! Calling with selector = '%s' " selector; + Printing.log_out " receiver_kind= '%s'\n\n" (Clang_ast_j.string_of_receiver_kind receiver_kind); let method_type = CTypes_decl.get_type_from_expr_info expr_info context.tenv in let ret_id = if Sil.typ_equal method_type Sil.Tvoid then [] else [Ident.create_fresh Ident.knormal] in @@ -655,7 +655,7 @@ struct res_state and compoundStmt_trans trans_state stmt_info stmt_list = - Printing.log_out ~fmt:"Passing from CompoundStmt '%s'.\n" stmt_info.Clang_ast_t.si_pointer; + Printing.log_out "Passing from CompoundStmt '%s'.\n" stmt_info.Clang_ast_t.si_pointer; let line_number = get_line stmt_info trans_state.parent_line_number in let trans_state' = { trans_state with parent_line_number = line_number } in instructions trans_state' (list_rev stmt_list) @@ -667,7 +667,7 @@ struct let procname = Cfg.Procdesc.get_proc_name context.procdesc in let mk_temp_var id = Sil.mk_pvar (Mangled.from_string ("SIL_temp_conditional___"^(string_of_int id))) procname in - Printing.log_out ~fmt:"Passing from ConditionalOperator '%s' \n" stmt_info.Clang_ast_t.si_pointer; + Printing.log_out "Passing from ConditionalOperator '%s' \n" stmt_info.Clang_ast_t.si_pointer; let sil_loc = get_sil_location stmt_info parent_line_number context in let line_number = get_line stmt_info parent_line_number in (* We have two different kind of join type for conditional operator. *) @@ -820,7 +820,7 @@ struct | _ -> no_short_circuit_cond () and ifStmt_trans trans_state stmt_info stmt_list = - Printing.log_out ~fmt:"Passing from IfStmt '%s' \n" stmt_info.Clang_ast_t.si_pointer; + Printing.log_out "Passing from IfStmt '%s' \n" stmt_info.Clang_ast_t.si_pointer; let context = trans_state.context in let pln = trans_state.parent_line_number in let succ_nodes = trans_state.succ_nodes in @@ -853,7 +853,7 @@ struct (* Assumption: the CompoundStmt can be made of different stmts, not just CaseStmts *) and switchStmt_trans trans_state stmt_info switch_stmt_list = - Printing.log_out ~fmt:"\nPassing from `SwitchStmt '%s' \n" stmt_info.Clang_ast_t.si_pointer; + Printing.log_out "\nPassing from `SwitchStmt '%s' \n" stmt_info.Clang_ast_t.si_pointer; let context = trans_state.context in let pln = trans_state.parent_line_number in let succ_nodes = trans_state.succ_nodes in @@ -975,7 +975,7 @@ struct and stmtExpr_trans trans_state stmt_info stmt_list expr_info = let context = trans_state.context in - Printing.log_out ~fmt:"Passing from StmtExpr '%s'.\n" stmt_info.Clang_ast_t.si_pointer; + Printing.log_out "Passing from StmtExpr '%s'.\n" stmt_info.Clang_ast_t.si_pointer; let stmt = extract_stmt_from_singleton stmt_list "ERROR: StmtExpr should have only one statement.\n" in let res_trans_stmt = instruction trans_state stmt in let idl = res_trans_stmt.ids in @@ -1079,8 +1079,8 @@ struct and compoundAssignOperator trans_state stmt_info binary_operator_info expr_info stmt_list = let context = trans_state.context in let pln = trans_state.parent_line_number in - Printing.log_out ~fmt:"Passing from CompoundAssignOperator '%s'" stmt_info.Clang_ast_t.si_pointer; - Printing.log_out ~fmt:"'%s' .\n" + Printing.log_out "Passing from CompoundAssignOperator '%s'" stmt_info.Clang_ast_t.si_pointer; + Printing.log_out "'%s' .\n" (Clang_ast_j.string_of_binary_operator_kind binary_operator_info.Clang_ast_t.boi_kind); (* claim priority if no ancestors has claimed priority before *) let trans_state_pri = PriorityNode.try_claim_priority_node trans_state stmt_info in @@ -1280,7 +1280,7 @@ struct (* the init expression. We use the latter info. *) and declStmt_trans trans_state decl_list stmt_info = let succ_nodes = trans_state.succ_nodes in - Printing.log_out ~fmt:"Passing from DeclStmt '%s' \n" stmt_info.Clang_ast_t.si_pointer; + Printing.log_out "Passing from DeclStmt '%s' \n" stmt_info.Clang_ast_t.si_pointer; let line_number = get_line stmt_info trans_state.parent_line_number in let trans_state' = { trans_state with parent_line_number = line_number } in let res_trans = (match decl_list with @@ -1296,14 +1296,14 @@ struct { res_trans with leaf_nodes = []} and objCPropertyRefExpr_trans trans_state stmt_info stmt_list = - Printing.log_out ~fmt:"Passing from ObjCPropertyRefExpr '%s' \n" stmt_info.Clang_ast_t.si_pointer; + Printing.log_out "Passing from ObjCPropertyRefExpr '%s' \n" stmt_info.Clang_ast_t.si_pointer; (match stmt_list with | [stmt] -> instruction trans_state stmt | _ -> assert false) (* For OpaqueValueExpr we return the translation generated from its source expression*) and opaqueValueExpr_trans trans_state stmt_info opaque_value_expr_info = - Printing.log_out ~fmt:"Passing from OpaqueValueExpr '%s' \n" stmt_info.Clang_ast_t.si_pointer; + Printing.log_out "Passing from OpaqueValueExpr '%s' \n" stmt_info.Clang_ast_t.si_pointer; (match opaque_value_expr_info.Clang_ast_t.ovei_source_expr with | Some stmt -> instruction trans_state stmt | _ -> assert false) @@ -1325,7 +1325,7 @@ struct and pseudoObjectExpr_trans trans_state stmt_info stmt_list = let line_number = get_line stmt_info trans_state.parent_line_number in let trans_state' = { trans_state with parent_line_number = line_number } in - Printing.log_out ~fmt:"Passing from PseudoObjectExpr '%s' \n" stmt_info.Clang_ast_t.si_pointer; + Printing.log_out "Passing from PseudoObjectExpr '%s' \n" stmt_info.Clang_ast_t.si_pointer; let rec do_semantic_elements el = (match el with | OpaqueValueExpr _ :: el' -> do_semantic_elements el' @@ -1340,7 +1340,7 @@ struct and cast_exprs_trans trans_state stmt_info stmt_list expr_info cast_expr_info is_objc_bridged = let context = trans_state.context in let pln = trans_state.parent_line_number in - Printing.log_out ~fmt:"Passing from CastExpr '%s' \n" stmt_info.Clang_ast_t.si_pointer; + Printing.log_out "Passing from CastExpr '%s' \n" stmt_info.Clang_ast_t.si_pointer; let sil_loc = get_sil_location stmt_info pln context in let stmt = extract_stmt_from_singleton stmt_list "WARNING: In CastExpr There must be only one stmt defining the expression to be cast.\n" in @@ -1359,7 +1359,7 @@ struct (* function used in the computation for both Member_Expr and ObjCIVarRefExpr *) and do_memb_ivar_ref_exp trans_state expr_info exp_stmt sil_loc nfield = - Printing.log_out ~fmt:"!!!!! Dealing with field '%s' @." nfield; + Printing.log_out "!!!!! Dealing with field '%s' @." nfield; let res_trans_exp_stmt = instruction trans_state exp_stmt in let (e, class_typ) = extract_exp_from_list res_trans_exp_stmt.exps "WARNING: in MemberExpr we expect the translation of the stmt to return an expression\n" in @@ -1372,7 +1372,7 @@ struct (match class_typ with | Sil.Tvoid -> Sil.exp_minus_one | _ -> - Printing.log_out ~fmt:"Type is '%s' @." (Sil.typ_to_string class_typ); + Printing.log_out "Type is '%s' @." (Sil.typ_to_string class_typ); ( match ObjcInterface_decl.find_field trans_state.context.tenv nfield (Some class_typ) false with | Some (fn, _, _) -> Sil.Lfield (e, fn, class_typ) | None -> assert false)) in @@ -1380,7 +1380,7 @@ struct exps = [(exp, typ)] } and objCIvarRefExpr_trans trans_state stmt_info expr_info stmt_list obj_c_ivar_ref_expr_info = - Printing.log_out ~fmt:"Passing from ObjCIvarRefExpr '%s'\n" stmt_info.Clang_ast_t.si_pointer; + Printing.log_out "Passing from ObjCIvarRefExpr '%s'\n" stmt_info.Clang_ast_t.si_pointer; let sil_loc = get_sil_location stmt_info trans_state.parent_line_number trans_state.context in let exp_stmt = extract_stmt_from_singleton stmt_list "WARNING: in MemberExpr there must be only one stmt defining its expression.\n" in @@ -1390,7 +1390,7 @@ struct do_memb_ivar_ref_exp trans_state expr_info exp_stmt sil_loc name_field and memberExpr_trans trans_state stmt_info expr_info stmt_list member_expr_info = - Printing.log_out ~fmt:"Passing from MemberExpr '%s'\n" stmt_info.Clang_ast_t.si_pointer; + Printing.log_out "Passing from MemberExpr '%s'\n" stmt_info.Clang_ast_t.si_pointer; let sil_loc = get_sil_location stmt_info trans_state.parent_line_number trans_state.context in let exp_stmt = extract_stmt_from_singleton stmt_list "WARNING: in MemberExpr there must be only one stmt defining its expression.\n" in @@ -1400,7 +1400,7 @@ struct and unaryOperator_trans trans_state stmt_info expr_info stmt_list unary_operator_info = let context = trans_state.context in let pln = trans_state.parent_line_number in - Printing.log_out ~fmt:"Passing from UnaryOperator '%s'\n" stmt_info.Clang_ast_t.si_pointer; + Printing.log_out "Passing from UnaryOperator '%s'\n" stmt_info.Clang_ast_t.si_pointer; let sil_loc = get_sil_location stmt_info pln context in let line_number = get_line stmt_info pln in let trans_state_pri = PriorityNode.try_claim_priority_node trans_state stmt_info in @@ -1445,7 +1445,7 @@ struct let context = trans_state.context in let pln = trans_state.parent_line_number in let succ_nodes = trans_state.succ_nodes in - Printing.log_out ~fmt:"Passing from ReturnOperator '%s'.\n" stmt_info.Clang_ast_t.si_pointer; + Printing.log_out "Passing from ReturnOperator '%s'.\n" stmt_info.Clang_ast_t.si_pointer; let sil_loc = get_sil_location stmt_info pln context in let line_number = get_line stmt_info pln in let trans_state_pri = PriorityNode.try_claim_priority_node trans_state stmt_info in @@ -1480,7 +1480,7 @@ struct (* For ParenExpression we translate its body composed by the stmt_list. *) (* In paren expression there should be only one stmt that defines the expression *) and parenExpr_trans trans_state stmt_info stmt_list = - Printing.log_out ~fmt:"Passing from ParenExpr '%s' \n" stmt_info.Clang_ast_t.si_pointer; + Printing.log_out "Passing from ParenExpr '%s' \n" stmt_info.Clang_ast_t.si_pointer; let line_number = get_line stmt_info trans_state.parent_line_number in let trans_state'= { trans_state with parent_line_number = line_number } in let stmt = extract_stmt_from_singleton stmt_list @@ -1539,13 +1539,13 @@ struct (* For the same reason we also ignore the stmt_info that is related with the ObjCAtSynchronizedStmt construct *) (* Finally we recursively work on the CompoundStmt, the second item of stmt_list *) and objCAtSynchronizedStmt_trans trans_state stmt_info stmt_list = - Printing.log_out ~fmt:"Passing from `ObjCAtSynchronizedStmt '%s' \n" stmt_info.Clang_ast_t.si_pointer; + Printing.log_out "Passing from `ObjCAtSynchronizedStmt '%s' \n" stmt_info.Clang_ast_t.si_pointer; (match stmt_list with | [_; compound_stmt] -> instruction trans_state compound_stmt | _ -> assert false) and blockExpr_trans trans_state stmt_info expr_info decl = - Printing.log_out ~fmt:"Passing from BlockExpr '%s' \n" stmt_info.Clang_ast_t.si_pointer; + Printing.log_out "Passing from BlockExpr '%s' \n" stmt_info.Clang_ast_t.si_pointer; let context = trans_state.context in let pln = trans_state.parent_line_number in let procname = Cfg.Procdesc.get_proc_name context.procdesc in @@ -1609,7 +1609,7 @@ struct gotoStmt_trans trans_state stmt_info label_name | LabelStmt(stmt_info, stmt_list, label_name) -> - Printing.log_out ~fmt:"\nPassing from `LabelStmt '%s' \n" stmt_info.Clang_ast_t.si_pointer; + Printing.log_out "\nPassing from `LabelStmt '%s' \n" stmt_info.Clang_ast_t.si_pointer; labelStmt_trans trans_state stmt_info stmt_list label_name | ArraySubscriptExpr(stmt_info, stmt_list, expr_info) -> @@ -1786,16 +1786,16 @@ struct (match stmts with | [stmt1; ostmt1; ostmt2; stmt2] when contains_opaque_value_expr ostmt1 && contains_opaque_value_expr ostmt2 -> conditionalOperator_trans trans_state stmt_info [stmt1; stmt1; stmt2] expr_info - | _ -> Printing.log_stats ~fmt: "BinaryConditionalOperator not translated %s @." (Ast_utils.string_of_stmt instr); + | _ -> Printing.log_stats "BinaryConditionalOperator not translated %s @." (Ast_utils.string_of_stmt instr); assert false) | s -> (Printing.log_stats - ~fmt:"\n!!!!WARNING: found statement %s. \nACTION REQUIRED: Translation need to be defined. Statement ignored.... \n" + "\n!!!!WARNING: found statement %s. \nACTION REQUIRED: Translation need to be defined. Statement ignored.... \n" (Ast_utils.string_of_stmt s); assert false) (* Given a translation state, this function traslates a list of clang statements. *) and instructions trans_state clang_stmt_list = - (* Printing.log_err ~fmt:"\n instruction list %i" (List.length clang_stmt_list); *) + (* Printing.log_err "\n instruction list %i" (List.length clang_stmt_list); *) match clang_stmt_list with | [] -> { empty_res_trans with root_nodes = trans_state.succ_nodes } | s:: clang_stmt_list' -> diff --git a/infer/src/clang/cTrans_utils.ml b/infer/src/clang/cTrans_utils.ml index a846cc258..7531e3575 100644 --- a/infer/src/clang/cTrans_utils.ml +++ b/infer/src/clang/cTrans_utils.ml @@ -19,7 +19,7 @@ module L = Logging let extract_item_from_singleton l warning_string failure_val = match l with | [item] -> item - | _ -> Printing.log_err warning_string; failure_val + | _ -> Printing.log_err "%s" warning_string; failure_val let dummy_exp = (Sil.exp_minus_one, Sil.Tint Sil.IInt) @@ -362,7 +362,7 @@ let cast_operation context cast_kind exps cast_typ sil_loc is_objc_bridged = ([], [], Sil.Cast(typ, exp)) | _ -> Printing.log_err - ~fmt:"\nWARNING: Missing translation for Cast Kind %s. The construct has been ignored...\n" + "\nWARNING: Missing translation for Cast Kind %s. The construct has been ignored...\n" (Clang_ast_j.string_of_cast_kind cast_kind); ([],[], exp) @@ -451,14 +451,14 @@ let get_value_enum_constant tenv enum_type stmt = let typename = Sil.TN_enum(Mangled.from_string enum_type) in match Sil.tenv_lookup tenv typename with | Some (Sil.Tenum enum_constants) -> - Printing.log_out ~fmt:">>>Found enum with typename TN_typename('%s')\n" (Sil.typename_to_string typename); + Printing.log_out ">>>Found enum with typename TN_typename('%s')\n" (Sil.typename_to_string typename); let _, v = try list_find (fun (c, _) -> Mangled.equal c (Mangled.from_string constant)) enum_constants with _ -> (Printing.log_err - ~fmt:"Enumeration constant '%s' not found. Cannot continue...\n" constant; assert false) in + "Enumeration constant '%s' not found. Cannot continue...\n" constant; assert false) in v | _ -> Printing.log_err - ~fmt:"Enum type '%s' not found in tenv. Cannot continue...\n" (Sil.typename_to_string typename); + "Enum type '%s' not found in tenv. Cannot continue...\n" (Sil.typename_to_string typename); assert false let get_selector_receiver obj_c_message_expr_info = @@ -520,7 +520,7 @@ let rec get_type_from_exp_stmt stmt = | ImplicitCastExpr(_, stmt_list, _, _) -> get_type_from_exp_stmt (extract_stmt_from_singleton stmt_list "WARNING: We expect only one stmt.") | DeclRefExpr(_, _, _, info) -> do_decl_ref_exp info - | _ -> Printing.log_err ~fmt:"Failing with: %s \n%!" (Clang_ast_j.string_of_stmt stmt); + | _ -> Printing.log_err "Failing with: %s \n%!" (Clang_ast_j.string_of_stmt stmt); Printing.print_failure_info ""; assert false diff --git a/infer/src/clang/cTypes.ml b/infer/src/clang/cTypes.ml index 948883173..74eada090 100644 --- a/infer/src/clang/cTypes.ml +++ b/infer/src/clang/cTypes.ml @@ -21,7 +21,7 @@ let get_function_return_type s = match buf with | ret:: _ -> let ret'= String.trim ret in - Printing.log_out ~fmt:"return type ='%s'@." ret'; + Printing.log_out "return type ='%s'@." ret'; ret' | _ -> assert false @@ -38,24 +38,24 @@ let lookup_var_type context pvar = let locals = Cfg.Procdesc.get_locals context.CContext.procdesc in try let s, t = list_find (fun (s, t) -> s = (Sil.pvar_to_string pvar)) formals in - Printing.log_out ~fmt:"When looking for type of variable '%s' " (Sil.pvar_to_string pvar); - Printing.log_out ~fmt:"found '%s' in formals.@." (Sil.typ_to_string t); + Printing.log_out "When looking for type of variable '%s' " (Sil.pvar_to_string pvar); + Printing.log_out "found '%s' in formals.@." (Sil.typ_to_string t); t with Not_found -> try let s, t = list_find (fun (s, t) -> Mangled.equal (Sil.pvar_get_name pvar) s) locals in - Printing.log_out ~fmt:"When looking for type of variable '%s' " (Sil.pvar_to_string pvar); - Printing.log_out ~fmt:"found '%s' in locals.@." (Sil.typ_to_string t); + Printing.log_out "When looking for type of variable '%s' " (Sil.pvar_to_string pvar); + Printing.log_out "found '%s' in locals.@." (Sil.typ_to_string t); t with Not_found -> try let typ = CGlobal_vars.var_get_typ (CGlobal_vars.find (Sil.pvar_get_name pvar)) in - Printing.log_out ~fmt:"When looking for type of variable '%s'" (Sil.pvar_to_string pvar); - Printing.log_out ~fmt:" found '%s' in globals.@." (Sil.typ_to_string typ); + Printing.log_out "When looking for type of variable '%s'" (Sil.pvar_to_string pvar); + Printing.log_out " found '%s' in globals.@." (Sil.typ_to_string typ); typ with Not_found -> Printing.log_err - ~fmt:"WARNING: Variable '%s' not found in local+formal when looking for its type. Returning void.\n%!" + "WARNING: Variable '%s' not found in local+formal when looking for its type. Returning void.\n%!" (Sil.pvar_to_string pvar); Sil.Tvoid @@ -116,7 +116,7 @@ let extract_type_from_stmt s = | UnaryOperator(_, _, expr_info, _) | VAArgExpr (_, _, expr_info) -> expr_info.Clang_ast_t.ei_qual_type | _ -> (* For the other case we cannot get the type info *) - Printing.log_err ~fmt:"WARNING: Could not get type of statement '%s'\n%!" (Clang_ast_j.string_of_stmt s); + Printing.log_err "WARNING: Could not get type of statement '%s'\n%!" (Clang_ast_j.string_of_stmt s); assert false let get_desugared_type t = @@ -127,7 +127,7 @@ let get_desugared_type t = (* Remove the work 'struct' from a type name. Used to avoid repetition when typename are constructed*) (* E.g. 'struct struct s' *) let cut_struct_union s = - Printing.log_out ~fmt:"Cutting '%s'@." s; + Printing.log_out "Cutting '%s'@." s; let buf = Str.split (Str.regexp "[ \t]+") s in match buf with | "struct":: l (*-> Printing.string_from_list l *) @@ -145,7 +145,7 @@ let rec get_type_list nn ll = | [] -> [] | (n, t):: ll' -> (* Printing.log_out ">>>>>Searching for type '%s'. Seen '%s'.@." nn n; *) if n = nn then ( - Printing.log_out ~fmt:">>>>>>>>>>>>>>>>>>>>>>>NOW Found, Its type is: '%s'@." (Sil.typ_to_string t); + Printing.log_out ">>>>>>>>>>>>>>>>>>>>>>>NOW Found, Its type is: '%s'@." (Sil.typ_to_string t); [t] ) else get_type_list nn ll' @@ -163,8 +163,10 @@ let classname_of_type typ = | Sil.Tstruct(_, _, _, (Some name), _, _, _) | Sil.Tvar (Sil.TN_typedef name) -> Mangled.to_string name | Sil.Tfun _ -> CFrontend_config.objc_object - | _ -> (Printing.log_out - ~fmt:"Classname of type cannot be extracted in type %s" (Sil.typ_to_string typ)); assert false + | _ -> + Printing.log_out + "Classname of type cannot be extracted in type %s" (Sil.typ_to_string typ); + assert false let get_raw_qual_type_decl_ref_exp_info decl_ref_expr_info = match decl_ref_expr_info.Clang_ast_t.drti_decl_ref with diff --git a/infer/src/clang/cTypes_decl.ml b/infer/src/clang/cTypes_decl.ml index 4eeb539ad..4bb14e064 100644 --- a/infer/src/clang/cTypes_decl.ml +++ b/infer/src/clang/cTypes_decl.ml @@ -67,7 +67,7 @@ let rec search_for_named_type tenv typ = (* parsing and then translating the type The parser is higher-order and *) (* takes a tenv as needs to do look-ups *) let string_type_to_sil_type tenv s = - Printing.log_out ~fmt:" ...Trying parsing TYPE from string: '%s'@." s; + Printing.log_out " ...Trying parsing TYPE from string: '%s'@." s; if s = "" then ( Printing.log_stats "\n Empty string parsed as type Void.\n"; Sil.Tvoid) @@ -91,16 +91,16 @@ let string_type_to_sil_type tenv s = let t = try let t = CTypes_parser.parse (Ast_lexer.token) lexbuf in - Printing.log_out ~fmt: + Printing.log_out " ...Parsed. Translated with sil TYPE '%s'@." (Sil.typ_to_string t); t with Parsing.Parse_error -> ( Printing.log_stats - ~fmt:"\nXXXXXXX PARSE ERROR for string '%s'. RETURNING Void.TODO@.@." s; + "\nXXXXXXX PARSE ERROR for string '%s'. RETURNING Void.TODO@.@." s; Sil.Tvoid) in try search_for_named_type tenv t with Typename_not_found -> Printing.log_stats - ~fmt:"\nXXXXXX Parsed string '%s' as UNKNOWN type name. RETURNING a type name.TODO@.@." s; + "\nXXXXXX Parsed string '%s' as UNKNOWN type name. RETURNING a type name.TODO@.@." s; t) let qual_type_to_sil_type_no_expansions tenv qt = @@ -120,12 +120,12 @@ let parse_func_type name func_type = match arg_types with | [Sil.Tvoid] -> [] | _ -> arg_types in - Printing.log_out ~fmt: + Printing.log_out " ...Parsed. Translated with sil return type '%s' @." ((Sil.typ_to_string return_type)^" <- "^(Utils.list_to_string (Sil.typ_to_string) arg_types)); Some (return_type, arg_types) with Parsing.Parse_error -> ( - Printing.log_stats ~fmt:"\nXXXXXXX PARSE ERROR for string '%s'." func_type; + Printing.log_stats "\nXXXXXXX PARSE ERROR for string '%s'." func_type; None) (*In case of typedef like *) @@ -145,9 +145,9 @@ let rec disambiguate_typedef tenv namespace t mn = (match Sil.tenv_lookup tenv tn with | Some _ -> (* There is a struct in tenv, so we make the typedef mn pointing to the struct*) - Printing.log_out ~fmt:" ...Found type TN_typdef('%s') " (Mangled.to_string mn); - Printing.log_out ~fmt:"in typedef of '%s'@." (Mangled.to_string mn); - Printing.log_out ~fmt: + Printing.log_out " ...Found type TN_typdef('%s') " (Mangled.to_string mn); + Printing.log_out "in typedef of '%s'@." (Mangled.to_string mn); + Printing.log_out "Avoid circular definition in tenv by pointing the typedef to struc TN_csu('%s')@." (Mangled.to_string mn); Sil.Tvar(tn) @@ -168,9 +168,9 @@ and do_typedef_declaration tenv namespace decl_info name opt_type typedef_decl_i let t = opt_type_to_sil_type tenv opt_type in (* check for ambiguities in typedef that may create circularities in tenv*) let typ = disambiguate_typedef tenv namespace t mn in - Printing.log_out ~fmt:"ADDING: TypedefDecl for '%s'" name; - Printing.log_out ~fmt:" with type '%s'\n" (Sil.typ_to_string typ); - Printing.log_out ~fmt:" ...Adding entry to tenv with Typename TN_typedef = '%s'\n" + Printing.log_out "ADDING: TypedefDecl for '%s'" name; + Printing.log_out " with type '%s'\n" (Sil.typ_to_string typ); + Printing.log_out " ...Adding entry to tenv with Typename TN_typedef = '%s'\n" (Sil.typename_to_string typename); Sil.tenv_add tenv typename typ @@ -178,7 +178,7 @@ and get_struct_fields tenv namespace decl_list = match decl_list with | [] -> [] | FieldDecl(decl_info, name, qual_type, field_decl_info):: decl_list' -> - Printing.log_out ~fmt:" ...Defining field '%s'.\n" name; + Printing.log_out " ...Defining field '%s'.\n" name; let id = Ident.create_fieldname (Mangled.from_string name) 0 in let typ = qual_type_to_sil_type tenv qual_type in let annotation_items = [] in (* For the moment we don't use them*) @@ -193,8 +193,8 @@ and get_struct_fields tenv namespace decl_list = | _ :: decl_list' -> get_struct_fields tenv namespace decl_list' and do_record_declaration tenv namespace decl_info name opt_type decl_list decl_context_info record_decl_info = - Printing.log_out ~fmt:"ADDING: RecordDecl for '%s'" name; - Printing.log_out ~fmt:" pointer= '%s'\n" decl_info.Clang_ast_t.di_pointer; + Printing.log_out "ADDING: RecordDecl for '%s'" name; + Printing.log_out " pointer= '%s'\n" decl_info.Clang_ast_t.di_pointer; if not record_decl_info.Clang_ast_t.rdi_is_complete_definition then Printing.log_err " ...Warning, definition incomplete. The full definition will probably be later \n"; let typ = get_declaration_type tenv namespace decl_info name opt_type decl_list decl_context_info record_decl_info in @@ -205,7 +205,7 @@ and do_record_declaration tenv namespace decl_info name opt_type decl_list decl_ and get_declaration_type tenv namespace decl_info n opt_type decl_list decl_context_info record_decl_info = let ns_suffix = Ast_utils.namespace_to_string namespace in let n = ns_suffix^n in - Printing.log_out ~fmt: "Record Declaration '%s' defined as struct\n" n; + Printing.log_out "Record Declaration '%s' defined as struct\n" n; let non_static_fields = get_struct_fields tenv namespace decl_list in let non_static_fields = if CTrans_models.is_objc_memory_model_controlled n then append_no_duplicates_fields [Sil.objc_ref_counter_field] non_static_fields @@ -229,7 +229,7 @@ and get_declaration_type tenv namespace decl_info n opt_type decl_list decl_cont (* Look for a record definition that is defined after it is dereferenced. *) (* It returns true if a new record definition has been added to tenv.*) and add_late_defined_record tenv namespace typename = - Printing.log_out ~fmt:"!!!! Calling late-defined record '%s'\n" (Sil.typename_to_string typename) ; + Printing.log_out "!!!! Calling late-defined record '%s'\n" (Sil.typename_to_string typename) ; match typename with | Sil.TN_csu(Sil.Struct, name) | Sil.TN_csu(Sil.Union, name) -> let rec scan decls = @@ -250,7 +250,7 @@ and add_late_defined_record tenv namespace typename = if (Sil.typename_equal typename pot_struct_type || Sil.typename_equal typename pot_union_type) && record_decl_info.Clang_ast_t.rdi_is_complete_definition then ( - Printing.log_out ~fmt:"!!!! Adding late-defined record '%s'\n" t; + Printing.log_out "!!!! Adding late-defined record '%s'\n" t; do_record_declaration tenv namespace decl_info record_name opt_type decl_list decl_context_info record_decl_info; true) @@ -264,7 +264,7 @@ and add_late_defined_record tenv namespace typename = (* Look for a typedef definition that is defined after it is used. *) (* It returns true if a new typedef definition has been added to tenv.*) and add_late_defined_typedef tenv namespace typename = - Printing.log_out ~fmt:"Calling late-defined typedef '%s'\n" (Sil.typename_to_string typename); + Printing.log_out "Calling late-defined typedef '%s'\n" (Sil.typename_to_string typename); match typename with | Sil.TN_typedef name -> let rec scan decls = @@ -274,7 +274,7 @@ and add_late_defined_typedef tenv namespace typename = (match opt_type with | `Type t -> if (Mangled.to_string name) = name' then ( - Printing.log_out ~fmt:"!!!! Adding late-defined typedef '%s'\n" t; + Printing.log_out "!!!! Adding late-defined typedef '%s'\n" t; do_typedef_declaration tenv namespace decl_info name' opt_type tdi; true) else scan decls' @@ -291,7 +291,7 @@ and expand_structured_type tenv typ = (match Sil.tenv_lookup tenv tn with | Some t -> Printing.log_out - ~fmt:" Type expanded with type '%s' found in tenv@." (Sil.typ_to_string t); + " Type expanded with type '%s' found in tenv@." (Sil.typ_to_string t); if Sil.typ_equal t typ then typ else expand_structured_type tenv t @@ -309,16 +309,16 @@ and add_struct_to_tenv tenv typ = | _ -> assert false in let mangled = CTypes.get_name_from_struct typ in let typename = Sil.TN_csu(csu, mangled) in - Printing.log_out ~fmt:" >>>Adding struct to tenv mangled='%s'\n" (Mangled.to_string mangled); - Printing.log_out ~fmt:" >>>Adding struct to tenv typ='%s'\n" (Sil.typ_to_string typ); - Printing.log_out ~fmt:" >>>with Key Typename TN_csu('%s')\n" (Sil.typename_to_string typename); - Printing.log_out ~fmt:" >>>Adding entry to tenv ('%s'," (Sil.typename_to_string typename); - Printing.log_out ~fmt:"'%s')\n" (Sil.typ_to_string typ); + Printing.log_out " >>>Adding struct to tenv mangled='%s'\n" (Mangled.to_string mangled); + Printing.log_out " >>>Adding struct to tenv typ='%s'\n" (Sil.typ_to_string typ); + Printing.log_out " >>>with Key Typename TN_csu('%s')\n" (Sil.typename_to_string typename); + Printing.log_out " >>>Adding entry to tenv ('%s'," (Sil.typename_to_string typename); + Printing.log_out "'%s')\n" (Sil.typ_to_string typ); Sil.tenv_add tenv typename typ; - Printing.log_out ~fmt:" >>>Verifying that Typename TN_csu('%s') is in tenv\n" + Printing.log_out " >>>Verifying that Typename TN_csu('%s') is in tenv\n" (Sil.typename_to_string typename); (match Sil.tenv_lookup tenv typename with - | Some t -> Printing.log_out ~fmt:" >>>OK. Found typ='%s'\n" (Sil.typ_to_string t) + | Some t -> Printing.log_out " >>>OK. Found typ='%s'\n" (Sil.typ_to_string t) | None -> Printing.log_out " >>>NOT Found!!\n") and qual_type_to_sil_type_general tenv qt no_pointer = diff --git a/infer/src/clang/cTypes_parser.mly b/infer/src/clang/cTypes_parser.mly index 93d5b6c1e..cb709164d 100644 --- a/infer/src/clang/cTypes_parser.mly +++ b/infer/src/clang/cTypes_parser.mly @@ -217,7 +217,7 @@ clang_type: | VOLATILE pointer_clang_type { $2 } | ident ANONYM_IDENT { CFrontend_utils.Printing.log_out " ...Found just an identifier modified with a protocol. Ignoring protocol!. Parsing as Named Type!\n"; Sil.Tvar (Sil.TN_typedef(Mangled.from_string $1))} - | ident { CFrontend_utils.Printing.log_out ~fmt:" ...Found just an identifier. Parsing as Named Type %s !\n" $1; + | ident { CFrontend_utils.Printing.log_out " ...Found just an identifier. Parsing as Named Type %s !\n" $1; Sil.Tvar (Sil.TN_typedef(Mangled.from_string $1))} | csu_sil ident_csu { let typename=Sil.TN_csu($1, Mangled.from_string $2) in Sil.Tvar typename } diff --git a/infer/src/clang/cVar_decl.ml b/infer/src/clang/cVar_decl.ml index 329015c03..b46aede5d 100644 --- a/infer/src/clang/cVar_decl.ml +++ b/infer/src/clang/cVar_decl.ml @@ -15,8 +15,8 @@ module L = Logging (* For a variable declaration it return/construct the type *) let get_var_type tenv name t = let typ = CTypes_decl.qual_type_to_sil_type tenv t in - Printing.log_out ~fmt:" Getting/Defining type for variable '%s'" name; - Printing.log_out ~fmt:" as sil type '%s'\n" (Sil.typ_to_string typ); + Printing.log_out " Getting/Defining type for variable '%s'" name; + Printing.log_out " as sil type '%s'\n" (Sil.typ_to_string typ); typ (* NOTE: Currently we use this function to avoid certain C++ global variable definition defined *) @@ -26,31 +26,31 @@ let global_to_be_added di = (di.Clang_ast_t.di_parent_pointer = None) && (di.Clang_ast_t.di_previous_decl =`None) let global_var_decl tenv namespace decl_info name t = - Printing.log_out ~fmt:"PASSING: VarDecl for '%s' to global procdesc" name; - Printing.log_out ~fmt:" pointer= '%s'\n" decl_info.Clang_ast_t.di_pointer; + Printing.log_out "PASSING: VarDecl for '%s' to global procdesc" name; + Printing.log_out " pointer= '%s'\n" decl_info.Clang_ast_t.di_pointer; if global_to_be_added decl_info then ( let typ = get_var_type tenv name t in - Printing.log_out ~fmt:" >>> Adding entry to global procdesc: ('%s', " name; - Printing.log_out ~fmt:"'%s')\n" (Sil.typ_to_string typ); + Printing.log_out " >>> Adding entry to global procdesc: ('%s', " name; + Printing.log_out "'%s')\n" (Sil.typ_to_string typ); CGlobal_vars.add name typ) - else Printing.log_out ~fmt:"SKIPPING VarDecl for '%s'\n" name + else Printing.log_out "SKIPPING VarDecl for '%s'\n" name let rec lookup_ahead_for_vardecl context pointer var_name kind decl_list = match decl_list with - | [] -> Printing.log_out ~fmt:" Failing when looking ahead for variable '%s'\n" var_name; + | [] -> Printing.log_out " Failing when looking ahead for variable '%s'\n" var_name; assert false (* nothing has been found ahead, maybe something bad in the AST *) | VarDecl(decl_info, var_name', t, _) :: rest when var_name = var_name' -> if global_to_be_added decl_info then ( let tenv = CContext.get_tenv context in - Printing.log_out ~fmt:"ADDING (later-defined): VarDecl '%s' to global procdesc\n" var_name'; + Printing.log_out "ADDING (later-defined): VarDecl '%s' to global procdesc\n" var_name'; let typ = get_var_type tenv var_name' t in - Printing.log_out ~fmt:" >>> Adding (later-defined) entry to global procdesc: ('%s', " var_name'; - Printing.log_out ~fmt:"'%s')\n" (Sil.typ_to_string typ); + Printing.log_out " >>> Adding (later-defined) entry to global procdesc: ('%s', " var_name'; + Printing.log_out "'%s')\n" (Sil.typ_to_string typ); CGlobal_vars.add var_name' typ; let mangled_var_name = Mangled.from_string var_name' in let global_var = CGlobal_vars.find mangled_var_name in CGlobal_vars.var_get_name global_var) - else (Printing.log_out ~fmt:"SKIPPING VarDecl for '%s'\n" var_name; + else (Printing.log_out "SKIPPING VarDecl for '%s'\n" var_name; lookup_ahead_for_vardecl context pointer var_name kind rest) | _ :: rest -> lookup_ahead_for_vardecl context pointer var_name kind rest @@ -74,11 +74,11 @@ let lookup_var_static_globals context name = let pname = Cfg.Procdesc.get_proc_name context.CContext.procdesc in let str_pname = remove_block_name pname in let static_name = Sil.mk_static_local_name str_pname name in - Printing.log_out ~fmt:" ...Looking for variable '%s' in static globals...\n" static_name; + Printing.log_out " ...Looking for variable '%s' in static globals...\n" static_name; let var_name = Mangled.from_string static_name in let global_var = CGlobal_vars.find var_name in let var = CGlobal_vars.var_get_name global_var in - Printing.log_out ~fmt:" ...Variable '%s' found in static globals!!\n" (Sil.pvar_to_string var); + Printing.log_out " ...Variable '%s' found in static globals!!\n" (Sil.pvar_to_string var); var let lookup_var stmt_info context pointer var_name kind = @@ -89,7 +89,7 @@ let lookup_var stmt_info context pointer var_name kind = try lookup_var_static_globals context var_name with Not_found -> - (Printing.log_out ~fmt:"Looking on later-defined decls for '%s'\n" var_name; + (Printing.log_out "Looking on later-defined decls for '%s'\n" var_name; let decl_list = !CFrontend_config.global_translation_unit_decls in lookup_ahead_for_vardecl context pointer var_name kind decl_list ) @@ -105,7 +105,7 @@ let rec get_variables_stmt context (stmt : Clang_ast_t.stmt) : unit = | DeclRefExpr(stmt_info, stmt_list, expr_info, decl_ref_expr_info) -> (* Notice that DeclRefExpr is the reference to a declared var/function/enum... *) (* so no declaration here *) - Printing.log_out ~fmt:"Collecting variables, passing from DeclRefExpr '%s'\n" + Printing.log_out "Collecting variables, passing from DeclRefExpr '%s'\n" stmt_info.Clang_ast_t.si_pointer; let var_name = CTrans_utils.get_name_decl_ref_exp_info decl_ref_expr_info stmt_info in let kind = CTrans_utils.get_decl_kind decl_ref_expr_info in @@ -115,11 +115,11 @@ let rec get_variables_stmt context (stmt : Clang_ast_t.stmt) : unit = let pvar = lookup_var stmt_info context stmt_info.Clang_ast_t.si_pointer var_name kind in CContext.LocalVars.add_pointer_var stmt_info.Clang_ast_t.si_pointer pvar context) | CompoundStmt(stmt_info, lstmt) -> - Printing.log_out ~fmt:"Collecting variables, passing from CompoundStmt '%s'\n" + Printing.log_out "Collecting variables, passing from CompoundStmt '%s'\n" stmt_info.Clang_ast_t.si_pointer; CContext.LocalVars.enter_and_leave_scope context get_fun_locals lstmt | ForStmt(stmt_info, lstmt) -> - Printing.log_out ~fmt:"Collecting variables, passing from ForStmt '%s'\n" + Printing.log_out "Collecting variables, passing from ForStmt '%s'\n" stmt_info.Clang_ast_t.si_pointer; CContext.LocalVars.enter_and_leave_scope context get_fun_locals lstmt | _ -> @@ -138,7 +138,7 @@ and get_variables_decls context (decl_list : Clang_ast_t.decl list) : unit = let do_one_decl decl = match decl with | VarDecl (decl_info, name, qual_type, var_decl_info) -> - Printing.log_out ~fmt:"Collecting variables, passing from VarDecl '%s'\n" decl_info.Clang_ast_t.di_pointer; + Printing.log_out "Collecting variables, passing from VarDecl '%s'\n" decl_info.Clang_ast_t.di_pointer; let typ = get_var_type context.CContext.tenv name qual_type in (match var_decl_info.Clang_ast_t.vdi_storage_class with | Some "static" -> @@ -160,10 +160,10 @@ and get_variables_decls context (decl_list : Clang_ast_t.decl list) : unit = decl_info name opt_type typedef_decl_info | StaticAssertDecl decl_info -> (* We do not treat Assertions. *) Printing.log_out - ~fmt:"WARNING: When collecting variables, passing from StaticAssertDecl '%s'. Skipped.\n" + "WARNING: When collecting variables, passing from StaticAssertDecl '%s'. Skipped.\n" decl_info.Clang_ast_t.di_pointer | _ -> Printing.log_out - ~fmt:"!!! When collecting locals of a function found '%s'. Cannot continue\n\n" + "!!! When collecting locals of a function found '%s'. Cannot continue\n\n" (Clang_ast_j.string_of_decl decl); assert false in list_iter do_one_decl decl_list diff --git a/infer/src/clang/objcCategory_decl.ml b/infer/src/clang/objcCategory_decl.ml index 2223129d8..c1c6c98e7 100644 --- a/infer/src/clang/objcCategory_decl.ml +++ b/infer/src/clang/objcCategory_decl.ml @@ -39,7 +39,7 @@ let get_category_name_from_category_impl category_impl_info = (* to the corresponding class. Update the tenv accordingly.*) let process_category tenv name class_name decl_list = let name = if name ="" then noname_category class_name else name in - Printing.log_out ~fmt:"Now name is '%s'\n" name; + Printing.log_out "Now name is '%s'\n" name; let curr_class = CContext.ContextCategory (name, class_name) in let fields = CField_decl.get_fields tenv curr_class decl_list in let methods = ObjcProperty_decl.get_methods curr_class decl_list in @@ -53,19 +53,19 @@ let process_category tenv name class_name decl_list = Sil.Tstruct ( new_fields, [], Sil.Class, Some mang_name, superclass, new_methods, annotation ) in - Printing.log_out ~fmt:" Updating info for class '%s' in tenv\n" class_name; + Printing.log_out " Updating info for class '%s' in tenv\n" class_name; Sil.tenv_add tenv class_tn_name class_type_info; curr_class | _ -> assert false let category_decl tenv name category_decl_info decl_list = - Printing.log_out ~fmt:"ADDING: ObjCCategoryDecl for '%s'\n" name; + Printing.log_out "ADDING: ObjCCategoryDecl for '%s'\n" name; let class_name = get_class_from_category_decl category_decl_info in process_category tenv name class_name decl_list let category_impl_decl tenv name decl_info category_impl_decl_info decl_list = let category_name = get_category_name_from_category_impl category_impl_decl_info in - Printing.log_out ~fmt:"ADDING: ObjCCategoryImplDecl for '%s'\n" category_name; + Printing.log_out "ADDING: ObjCCategoryImplDecl for '%s'\n" category_name; let cat_class = get_class_from_category_impl category_impl_decl_info in process_category tenv category_name cat_class decl_list diff --git a/infer/src/clang/objcInterface_decl.ml b/infer/src/clang/objcInterface_decl.ml index 9cb814700..d31b40fc4 100644 --- a/infer/src/clang/objcInterface_decl.ml +++ b/infer/src/clang/objcInterface_decl.ml @@ -20,21 +20,21 @@ module L = Logging let objc_class_str = "ObjC-Class" let objc_class_annotation = - [({ Sil.class_name=objc_class_str; Sil.parameters=[]}, true)] + [({ Sil.class_name = objc_class_str; Sil.parameters =[]}, true)] let is_objc_class_annotation a = match a with - | [({Sil.class_name=n; Sil.parameters=[]},true)] when n=objc_class_str -> true + | [({ Sil.class_name = n; Sil.parameters =[]}, true)] when n = objc_class_str -> true | _ -> false let is_pointer_to_objc_class tenv typ = match typ with | Sil.Tptr (Sil.Tvar (Sil.TN_csu (Sil.Class, cname)), _) -> - (match Sil.tenv_lookup tenv (Sil.TN_csu (Sil.Class, cname)) with - | Some Sil.Tstruct(_, _, Sil.Class, _, _, _, a) when is_objc_class_annotation a -> true - | _ -> false) + (match Sil.tenv_lookup tenv (Sil.TN_csu (Sil.Class, cname)) with + | Some Sil.Tstruct(_, _, Sil.Class, _, _, _, a) when is_objc_class_annotation a -> true + | _ -> false) | Sil.Tptr (Sil.Tstruct(_, _, Sil.Class, _, _, _, a), _) when - is_objc_class_annotation a -> true + is_objc_class_annotation a -> true | _ -> false let get_super_interface_decl otdi_super = @@ -89,7 +89,7 @@ let update_curr_class curr_class superclasses = (* Adds pairs (interface name, interface_type_info) to the global environment. *) let add_class_to_tenv tenv class_name decl_list obj_c_interface_decl_info = - Printing.log_out ~fmt:"ADDING: ObjCInterfaceDecl for '%s'\n" class_name; + Printing.log_out "ADDING: ObjCInterfaceDecl for '%s'\n" class_name; let interface_name = CTypes.mk_classname class_name in let curr_class, superclasses, fields = create_curr_class_and_superclasses_fields tenv decl_list class_name @@ -98,8 +98,8 @@ let add_class_to_tenv tenv class_name decl_list obj_c_interface_decl_info = let methods = ObjcProperty_decl.get_methods curr_class decl_list in let fields_sc = CField_decl.fields_superclass tenv obj_c_interface_decl_info in list_iter (fun (fn, ft, _) -> - Printing.log_out ~fmt:"----->SuperClass field: '%s' " (Ident.fieldname_to_string fn); - Printing.log_out ~fmt:"type: '%s'\n" (Sil.typ_to_string ft)) fields_sc; + Printing.log_out "----->SuperClass field: '%s' " (Ident.fieldname_to_string fn); + Printing.log_out "type: '%s'\n" (Sil.typ_to_string ft)) fields_sc; (*In case we found categories, or partial definition of this class earlier and they are already in the tenv *) let fields, superclasses, methods = match Sil.tenv_lookup tenv interface_name with @@ -111,17 +111,17 @@ let add_class_to_tenv tenv class_name decl_list obj_c_interface_decl_info = let fields = append_no_duplicates_fields fields fields_sc in (* We add the special hidden counter_field for implementing reference counting *) let fields = append_no_duplicates_fields [Sil.objc_ref_counter_field] fields in - Printing.log_out ~fmt:"Class %s field:\n" class_name; + Printing.log_out "Class %s field:\n" class_name; list_iter (fun (fn, ft, _) -> - Printing.log_out ~fmt:"-----> field: '%s'\n" (Ident.fieldname_to_string fn)) fields; + Printing.log_out "-----> field: '%s'\n" (Ident.fieldname_to_string fn)) fields; let interface_type_info = Sil.Tstruct(fields, [], Sil.Class, Some (Mangled.from_string class_name), superclasses, methods, objc_class_annotation) in Sil.tenv_add tenv interface_name interface_type_info; Printing.log_out - ~fmt:" >>>Verifying that Typename '%s' is in tenv\n" (Sil.typename_to_string interface_name); + " >>>Verifying that Typename '%s' is in tenv\n" (Sil.typename_to_string interface_name); (match Sil.tenv_lookup tenv interface_name with - | Some t -> Printing.log_out ~fmt:" >>>OK. Found typ='%s'\n" (Sil.typ_to_string t) + | Some t -> Printing.log_out " >>>OK. Found typ='%s'\n" (Sil.typ_to_string t) | None -> Printing.log_out " >>>NOT Found!!\n"); curr_class @@ -134,7 +134,7 @@ let add_missing_fields tenv class_name decl_list idi = let mang_name = Mangled.from_string class_name in let class_tn_name = Sil.TN_csu (Sil.Class, mang_name) in Printing.log_out - ~fmt:" >>>Verifying that Typename TN_csu('%s') is in tenv\n" + " >>>Verifying that Typename TN_csu('%s') is in tenv\n" (Sil.typename_to_string class_tn_name); let curr_class = (match Sil.tenv_lookup tenv class_tn_name with @@ -144,19 +144,19 @@ let add_missing_fields tenv class_name decl_list idi = let missing_field f = not (list_mem equal_fields f intf_fields) in list_filter missing_field fields in Printing.log_out - ~fmt:" Looking for extra fields defined only in the implementation of '%s'\n" + " Looking for extra fields defined only in the implementation of '%s'\n" class_name; let extra_fields = compute_extra_fields fields intf_fields in list_iter (fun (fn, _, _) -> Printing.log_out - ~fmt:" ---> Extra non-static field: '%s'\n" (Ident.fieldname_to_string fn)) + " ---> Extra non-static field: '%s'\n" (Ident.fieldname_to_string fn)) extra_fields; let new_fields = append_no_duplicates_fields extra_fields intf_fields in let class_type_info = Sil.Tstruct ( new_fields, [], Sil.Class, Some mang_name, superclass, methods, annotation ) in - Printing.log_out ~fmt:" Updating info for class '%s' in tenv\n" class_name; + Printing.log_out " Updating info for class '%s' in tenv\n" class_name; Sil.tenv_add tenv class_tn_name class_type_info; update_curr_class curr_class superclass ) | _ -> assert false) in @@ -181,7 +181,7 @@ let interface_declaration tenv class_name decl_list obj_c_interface_decl_info = let interface_impl_declaration tenv class_name decl_list implementation_decl_info = let curr_class = add_missing_fields tenv class_name decl_list implementation_decl_info in add_missing_methods tenv class_name decl_list curr_class; - Printing.log_out ~fmt:"ADDING: ObjCImplementationDecl for class '%s'\n" class_name; + Printing.log_out "ADDING: ObjCImplementationDecl for class '%s'\n" class_name; Printing.log_out " Processing method declarations...\n"; curr_class @@ -217,9 +217,9 @@ let rec find_field tenv nfield str searched_late_defined = | Some _ -> nfield | None -> (Mangled.to_string cname)^"_"^nfield in *) let print_error name_field fields = - Printing.log_err ~fmt:"\nFaild to find name field '%s'\n\n" (Ident.fieldname_to_string name_field) ; + Printing.log_err "\nFaild to find name field '%s'\n\n" (Ident.fieldname_to_string name_field) ; Printing.log_err "In the following list of fields\n"; - list_iter (fun (fn, _, _) -> Printing.log_err ~fmt:"\nField name: '%s'\n\n" (Ident.fieldname_to_string fn)) fields; + list_iter (fun (fn, _, _) -> Printing.log_err "\nField name: '%s'\n\n" (Ident.fieldname_to_string fn)) fields; Printing.print_failure_info "" in let rec search_super s = match s with diff --git a/infer/src/clang/objcProperty_decl.ml b/infer/src/clang/objcProperty_decl.ml index e59872e94..01cbb2dcf 100644 --- a/infer/src/clang/objcProperty_decl.ml +++ b/infer/src/clang/objcProperty_decl.ml @@ -150,7 +150,7 @@ struct let key = (curr_class, property_name) in let getter_name = get_getter_name property_name attributes in let setter_name = get_setter_name property_name attributes in - Printing.log_out ~fmt:" ...Using '%s' in property table\n" (property_key_to_string key); + Printing.log_out " ...Using '%s' in property table\n" (property_key_to_string key); PropertyTableHash.add property_table key (qt, attributes, decl_info, (getter_name, None), (setter_name, None), None) end @@ -194,7 +194,7 @@ let check_for_property curr_class method_name meth_decl body = if is_getter then (method_name = getter_name) else (method_name = setter_name) in if found then - (Printing.log_out ~fmt:" Found property '%s' defined in property table\n" + (Printing.log_out " Found property '%s' defined in property table\n" (Property.property_key_to_string (curr_class, property_name)); upgrade_property_accessor (curr_class, property_name) property_type meth_decl defined is_getter) in @@ -211,7 +211,7 @@ let prepare_dynamic_property curr_class decl_info property_impl_decl_info = | None -> None) in (* update property info with proper ivar name *) Property.replace_property (curr_class, pname) (qt', atts, di, getter, setter, ivar); - Printing.log_out ~fmt: "Updated property table by adding ivar name for property pname '%s'\n" pname; + Printing.log_out "Updated property table by adding ivar name for property pname '%s'\n" pname; Some qt' with Not_found -> L.err "Property '%s' not found in the table. Ivar not updated and qual_type not found.@." pname; None) in @@ -263,12 +263,12 @@ let get_memory_management_attribute attributes = let make_getter_setter cfg curr_class decl_info property_impl_decl_info = let class_name = CContext.get_curr_class_name curr_class in let prop_name = Ast_utils.property_name property_impl_decl_info in - Printing.log_out ~fmt:"ADDING: ObjCPropertyImplDecl for property '%s' " prop_name; - Printing.log_out ~fmt:"pointer = '%s'\n" decl_info.Clang_ast_t.di_pointer; + Printing.log_out "ADDING: ObjCPropertyImplDecl for property '%s' " prop_name; + Printing.log_out "pointer = '%s'\n" decl_info.Clang_ast_t.di_pointer; let qt, attributes, decl_info, (getter_name, getter), (setter_name, setter), _ = (try Property.find_property curr_class prop_name with _ -> - Printing.log_out ~fmt:"Property %s not found@." prop_name; + Printing.log_out "Property %s not found@." prop_name; assert false) in let ivar_name = get_ivarname_property property_impl_decl_info in let make_getter () = @@ -354,7 +354,7 @@ let rec get_methods curr_class decl_list = match decl_list with | [] -> [] | (ObjCMethodDecl(decl_info, method_name, method_decl_info) as d):: decl_list' -> - Printing.log_out ~fmt:" ...Adding Method '%s' \n" (class_name^"_"^method_name); + Printing.log_out " ...Adding Method '%s' \n" (class_name^"_"^method_name); let methods = get_methods curr_class decl_list' in let _ = check_for_property curr_class method_name d method_decl_info.Clang_ast_t.omdi_body in let meth_name = CMethod_trans.mk_procname_from_method class_name method_name in @@ -363,8 +363,8 @@ let rec get_methods curr_class decl_list = | ObjCPropertyDecl(decl_info, pname, pdi):: decl_list' -> (* Property declaration register the property on the property table to be *) (* used later on in case getter and setters need to be synthesized by ObjCPropertyImplDecl *) - Printing.log_out ~fmt:" ...Adding Property Declaration '%s' " pname; - Printing.log_out ~fmt:" pointer= '%s' \n" decl_info.Clang_ast_t.di_pointer; + Printing.log_out " ...Adding Property Declaration '%s' " pname; + Printing.log_out " pointer= '%s' \n" decl_info.Clang_ast_t.di_pointer; Property.add_property (curr_class, pname) pdi.opdi_qual_type pdi.opdi_property_attributes decl_info; get_methods curr_class decl_list' (* TODO maybe add prop_name here *) diff --git a/infer/src/clang/objcProtocol_decl.ml b/infer/src/clang/objcProtocol_decl.ml index 16e7c5e1f..09c641afe 100644 --- a/infer/src/clang/objcProtocol_decl.ml +++ b/infer/src/clang/objcProtocol_decl.ml @@ -13,7 +13,7 @@ let protocol_decl tenv name decl_list = (* Protocol_type_info contains the methods composing the protocol. *) (* Here we are giving a similar treatment as interfaces (see above)*) (* It may turn out that we need a more specific treatment for protocols*) - Printing.log_out ~fmt:"ADDING: ObjCProtocolDecl for '%s'\n" name; + Printing.log_out "ADDING: ObjCProtocolDecl for '%s'\n" name; let mang_name = Mangled.from_string name in let curr_class = CContext.ContextProtocol name in let protocol_name = Sil.TN_csu(Sil.Protocol, mang_name) in