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

[clang frontend] Simplify logging functions.

Browse Source
master
Cristiano Calcagno 11 years ago
parent 10970c4f51
commit 3a51764d4c
22 changed files with 245 additions and 250 deletions
Show Stats Download Patch File Download Diff File

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

@ -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 =

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

@ -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)] ;

10
infer/src/clang/cEnum_decl.ml
Unescape View File

@ -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

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

@ -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' ->

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

@ -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 *)

35
infer/src/clang/cFrontend_utils.ml
Unescape View File

@ -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 ->

6
infer/src/clang/cFrontend_utils.mli
Unescape View File

@ -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

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

@ -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

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

@ -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)

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

@ -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 _ =

14
infer/src/clang/cMethod_decl.ml
Unescape View File

@ -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 =

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

@ -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 ())

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

@ -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' ->

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

@ -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

28
infer/src/clang/cTypes.ml
Unescape View File

@ -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

56
infer/src/clang/cTypes_decl.ml
Unescape View File

@ -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 =

2
infer/src/clang/cTypes_parser.mly
Unescape View File

@ -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 }

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

@ -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

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

@ -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

28
infer/src/clang/objcInterface_decl.ml
Unescape View File

@ -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

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

@ -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 *)

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

@ -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

Write Preview
Loading…
Cancel
Save