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

[clang] Migrating clang logging to the Logging module

Browse Source 
Reviewed By: jberdine

Differential Revision: D3931164

fbshipit-source-id: 4dd87ea
master
Dulma Churchill 8 years ago committed by Facebook Github Bot 5
parent 67a883e1a2
commit befab1007b
27 changed files with 177 additions and 154 deletions
Show Stats Download Patch File Download Diff File

10
infer/lib/clang_wrappers/attach_plugin_and_run_clang_frontend.sh
Unescape View File

@ -21,8 +21,6 @@ ETC_DIR="${SCRIPT_DIR}/../../etc"
CLANG_COMPILER="${SCRIPT_DIR}/filter_args_and_run_fcp_clang" CLANG_COMPILER="${SCRIPT_DIR}/filter_args_and_run_fcp_clang"
# extension of the file containing the clang cmd intercepted # extension of the file containing the clang cmd intercepted
CMD_FILE_EXT=".sh" CMD_FILE_EXT=".sh"
# extension of the file containing the output of the Infer Clang frontend
INFERCLANG_LOG_FILE_EXT=".astlog"
# path of the plugin to load in clang # path of the plugin to load in clang
PLUGIN_PATH="${SCRIPT_DIR}/../../../facebook-clang-plugins/libtooling/build/FacebookClangPlugin.dylib" PLUGIN_PATH="${SCRIPT_DIR}/../../../facebook-clang-plugins/libtooling/build/FacebookClangPlugin.dylib"
# name of the plugin to use # name of the plugin to use
@ -153,19 +151,13 @@ else
echo "bdump -x -d ${ETC_DIR}/clang_ast.dict -w '!!DUMMY!!' ${OBJECT_FILENAME}.biniou " \ echo "bdump -x -d ${ETC_DIR}/clang_ast.dict -w '!!DUMMY!!' ${OBJECT_FILENAME}.biniou " \
"> ${OBJECT_FILENAME}.bdump" \ "> ${OBJECT_FILENAME}.bdump" \
>> "${OBJECT_FILENAME}${CMD_FILE_EXT}" >> "${OBJECT_FILENAME}${CMD_FILE_EXT}"
# Emit the InferClang cmd used to run the frontend
INFER_FRONTEND_LOG_FILE="${OBJECT_FILENAME}${INFERCLANG_LOG_FILE_EXT}"
echo "${INFER_FRONTEND_CMD[@]}" > "$INFER_FRONTEND_LOG_FILE"
else
INFER_FRONTEND_LOG_FILE="/dev/null"
fi fi
fi fi
# run clang and pipe its output to InferClang/InferLLVM, or flush it in case the latter crashes # run clang and pipe its output to InferClang/InferLLVM, or flush it in case the latter crashes
"${CLANG_CMD[@]}" | \ "${CLANG_CMD[@]}" | \
("${INFER_FRONTEND_CMD[@]}" || \ ("${INFER_FRONTEND_CMD[@]}" || \
{ EC=$?; cat > /dev/null; exit $EC; }) \ { EC=$?; cat > /dev/null; exit $EC; }) 2>&1
>> "$INFER_FRONTEND_LOG_FILE" 2>&1
STATUSES=("${PIPESTATUS[@]}") STATUSES=("${PIPESTATUS[@]}")
STATUS="${STATUSES[0]}" STATUS="${STATUSES[0]}"
INFER_STATUS="${STATUSES[1]}" INFER_STATUS="${STATUSES[1]}"

4
infer/src/backend/DB.ml
Unescape View File

@ -182,8 +182,12 @@ module FilenameMap = Map.Make(
(** Return the time when a file was last modified. The file must exist. *) (** Return the time when a file was last modified. The file must exist. *)
let file_modified_time ?(symlink=false) fname = let file_modified_time ?(symlink=false) fname =
try
let stat = (if symlink then Unix.lstat else Unix.stat) fname in let stat = (if symlink then Unix.lstat else Unix.stat) fname in
stat.Unix.st_mtime stat.Unix.st_mtime
with Unix.Unix_error _ ->
Logging.do_err "File %s does not exist." fname;
exit 1
(** Create a directory if it does not exist already. *) (** Create a directory if it does not exist already. *)
let create_dir dir = let create_dir dir =

34
infer/src/backend/config.ml
Unescape View File

@ -1528,9 +1528,8 @@ let patterns_suppress_warnings =
if CLOpt.(current_exe <> Java) then [] if CLOpt.(current_exe <> Java) then []
else error ("Error: The option " ^ suppress_warnings_annotations_long ^ " was not provided") else error ("Error: The option " ^ suppress_warnings_annotations_long ^ " was not provided")
(** Name of files for logging the output in the specific executable *) (** Name of dir for logging the output in the specific executable *)
let log_files_of_current_exe = let log_dir_of_current_exe =
let prefix =
match CLOpt.current_exe with match CLOpt.current_exe with
| Analyze -> "analyze" | Analyze -> "analyze"
| BuckCompilationDatabase -> "buck_compilation_database" | BuckCompilationDatabase -> "buck_compilation_database"
@ -1540,20 +1539,41 @@ let log_files_of_current_exe =
| Llvm -> "llvm" | Llvm -> "llvm"
| Print -> "print" | Print -> "print"
| StatsAggregator -> "stats_agregator" | StatsAggregator -> "stats_agregator"
| Toplevel -> "top_level" in | Toplevel -> "top_level"
prefix ^ "_out_", prefix ^ "_err_"
let log_identifier_of_current_exe =
match CLOpt.current_exe with
| Analyze -> Option.map Filename.basename cluster_cmdline
| Clang -> Option.map Filename.basename source_file
| Interactive
| Java
| Llvm
| Print
| StatsAggregator
| Toplevel
| BuckCompilationDatabase -> None
(** Name of files for logging the output in the specific executable *)
let log_files_of_current_exe =
let name_prefix =
match log_identifier_of_current_exe with
| Some name -> name ^ "_"
| None -> "" in
let prefix = log_dir_of_current_exe in
name_prefix ^ prefix ^ "_out_", name_prefix ^ prefix ^ "_err_"
(** should_log_exe exe = true means that files for logging in the log folder will be created (** should_log_exe exe = true means that files for logging in the log folder will be created
and uses of Logging.out or Logging.err will log in those files *) and uses of Logging.out or Logging.err will log in those files *)
let should_log_current_exe = let should_log_current_exe =
match CLOpt.current_exe with match CLOpt.current_exe with
| Analyze -> debug_mode || stats_mode | Analyze
| Clang -> debug_mode || stats_mode
| BuckCompilationDatabase -> true | BuckCompilationDatabase -> true
| _ -> false | _ -> false
let tmp_log_files_of_current_exe () = let tmp_log_files_of_current_exe () =
let out_name, err_name = log_files_of_current_exe in let out_name, err_name = log_files_of_current_exe in
let log_dir = results_dir // log_dir_name in let log_dir = results_dir // log_dir_name // log_dir_of_current_exe in
let out_file = let out_file =
if out_file_cmdline = "" then if out_file_cmdline = "" then
Filename.temp_file ~temp_dir:log_dir out_name ".log" Filename.temp_file ~temp_dir:log_dir out_name ".log"

5
infer/src/backend/config.mli
Unescape View File

@ -309,9 +309,12 @@ val curr_language : language ref
val print_usage_exit : unit -> 'a val print_usage_exit : unit -> 'a
(** Name of dir for logging the output in the specific executable *)
val log_dir_of_current_exe : string
(** Name of current temporary files for logging the output in the current executable *) (** Name of current temporary files for logging the output in the current executable *)
val tmp_log_files_of_current_exe : unit -> string * string val tmp_log_files_of_current_exe : unit -> string * string
(** should_log_exe = true means that files for logging in the log folder will be created (** should_log_exe = true means that files for logging in the log dir will be created
and uses of Logging.out or Logging.err will log in those files *) and uses of Logging.out or Logging.err will log in those files *)
val should_log_current_exe : bool val should_log_current_exe : bool

24
infer/src/backend/logging.ml
Unescape View File

@ -89,8 +89,10 @@ let out_formatter, err_formatter =
in in
if Config.should_log_current_exe then if Config.should_log_current_exe then
let log_dir = Config.results_dir // Config.log_dir_name in let log_dir = Config.results_dir // Config.log_dir_name in
let exe_log_dir = log_dir // Config.log_dir_of_current_exe in
create_dir Config.results_dir; create_dir Config.results_dir;
create_dir log_dir; create_dir log_dir;
create_dir exe_log_dir;
let out_file, err_file = Config.tmp_log_files_of_current_exe () in let out_file, err_file = Config.tmp_log_files_of_current_exe () in
let out_fmt, out_chan = open_output_file out_file in let out_fmt, out_chan = open_output_file out_file in
let err_fmt, err_chan = open_output_file err_file in let err_fmt, err_chan = open_output_file err_file in
@ -124,28 +126,42 @@ let set_delayed_prints new_delayed_actions =
let do_print fmt fmt_string = let do_print fmt fmt_string =
F.fprintf fmt fmt_string F.fprintf fmt fmt_string
let do_print_in_debug_mode fmt fmt_string = let do_print_in_debug_or_stats_mode fmt fmt_string =
if Config.debug_mode || Config.stats_mode then if Config.debug_mode || Config.stats_mode then
F.fprintf fmt fmt_string F.fprintf fmt fmt_string
else else
F.ifprintf fmt fmt_string F.ifprintf fmt fmt_string
(** print to the current out stream (note: only prints in debug mode) *) let do_print_in_debug_mode fmt fmt_string =
if Config.debug_mode then
F.fprintf fmt fmt_string
else
F.ifprintf fmt fmt_string
(** print to the current out stream (note: only prints in debug or stats mode) *)
let out fmt_string = let out fmt_string =
do_print_in_debug_or_stats_mode out_formatter fmt_string
(** print to the current out stream (note: only prints in debug mode) *)
let out_debug fmt_string =
do_print_in_debug_mode out_formatter fmt_string do_print_in_debug_mode out_formatter fmt_string
(** print to the current out stream *) (** print to the current out stream *)
let do_out fmt_string = let do_out fmt_string =
do_print out_formatter fmt_string do_print out_formatter fmt_string
(** print to the current err stream (note: only prints in debug mode) *) (** print to the current err stream (note: only prints in debug or stats mode) *)
let err fmt_string = let err fmt_string =
do_print_in_debug_mode err_formatter fmt_string do_print_in_debug_or_stats_mode err_formatter fmt_string
(** print to the current err stream *) (** print to the current err stream *)
let do_err fmt_string = let do_err fmt_string =
do_print err_formatter fmt_string do_print err_formatter fmt_string
(** print to the current out stream (note: only prints in debug mode) *)
let err_debug fmt_string =
do_print_in_debug_mode err_formatter fmt_string
(** print immediately to standard error *) (** print immediately to standard error *)
let stderr fmt_string = let stderr fmt_string =
do_print F.err_formatter fmt_string do_print F.err_formatter fmt_string

13
infer/src/backend/logging.mli
Unescape View File

@ -72,12 +72,21 @@ val set_delayed_prints : print_action list -> unit
(** reset the delayed print actions *) (** reset the delayed print actions *)
val reset_delayed_prints : unit -> unit val reset_delayed_prints : unit -> unit
(** print to the current out stream (note: only prints in developer mode) *) (** print to the current out stream
(note: only prints in debug or in stats mode) *)
val out : ('a, Format.formatter, unit) format -> 'a val out : ('a, Format.formatter, unit) format -> 'a
(** print to the current error stream (note: only prints in developer mode) *) (** print to the current out stream
(note: only prints in debug mode) *)
val out_debug : ('a, Format.formatter, unit) format -> 'a
(** print to the current error stream
(note: only prints in debug or stats mode) *)
val err : ('a, Format.formatter, unit) format -> 'a val err : ('a, Format.formatter, unit) format -> 'a
(** print to the current error stream (note: only prints in debug mode) *)
val err_debug : ('a, Format.formatter, unit) format -> 'a
(** print to the current out stream *) (** print to the current out stream *)
val do_out : ('a, Format.formatter, unit) format -> 'a val do_out : ('a, Format.formatter, unit) format -> 'a

3
infer/src/clang/ast_expressions.ml
Unescape View File

@ -597,7 +597,8 @@ let translate_block_enumerate block_name stmt_info stmt_list ei =
let translated_stmt, op = translate bdi.bdi_parameters s block_decl bei.ei_type_ptr in let translated_stmt, op = translate bdi.bdi_parameters s block_decl bei.ei_type_ptr in
CompoundStmt (stmt_info, translated_stmt), vars_to_register @ op @ bv CompoundStmt (stmt_info, translated_stmt), vars_to_register @ op @ bv
| _ -> (* When it is not the method we expect with only one parameter, we don't translate *) | _ -> (* When it is not the method we expect with only one parameter, we don't translate *)
Printing.log_out "WARNING: Block Enumeration called at %s not translated." (Clang_ast_j.string_of_stmt_info stmt_info); Logging.out_debug "WARNING: Block Enumeration called at %s not translated."
(Clang_ast_j.string_of_stmt_info stmt_info);
CompoundStmt (stmt_info, stmt_list), [] CompoundStmt (stmt_info, stmt_list), []
(* We translate the logical negation of an integer with a conditional*) (* We translate the logical negation of an integer with a conditional*)

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

@ -131,7 +131,7 @@ let binary_operation_instruction boi e1 typ e2 loc rhs_owning_method =
(* We should not get here. *) (* We should not get here. *)
(* These should be treated by compound_assignment_binary_operation_instruction*) (* These should be treated by compound_assignment_binary_operation_instruction*)
| bok -> | bok ->
Printing.log_stats Logging.out
"\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); (Clang_ast_j.string_of_binary_operator_kind bok);
(Exp.minus_one, []) (Exp.minus_one, [])
@ -178,7 +178,7 @@ let unary_operation_instruction uoi e typ loc =
(e, []) (e, [])
| `AddrOf -> (e, []) | `AddrOf -> (e, [])
| `Real | `Imag | `Extension | `Coawait -> | `Real | `Imag | `Extension | `Coawait ->
Printing.log_stats Logging.out
"\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, []) (e, [])

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

@ -18,7 +18,7 @@ module L = Logging
type field_type = Ident.fieldname * Typ.t * (Annot.t * bool) list type field_type = Ident.fieldname * Typ.t * (Annot.t * bool) list
let rec get_fields_super_classes tenv super_class = let rec get_fields_super_classes tenv super_class =
Printing.log_out " ... Getting fields of superclass '%s'\n" (Typename.to_string super_class); Logging.out_debug " ... Getting fields of superclass '%s'\n" (Typename.to_string super_class);
match Tenv.lookup tenv super_class with match Tenv.lookup tenv super_class with
| None -> [] | None -> []
| Some { fields; supers = super_class :: _ } -> | Some { fields; supers = super_class :: _ } ->
@ -85,7 +85,7 @@ let add_missing_fields tenv class_name ck missing_fields =
| Some ({ fields } as struct_typ) -> | Some ({ fields } as struct_typ) ->
let new_fields = General_utils.append_no_duplicates_fields fields missing_fields in let new_fields = General_utils.append_no_duplicates_fields fields missing_fields in
ignore (Tenv.mk_struct tenv ~default:struct_typ ~fields:new_fields ~statics:[] class_tn_name); ignore (Tenv.mk_struct tenv ~default:struct_typ ~fields:new_fields ~statics:[] class_tn_name);
Printing.log_out " Updating info for class '%s' in tenv\n" class_name Logging.out_debug " Updating info for class '%s' in tenv\n" class_name
| _ -> () | _ -> ()
let modelled_fields_in_classes = [("NSData", "_bytes", Typ.Tptr (Typ.Tvoid, Typ.Pk_pointer))] let modelled_fields_in_classes = [("NSData", "_bytes", Typ.Tptr (Typ.Tvoid, Typ.Pk_pointer))]

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

@ -24,12 +24,12 @@ let compute_icfg source tenv ast =
match ast with match ast with
| Clang_ast_t.TranslationUnitDecl(_, decl_list, _, _) -> | Clang_ast_t.TranslationUnitDecl(_, decl_list, _, _) ->
CFrontend_config.global_translation_unit_decls := decl_list; CFrontend_config.global_translation_unit_decls := decl_list;
Printing.log_out "\n Start creating icfg\n"; Logging.out_debug "\n Start creating icfg\n";
let cg = Cg.create (Some source) in let cg = Cg.create (Some source) in
let cfg = Cfg.Node.create_cfg () in let cfg = Cfg.Node.create_cfg () in
IList.iter (CFrontend_declImpl.translate_one_declaration tenv cg cfg `DeclTraversal) IList.iter (CFrontend_declImpl.translate_one_declaration tenv cg cfg `DeclTraversal)
decl_list; decl_list;
Printing.log_out "\n Finished creating icfg\n"; Logging.out_debug "\n Finished creating icfg\n";
(cg, cfg) (cg, cfg)
| _ -> assert false (* NOTE: Assumes that an AST alsways starts with a TranslationUnitDecl *) | _ -> assert false (* NOTE: Assumes that an AST alsways starts with a TranslationUnitDecl *)
@ -43,10 +43,10 @@ let do_source_file source_file ast =
CTypes_decl.add_predefined_types tenv; CTypes_decl.add_predefined_types tenv;
init_global_state_capture (); init_global_state_capture ();
Config.nLOC := FileLOC.file_get_loc (DB.source_file_to_string source_file); Config.nLOC := FileLOC.file_get_loc (DB.source_file_to_string source_file);
Printing.log_out "\n Start building call/cfg graph for '%s'....\n" Logging.out_debug "\n Start building call/cfg graph for '%s'....\n"
(DB.source_file_to_string source_file); (DB.source_file_to_string source_file);
let call_graph, cfg = compute_icfg source_file tenv ast in let call_graph, cfg = compute_icfg source_file tenv ast in
Printing.log_out "\n End building call/cfg graph for '%s'.\n" Logging.out_debug "\n End building call/cfg graph for '%s'.\n"
(DB.source_file_to_string source_file); (DB.source_file_to_string source_file);
(* This part below is a boilerplate in every frontends. *) (* This part below is a boilerplate in every frontends. *)
(* This could be moved in the cfg_infer module *) (* This could be moved in the cfg_infer module *)

4
infer/src/clang/cFrontend_checkers_main.ml
Unescape View File

@ -74,7 +74,7 @@ let store_issues source_file =
LintIssues.store_issues lint_issues_file !LintIssues.errLogMap LintIssues.store_issues lint_issues_file !LintIssues.errLogMap
let do_frontend_checks source_file ast = let do_frontend_checks source_file ast =
Printing.log_stats "Start linting file %s\n" (DB.source_file_to_string source_file); Logging.out "Start linting file %s\n" (DB.source_file_to_string source_file);
match ast with match ast with
| Clang_ast_t.TranslationUnitDecl(_, decl_list, _, _) -> | Clang_ast_t.TranslationUnitDecl(_, decl_list, _, _) ->
let context = context_with_ck_set CLintersContext.empty decl_list in let context = context_with_ck_set CLintersContext.empty decl_list in
@ -85,5 +85,5 @@ let do_frontend_checks source_file ast =
IList.iter (do_frontend_checks_decl context) allowed_decls; IList.iter (do_frontend_checks_decl context) allowed_decls;
if (LintIssues.exists_issues ()) then if (LintIssues.exists_issues ()) then
store_issues source_file; store_issues source_file;
Printing.log_stats "End linting file %s\n" (DB.source_file_to_string source_file) Logging.out "End linting file %s\n" (DB.source_file_to_string source_file)
| _ -> assert false (* NOTE: Assumes that an AST alsways starts with a TranslationUnitDecl *) | _ -> assert false (* NOTE: Assumes that an AST alsways starts with a TranslationUnitDecl *)

13
infer/src/clang/cFrontend_decl.ml
Unescape View File

@ -32,7 +32,7 @@ struct
(* Translates the method/function's body into nodes of the cfg. *) (* Translates the method/function's body into nodes of the cfg. *)
let add_method tenv cg cfg class_decl_opt procname body has_return_param is_objc_method let add_method tenv cg cfg class_decl_opt procname body has_return_param is_objc_method
outer_context_opt extra_instrs = outer_context_opt extra_instrs =
Printing.log_out Logging.out_debug
"\n\n>>---------- ADDING METHOD: '%s' ---------<<\n@." (Procname.to_string procname); "\n\n>>---------- ADDING METHOD: '%s' ---------<<\n@." (Procname.to_string procname);
try try
(match Cfg.Procdesc.find_from_name cfg procname with (match Cfg.Procdesc.find_from_name cfg procname with
@ -43,7 +43,7 @@ struct
has_return_param is_objc_method outer_context_opt in has_return_param is_objc_method outer_context_opt in
let start_node = Cfg.Procdesc.get_start_node procdesc in let start_node = Cfg.Procdesc.get_start_node procdesc in
let exit_node = Cfg.Procdesc.get_exit_node procdesc in let exit_node = Cfg.Procdesc.get_exit_node procdesc in
Printing.log_out Logging.out_debug
"\n\n>>---------- Start translating body of function: '%s' ---------<<\n@." "\n\n>>---------- Start translating body of function: '%s' ---------<<\n@."
(Procname.to_string procname); (Procname.to_string procname);
let meth_body_nodes = T.instructions_trans context body extra_instrs exit_node in let meth_body_nodes = T.instructions_trans context body extra_instrs exit_node in
@ -56,8 +56,7 @@ struct
| CTrans_utils.Self.SelfClassException _ -> | CTrans_utils.Self.SelfClassException _ ->
assert false (* this shouldn't happen, because self or [a class] should always be arguments of functions. This is to make sure I'm not wrong. *) assert false (* this shouldn't happen, because self or [a class] should always be arguments of functions. This is to make sure I'm not wrong. *)
| Assert_failure (file, line, column) -> | Assert_failure (file, line, column) ->
print_endline ("Fatal error: exception Assert_failure("^ Logging.out "Fatal error: exception Assert_failure(%s, %d, %d)\n%!" file line column;
file^", "^(string_of_int line)^", "^(string_of_int column)^")");
Cfg.Procdesc.remove cfg procname true; Cfg.Procdesc.remove cfg procname true;
CMethod_trans.create_external_procdesc cfg procname is_objc_method None; CMethod_trans.create_external_procdesc cfg procname is_objc_method None;
() ()
@ -133,7 +132,7 @@ struct
| EmptyDecl _ | EmptyDecl _
| ObjCIvarDecl _ | ObjCPropertyDecl _ -> () | ObjCIvarDecl _ | ObjCPropertyDecl _ -> ()
| _ -> | _ ->
Printing.log_stats Logging.out
"\nWARNING: found Method Declaration '%s' skipped. NEED TO BE FIXED\n\n" (Ast_utils.string_of_decl dec); "\nWARNING: found Method Declaration '%s' skipped. NEED TO BE FIXED\n\n" (Ast_utils.string_of_decl dec);
() ()
@ -222,7 +221,7 @@ struct
if Config.cxx_experimental then if Config.cxx_experimental then
process_methods tenv cg cfg curr_class [dec] process_methods tenv cg cfg curr_class [dec]
| Some dec -> | Some dec ->
Printing.log_stats "Methods of %s skipped\n" (Ast_utils.string_of_decl dec) Logging.out "Methods of %s skipped\n" (Ast_utils.string_of_decl dec)
| None -> ()) | None -> ())
| _ -> ()); | _ -> ());
match dec with match dec with
@ -244,7 +243,7 @@ struct
IList.iter (translate_one_declaration tenv cg cfg decl_trans_context) method_decls IList.iter (translate_one_declaration tenv cg cfg decl_trans_context) method_decls
| EnumDecl _ -> ignore (CEnum_decl.enum_decl dec) | EnumDecl _ -> ignore (CEnum_decl.enum_decl dec)
| LinkageSpecDecl (_, decl_list, _) -> | LinkageSpecDecl (_, decl_list, _) ->
Printing.log_out "ADDING: LinkageSpecDecl decl list\n"; Logging.out_debug "ADDING: LinkageSpecDecl decl list\n";
IList.iter (translate_one_declaration tenv cg cfg decl_trans_context) decl_list IList.iter (translate_one_declaration tenv cg cfg decl_trans_context) decl_list
| NamespaceDecl (_, _, decl_list, _, _) -> | NamespaceDecl (_, _, decl_list, _, _) ->
IList.iter (translate_one_declaration tenv cg cfg decl_trans_context) decl_list IList.iter (translate_one_declaration tenv cg cfg decl_trans_context) decl_list

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

@ -186,7 +186,7 @@ struct
let get_decl decl_ptr = let get_decl decl_ptr =
try try
Some (Clang_ast_main.PointerMap.find decl_ptr !CFrontend_config.pointer_decl_index) Some (Clang_ast_main.PointerMap.find decl_ptr !CFrontend_config.pointer_decl_index)
with Not_found -> Printing.log_stats "decl with pointer %d not found\n" decl_ptr; None with Not_found -> Logging.out "decl with pointer %d not found\n" decl_ptr; None
let get_decl_opt decl_ptr_opt = let get_decl_opt decl_ptr_opt =
match decl_ptr_opt with match decl_ptr_opt with
@ -196,7 +196,7 @@ struct
let get_stmt stmt_ptr = let get_stmt stmt_ptr =
try try
Some (Clang_ast_main.PointerMap.find stmt_ptr !CFrontend_config.pointer_stmt_index) Some (Clang_ast_main.PointerMap.find stmt_ptr !CFrontend_config.pointer_stmt_index)
with Not_found -> Printing.log_stats "stmt with pointer %d not found\n" stmt_ptr; None with Not_found -> Logging.out "stmt with pointer %d not found\n" stmt_ptr; None
let get_stmt_opt stmt_ptr_opt = let get_stmt_opt stmt_ptr_opt =
match stmt_ptr_opt with match stmt_ptr_opt with
@ -211,7 +211,7 @@ struct
let get_property_of_ivar decl_ptr = let get_property_of_ivar decl_ptr =
try try
Some (Clang_ast_main.PointerMap.find decl_ptr !CFrontend_config.ivar_to_property_index) Some (Clang_ast_main.PointerMap.find decl_ptr !CFrontend_config.ivar_to_property_index)
with Not_found -> Printing.log_stats "property with pointer %d not found\n" decl_ptr; None with Not_found -> Logging.out "property with pointer %d not found\n" decl_ptr; None
let update_sil_types_map type_ptr sil_type = let update_sil_types_map type_ptr sil_type =
CFrontend_config.sil_types_map := CFrontend_config.sil_types_map :=
@ -240,11 +240,11 @@ struct
(let raw_ptr = Clang_ast_types.type_ptr_to_clang_pointer type_ptr in (let raw_ptr = Clang_ast_types.type_ptr_to_clang_pointer type_ptr in
try try
Some (Clang_ast_main.PointerMap.find raw_ptr !CFrontend_config.pointer_type_index) Some (Clang_ast_main.PointerMap.find raw_ptr !CFrontend_config.pointer_type_index)
with Not_found -> Printing.log_stats "type with pointer %d not found\n" raw_ptr; None) with Not_found -> Logging.out "type with pointer %d not found\n" raw_ptr; None)
with Clang_ast_types.Not_Clang_Pointer -> with Clang_ast_types.Not_Clang_Pointer ->
(* otherwise, function fails *) (* otherwise, function fails *)
let type_str = Clang_ast_types.type_ptr_to_string type_ptr in let type_str = Clang_ast_types.type_ptr_to_string type_ptr in
Printing.log_stats "type %s is not clang pointer\n" type_str; Logging.out "type %s is not clang pointer\n" type_str;
None None
let get_desugared_type type_ptr = let get_desugared_type type_ptr =

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

@ -18,7 +18,7 @@ let curr_file = ref DB.source_file_empty
let source_file_from_path path = let source_file_from_path path =
if Filename.is_relative path then if Filename.is_relative path then
(Printing.log_err (Logging.err_debug
"ERROR: Path %s is relative. Please pass an absolute path in the -c argument.@." "ERROR: Path %s is relative. Please pass an absolute path in the -c argument.@."
path; path;
exit 1); exit 1);
@ -27,7 +27,7 @@ let source_file_from_path path =
(try (try
DB.rel_source_file_from_abs_path root path DB.rel_source_file_from_abs_path root path
with Failure _ -> with Failure _ ->
Printing.log_err "ERROR: %s should be a prefix of %s.@." root path; Logging.err_debug "ERROR: %s should be a prefix of %s.@." root path;
DB.source_file_from_string path) DB.source_file_from_string path)
| None -> DB.source_file_from_string path | None -> DB.source_file_from_string path
@ -151,6 +151,6 @@ let get_sil_location stmt_info context =
let check_source_file source_file = let check_source_file source_file =
if is_file_blacklisted source_file then if is_file_blacklisted source_file then
(Printing.log_stats "%s" (Logging.out "%s"
("\n Skip the analysis of source file" ^ source_file ^ "\n\n"); ("\n Skip the analysis of source file" ^ source_file ^ "\n\n");
exit(0)); exit(0));

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

@ -23,14 +23,14 @@ let validate_decl_from_file fname =
try try
Ag_util.Biniou.from_file ~len:buffer_len Clang_ast_b.read_decl fname Ag_util.Biniou.from_file ~len:buffer_len Clang_ast_b.read_decl fname
with (Invalid_argument "Bi_inbuf.refill_from_channel") -> with (Invalid_argument "Bi_inbuf.refill_from_channel") ->
Printing.log_stats "WARNING: biniou buffer too short, skipping the file\n"; Logging.out "WARNING: biniou buffer too short, skipping the file\n";
assert false assert false
let validate_decl_from_stdin () = let validate_decl_from_stdin () =
try try
Ag_util.Biniou.from_channel ~len:buffer_len Clang_ast_b.read_decl stdin Ag_util.Biniou.from_channel ~len:buffer_len Clang_ast_b.read_decl stdin
with (Invalid_argument "Bi_inbuf.refill_from_channel") -> with (Invalid_argument "Bi_inbuf.refill_from_channel") ->
Printing.log_stats "WARNING: biniou buffer too short, skipping the file\n"; Logging.out "WARNING: biniou buffer too short, skipping the file\n";
assert false assert false
let register_perf_stats_report source_file = let register_perf_stats_report source_file =
@ -51,7 +51,7 @@ let do_run source_path ast_path =
let init_time = Unix.gettimeofday () in let init_time = Unix.gettimeofday () in
let print_elapsed () = let print_elapsed () =
let elapsed = Unix.gettimeofday () -. init_time in let elapsed = Unix.gettimeofday () -. init_time in
Printf.printf "Elapsed: %07.3f seconds.\n" elapsed in Logging.out "Elapsed: %07.3f seconds.\n" elapsed in
try try
let ast_filename, ast_decl = let ast_filename, ast_decl =
match ast_path with match ast_path with
@ -69,19 +69,19 @@ let do_run source_path ast_path =
CFrontend_config.json := ast_filename; CFrontend_config.json := ast_filename;
CLocation.check_source_file source_path; CLocation.check_source_file source_path;
let source_file = CLocation.source_file_from_path source_path in let source_file = CLocation.source_file_from_path source_path in
Printing.log_stats "Clang frontend action is %s\n" Config.clang_frontend_action_string; Logging.out "Clang frontend action is %s\n" Config.clang_frontend_action_string;
Printf.printf "Start %s of AST from %s\n" Config.clang_frontend_action_string Logging.out "Start %s of AST from %s\n" Config.clang_frontend_action_string
!CFrontend_config.json; !CFrontend_config.json;
init_global_state_for_capture_and_linters source_file; init_global_state_for_capture_and_linters source_file;
if Config.clang_frontend_do_lint then if Config.clang_frontend_do_lint then
CFrontend_checkers_main.do_frontend_checks source_file ast_decl; CFrontend_checkers_main.do_frontend_checks source_file ast_decl;
if Config.clang_frontend_do_capture then if Config.clang_frontend_do_capture then
CFrontend.do_source_file source_file ast_decl; CFrontend.do_source_file source_file ast_decl;
Printf.printf "End translation AST file %s... OK!\n" !CFrontend_config.json; Logging.out "End translation AST file %s... OK!\n" !CFrontend_config.json;
print_elapsed (); print_elapsed ();
with with
(Yojson.Json_error s) as exc -> (Yojson.Json_error s) as exc ->
Printing.log_err "%s\n" s; Logging.err_debug "%s\n" s;
print_elapsed (); print_elapsed ();
raise exc raise exc
@ -90,5 +90,5 @@ let () =
| Some path -> | Some path ->
do_run path Config.ast_file do_run path Config.ast_file
| None -> | None ->
Printing.log_err "Incorrect command line arguments\n"; Logging.err_debug "Incorrect command line arguments\n";
Config.print_usage_exit () Config.print_usage_exit ()

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

@ -228,12 +228,12 @@ let get_method_name_from_clang tenv ms_opt =
let get_superclass_curr_class_objc context = let get_superclass_curr_class_objc context =
let retrive_super cname super_opt = let retrive_super cname super_opt =
let iname = Typename.TN_csu (Csu.Class Csu.Objc, Mangled.from_string cname) in let iname = Typename.TN_csu (Csu.Class Csu.Objc, Mangled.from_string cname) in
Printing.log_out "Checking for superclass = '%s'\n\n%!" (Typename.to_string iname); Logging.out_debug "Checking for superclass = '%s'\n\n%!" (Typename.to_string iname);
match Tenv.lookup (CContext.get_tenv context) iname with match Tenv.lookup (CContext.get_tenv context) iname with
| Some { supers = super_name :: _ } -> | Some { supers = super_name :: _ } ->
Typename.name super_name Typename.name super_name
| _ -> | _ ->
Printing.log_err "NOT FOUND superclass = '%s'\n\n%!" (Typename.to_string iname); Logging.err_debug "NOT FOUND superclass = '%s'\n\n%!" (Typename.to_string iname);
(match super_opt with (match super_opt with
| Some super -> super | Some super -> super
| _ -> assert false) in | _ -> assert false) in
@ -395,8 +395,8 @@ let create_local_procdesc cfg tenv ms fbody captured is_objc_inst_method =
~shift:(IList.length captured_mangled) ~shift:(IList.length captured_mangled)
(CMethod_signature.ms_get_args ms) in (CMethod_signature.ms_get_args ms) in
let source_range = CMethod_signature.ms_get_loc ms in let source_range = CMethod_signature.ms_get_loc ms in
Printing.log_out "\nCreating a new procdesc for function: '%s'\n@." pname; Logging.out_debug "\nCreating a new procdesc for function: '%s'\n@." pname;
Printing.log_out "\nms = %s\n@." (CMethod_signature.ms_to_string ms); Logging.out_debug "\nms = %s\n@." (CMethod_signature.ms_to_string ms);
let loc_start = CLocation.get_sil_location_from_range source_range true in 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 let loc_exit = CLocation.get_sil_location_from_range source_range false in
let ret_type = get_return_type tenv ms in let ret_type = get_return_type tenv ms in

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

@ -121,9 +121,9 @@ struct
let item_annot = Annot.Item.empty in let item_annot = Annot.Item.empty in
fname, typ, item_annot in fname, typ, item_annot in
let fields = IList.map mk_field_from_captured_var captured_vars in let fields = IList.map mk_field_from_captured_var captured_vars in
Printing.log_out "Block %s field:\n" block_name; Logging.out_debug "Block %s field:\n" block_name;
IList.iter (fun (fn, _, _) -> IList.iter (fun (fn, _, _) ->
Printing.log_out "-----> field: '%s'\n" (Ident.fieldname_to_string fn)) fields; Logging.out_debug "-----> field: '%s'\n" (Ident.fieldname_to_string fn)) fields;
let mblock = Mangled.from_string block_name in let mblock = Mangled.from_string block_name in
let block_name = Typename.TN_csu (Csu.Class Csu.Objc, mblock) in let block_name = Typename.TN_csu (Csu.Class Csu.Objc, mblock) in
ignore (Tenv.mk_struct tenv ~fields block_name); ignore (Tenv.mk_struct tenv ~fields block_name);
@ -188,7 +188,7 @@ struct
(* the parameter f will be called with function instruction *) (* the parameter f will be called with function instruction *)
let exec_with_block_priority_exception f trans_state e stmt_info = let exec_with_block_priority_exception f trans_state e stmt_info =
if (is_block_expr e) && (PriorityNode.own_priority_node trans_state.priority stmt_info) then ( if (is_block_expr e) && (PriorityNode.own_priority_node trans_state.priority stmt_info) then (
Printing.log_out "Translating block expression by freeing the priority"; Logging.out_debug "Translating block expression by freeing the priority";
f { trans_state with priority = Free } e) f { trans_state with priority = Free } e)
else f trans_state e else f trans_state e
@ -418,7 +418,7 @@ struct
| None -> typ (* Some default type since the type is missing *) in | None -> typ (* Some default type since the type is missing *) in
{ empty_res_trans with { empty_res_trans with
exps = [(Exp.Sizeof (sizeof_typ, None, Subtype.exact), sizeof_typ)] } exps = [(Exp.Sizeof (sizeof_typ, None, Subtype.exact), sizeof_typ)] }
| k -> Printing.log_stats | k -> Logging.out
"\nWARNING: Missing translation of Uniry_Expression_Or_Trait of kind: \ "\nWARNING: Missing translation of Uniry_Expression_Or_Trait of kind: \
%s . Expression ignored, returned -1... \n" %s . Expression ignored, returned -1... \n"
(Clang_ast_j.string_of_unary_expr_or_type_trait_kind k); (Clang_ast_j.string_of_unary_expr_or_type_trait_kind k);
@ -485,7 +485,7 @@ struct
let context = trans_state.context in let context = trans_state.context in
let sil_loc = CLocation.get_sil_location stmt_info context in let sil_loc = CLocation.get_sil_location stmt_info context in
let name_info, _, type_ptr = Ast_utils.get_info_from_decl_ref decl_ref in let name_info, _, type_ptr = Ast_utils.get_info_from_decl_ref decl_ref in
Printing.log_out "!!!!! Dealing with field '%s' @." name_info.Clang_ast_t.ni_name; Logging.out_debug "!!!!! Dealing with field '%s' @." name_info.Clang_ast_t.ni_name;
let field_typ = CTypes_decl.type_ptr_to_sil_type context.tenv type_ptr in let field_typ = CTypes_decl.type_ptr_to_sil_type context.tenv type_ptr in
let (obj_sil, class_typ) = extract_exp_from_list pre_trans_result.exps let (obj_sil, class_typ) = extract_exp_from_list pre_trans_result.exps
"WARNING: in Field dereference we expect to know the object\n" in "WARNING: in Field dereference we expect to know the object\n" in
@ -496,7 +496,7 @@ struct
match class_typ with match class_typ with
| Typ.Tptr (t, _) -> t | Typ.Tptr (t, _) -> t
| t -> t in | t -> t in
Printing.log_out "Type is '%s' @." (Typ.to_string class_typ); Logging.out_debug "Type is '%s' @." (Typ.to_string class_typ);
let field_name = General_utils.mk_class_field_name name_info in let field_name = General_utils.mk_class_field_name name_info in
let field_exp = Exp.Lfield (obj_sil, field_name, class_typ) in let field_exp = Exp.Lfield (obj_sil, field_name, class_typ) in
(* In certain cases, there is be no LValueToRValue cast, but backend needs dereference*) (* In certain cases, there is be no LValueToRValue cast, but backend needs dereference*)
@ -526,7 +526,7 @@ struct
Option.may (call_translation context) decl_opt; Option.may (call_translation context) decl_opt;
let method_name = Ast_utils.get_unqualified_name name_info in let method_name = Ast_utils.get_unqualified_name name_info in
let class_name = Ast_utils.get_class_name_from_member name_info in let class_name = Ast_utils.get_class_name_from_member name_info in
Printing.log_out "!!!!! Dealing with method '%s' @." method_name; Logging.out_debug "!!!!! Dealing with method '%s' @." method_name;
let method_typ = CTypes_decl.type_ptr_to_sil_type context.tenv type_ptr in let method_typ = CTypes_decl.type_ptr_to_sil_type context.tenv type_ptr in
let ms_opt = CMethod_trans.method_signature_of_pointer context.tenv decl_ptr in let ms_opt = CMethod_trans.method_signature_of_pointer context.tenv decl_ptr in
let is_instance_method = match ms_opt with let is_instance_method = match ms_opt with
@ -655,7 +655,7 @@ struct
let typ = CTypes.add_pointer_to_typ (CTypes_decl.get_type_curr_class_objc curr_class) in let typ = CTypes.add_pointer_to_typ (CTypes_decl.get_type_curr_class_objc curr_class) in
[(var_exp, typ)] [(var_exp, typ)]
else [(var_exp, typ)] in else [(var_exp, typ)] in
Printing.log_out "\n\n PVAR ='%s'\n\n" (Pvar.to_string pvar); Logging.out_debug "\n\n PVAR ='%s'\n\n" (Pvar.to_string pvar);
let res_trans = { trans_result' with exps } in let res_trans = { trans_result' with exps } in
match typ with match typ with
| Tptr (_, Pk_reference) -> | Tptr (_, Pk_reference) ->
@ -664,7 +664,7 @@ struct
| _ -> res_trans | _ -> res_trans
and decl_ref_trans trans_state pre_trans_result stmt_info decl_ref ~is_constructor_init = and decl_ref_trans trans_state pre_trans_result stmt_info decl_ref ~is_constructor_init =
Printing.log_out " priority node free = '%s'\n@." Logging.out_debug " priority node free = '%s'\n@."
(string_of_bool (PriorityNode.is_priority_free trans_state)); (string_of_bool (PriorityNode.is_priority_free trans_state));
let decl_kind = decl_ref.Clang_ast_t.dr_kind in let decl_kind = decl_ref.Clang_ast_t.dr_kind in
match decl_kind with match decl_kind with
@ -677,14 +677,14 @@ struct
method_deref_trans trans_state pre_trans_result decl_ref stmt_info decl_kind method_deref_trans trans_state pre_trans_result decl_ref stmt_info decl_kind
| _ -> | _ ->
let print_error decl_kind = let print_error decl_kind =
Printing.log_stats Logging.out
"Warning: Decl ref expression %s with pointer %d still needs to be translated " "Warning: Decl ref expression %s with pointer %d still needs to be translated "
(Clang_ast_j.string_of_decl_kind decl_kind) (Clang_ast_j.string_of_decl_kind decl_kind)
decl_ref.Clang_ast_t.dr_decl_pointer in decl_ref.Clang_ast_t.dr_decl_pointer in
print_error decl_kind; assert false print_error decl_kind; assert false
and declRefExpr_trans trans_state stmt_info decl_ref_expr_info _ = and declRefExpr_trans trans_state stmt_info decl_ref_expr_info _ =
Printing.log_out " priority node free = '%s'\n@." Logging.out_debug " priority node free = '%s'\n@."
(string_of_bool (PriorityNode.is_priority_free trans_state)); (string_of_bool (PriorityNode.is_priority_free trans_state));
let decl_ref = match decl_ref_expr_info.Clang_ast_t.drti_decl_ref with let decl_ref = match decl_ref_expr_info.Clang_ast_t.drti_decl_ref with
| Some dr -> dr | Some dr -> dr
@ -770,8 +770,8 @@ struct
and binaryOperator_trans trans_state binary_operator_info stmt_info expr_info stmt_list = and binaryOperator_trans trans_state binary_operator_info stmt_info expr_info stmt_list =
let bok = let bok =
Clang_ast_j.string_of_binary_operator_kind binary_operator_info.Clang_ast_t.boi_kind in Clang_ast_j.string_of_binary_operator_kind binary_operator_info.Clang_ast_t.boi_kind in
Printing.log_out " BinaryOperator '%s' " bok; Logging.out_debug " BinaryOperator '%s' " bok;
Printing.log_out " priority node free = '%s'\n@." Logging.out_debug " priority node free = '%s'\n@."
(string_of_bool (PriorityNode.is_priority_free trans_state)); (string_of_bool (PriorityNode.is_priority_free trans_state));
let context = trans_state.context in let context = trans_state.context in
let trans_state_pri = PriorityNode.try_claim_priority_node trans_state stmt_info in let trans_state_pri = PriorityNode.try_claim_priority_node trans_state stmt_info in
@ -880,7 +880,7 @@ struct
let params = IList.tl (collect_exprs result_trans_subexprs) in let params = IList.tl (collect_exprs result_trans_subexprs) in
if IList.length params = IList.length params_stmt then if IList.length params = IList.length params_stmt then
params params
else (Printing.log_err else (Logging.err_debug
"WARNING: stmt_list and res_trans_par.exps must have same size. \ "WARNING: stmt_list and res_trans_par.exps must have same size. \
NEED TO BE FIXED\n\n"; NEED TO BE FIXED\n\n";
fix_param_exps_mismatch params_stmt params) in fix_param_exps_mismatch params_stmt params) in
@ -1058,7 +1058,7 @@ struct
| [] -> obj_c_message_expr_info, [empty_res_trans] | [] -> obj_c_message_expr_info, [empty_res_trans]
and objCMessageExpr_trans trans_state si obj_c_message_expr_info stmt_list expr_info = and objCMessageExpr_trans trans_state si obj_c_message_expr_info stmt_list expr_info =
Printing.log_out " priority node free = '%s'\n@." Logging.out_debug " priority node free = '%s'\n@."
(string_of_bool (PriorityNode.is_priority_free trans_state)); (string_of_bool (PriorityNode.is_priority_free trans_state));
let context = trans_state.context in let context = trans_state.context in
let sil_loc = CLocation.get_sil_location si context in let sil_loc = CLocation.get_sil_location si context in
@ -1101,12 +1101,12 @@ struct
and dispatch_function_trans trans_state stmt_info stmt_list n = and dispatch_function_trans trans_state stmt_info stmt_list n =
Printing.log_out "\n Call to a dispatch function treated as special case...\n"; Logging.out_debug "\n Call to a dispatch function treated as special case...\n";
let transformed_stmt = Ast_expressions.translate_dispatch_function stmt_info stmt_list n in let transformed_stmt = Ast_expressions.translate_dispatch_function stmt_info stmt_list n in
instruction trans_state transformed_stmt instruction trans_state transformed_stmt
and block_enumeration_trans trans_state stmt_info stmt_list ei = and block_enumeration_trans trans_state stmt_info stmt_list ei =
Printing.log_out "\n Call to a block enumeration function treated as special case...\n@."; Logging.out_debug "\n Call to a block enumeration function treated as special case...\n@.";
let procname = Cfg.Procdesc.get_proc_name trans_state.context.CContext.procdesc in let procname = Cfg.Procdesc.get_proc_name trans_state.context.CContext.procdesc in
let pvar = CFrontend_utils.General_utils.get_next_block_pvar procname in let pvar = CFrontend_utils.General_utils.get_next_block_pvar procname in
let transformed_stmt, _ = let transformed_stmt, _ =
@ -1189,7 +1189,7 @@ struct
let root_nodes = init_res_trans'.root_nodes in let root_nodes = init_res_trans'.root_nodes in
let root_nodes' = if root_nodes <> [] then root_nodes else op_res_trans.root_nodes in let root_nodes' = if root_nodes <> [] then root_nodes else op_res_trans.root_nodes in
{ op_res_trans with root_nodes = root_nodes'; } { op_res_trans with root_nodes = root_nodes'; }
| _ -> Printing.log_stats "BinaryConditionalOperator not translated@."; | _ -> Logging.out "BinaryConditionalOperator not translated@.";
assert false assert false
(* Translate a condition for if/loops statement. It shorts-circuit and/or. *) (* Translate a condition for if/loops statement. It shorts-circuit and/or. *)
@ -1206,7 +1206,7 @@ struct
"\nWARNING: Missing expression for Conditional operator. Need to be fixed" in "\nWARNING: Missing expression for Conditional operator. Need to be fixed" in
(* this function translate cond without doing shortcircuit *) (* this function translate cond without doing shortcircuit *)
let no_short_circuit_cond () = let no_short_circuit_cond () =
Printing.log_out " No short-circuit condition\n"; Logging.out_debug " No short-circuit condition\n";
let res_trans_cond = let res_trans_cond =
if is_null_stmt cond then { if is_null_stmt cond then {
empty_res_trans with exps = [(Exp.Const (Const.Cint IntLit.one), (Typ.Tint Typ.IBool))] empty_res_trans with exps = [(Exp.Const (Const.Cint IntLit.one), (Typ.Tint Typ.IBool))]
@ -1267,7 +1267,7 @@ struct
instrs = res_trans_s1.instrs@res_trans_s2.instrs; instrs = res_trans_s1.instrs@res_trans_s2.instrs;
exps = [(e_cond, typ1)]; exps = [(e_cond, typ1)];
} in } in
Printing.log_out "Translating Condition for If-then-else/Loop/Conditional Operator \n"; Logging.out_debug "Translating Condition for If-then-else/Loop/Conditional Operator \n";
let open Clang_ast_t in let open Clang_ast_t in
match cond with match cond with
| BinaryOperator(_, [s1; s2], _, boi) -> | BinaryOperator(_, [s1; s2], _, boi) ->
@ -1757,7 +1757,7 @@ struct
| RecordDecl _ :: _ -> (* Case for struct *) | RecordDecl _ :: _ -> (* Case for struct *)
collect_all_decl trans_state decl_list succ_nodes stmt_info collect_all_decl trans_state decl_list succ_nodes stmt_info
| _ -> | _ ->
Printing.log_stats Logging.out
"WARNING: In DeclStmt found an unknown declaration type. \ "WARNING: In DeclStmt found an unknown declaration type. \
RETURNING empty list of declaration. NEED TO BE FIXED"; RETURNING empty list of declaration. NEED TO BE FIXED";
empty_res_trans in empty_res_trans in
@ -1770,7 +1770,7 @@ struct
(* For OpaqueValueExpr we return the translation generated from its source expression*) (* For OpaqueValueExpr we return the translation generated from its source expression*)
and opaqueValueExpr_trans trans_state opaque_value_expr_info = and opaqueValueExpr_trans trans_state opaque_value_expr_info =
Printing.log_out " priority node free = '%s'\n@." Logging.out_debug " priority node free = '%s'\n@."
(string_of_bool (PriorityNode.is_priority_free trans_state)); (string_of_bool (PriorityNode.is_priority_free trans_state));
match trans_state.opaque_exp with match trans_state.opaque_exp with
| Some exp -> { empty_res_trans with exps = [exp] } | Some exp -> { empty_res_trans with exps = [exp] }
@ -1798,7 +1798,7 @@ struct
(* to translate the CallToSetter which is (* to translate the CallToSetter which is
how x.f = a is actually implemented by the runtime.*) how x.f = a is actually implemented by the runtime.*)
and pseudoObjectExpr_trans trans_state stmt_list = and pseudoObjectExpr_trans trans_state stmt_list =
Printing.log_out " priority node free = '%s'\n@." Logging.out_debug " priority node free = '%s'\n@."
(string_of_bool (PriorityNode.is_priority_free trans_state)); (string_of_bool (PriorityNode.is_priority_free trans_state));
let rec do_semantic_elements el = let rec do_semantic_elements el =
let open Clang_ast_t in let open Clang_ast_t in
@ -1814,7 +1814,7 @@ struct
(* Cast expression are treated the same apart from the cast operation kind*) (* Cast expression are treated the same apart from the cast operation kind*)
and cast_exprs_trans trans_state stmt_info stmt_list expr_info cast_expr_info = and cast_exprs_trans trans_state stmt_info stmt_list expr_info cast_expr_info =
let context = trans_state.context in let context = trans_state.context in
Printing.log_out " priority node free = '%s'\n@." Logging.out_debug " priority node free = '%s'\n@."
(string_of_bool (PriorityNode.is_priority_free trans_state)); (string_of_bool (PriorityNode.is_priority_free trans_state));
let sil_loc = CLocation.get_sil_location stmt_info context in let sil_loc = CLocation.get_sil_location stmt_info context in
let stmt = extract_stmt_from_singleton stmt_list let stmt = extract_stmt_from_singleton stmt_list
@ -1930,7 +1930,7 @@ struct
| [] -> (* return; *) | [] -> (* return; *)
let ret_node = mk_ret_node [] in let ret_node = mk_ret_node [] in
{ empty_res_trans with root_nodes = [ret_node]; leaf_nodes = []} { empty_res_trans with root_nodes = [ret_node]; leaf_nodes = []}
| _ -> Printing.log_out | _ -> Logging.out_debug
"\nWARNING: Missing translation of Return Expression. \ "\nWARNING: Missing translation of Return Expression. \
Return Statement ignored. Need fixing!\n"; Return Statement ignored. Need fixing!\n";
{ empty_res_trans with root_nodes = succ_nodes }) in { empty_res_trans with root_nodes = succ_nodes }) in
@ -2358,7 +2358,7 @@ struct
let stmt_kind = Clang_ast_proj.get_stmt_kind_string instr in let stmt_kind = Clang_ast_proj.get_stmt_kind_string instr in
let stmt_info, _ = Clang_ast_proj.get_stmt_tuple instr in let stmt_info, _ = Clang_ast_proj.get_stmt_tuple instr in
let stmt_pointer = stmt_info.Clang_ast_t.si_pointer in let stmt_pointer = stmt_info.Clang_ast_t.si_pointer in
Printing.log_out "\nPassing from %s '%d' \n" stmt_kind stmt_pointer; Logging.out_debug "\nPassing from %s '%d' \n" stmt_kind stmt_pointer;
let open Clang_ast_t in let open Clang_ast_t in
match instr with match instr with
| GotoStmt(stmt_info, _, { Clang_ast_t.gsi_label = label_name; _ }) -> | GotoStmt(stmt_info, _, { Clang_ast_t.gsi_label = label_name; _ }) ->
@ -2411,7 +2411,7 @@ struct
switchStmt_trans trans_state stmt_info switch_stmt_list switchStmt_trans trans_state stmt_info switch_stmt_list
| CaseStmt _ -> | CaseStmt _ ->
Printing.log_out Logging.out_debug
"FATAL: Passing from CaseStmt outside of SwitchStmt, terminating.\n"; "FATAL: Passing from CaseStmt outside of SwitchStmt, terminating.\n";
assert false assert false
@ -2560,7 +2560,7 @@ struct
| ObjCAtTryStmt (_, stmts) -> | ObjCAtTryStmt (_, stmts) ->
compoundStmt_trans trans_state stmts compoundStmt_trans trans_state stmts
| CXXTryStmt (_, stmts) -> | CXXTryStmt (_, stmts) ->
(Printing.log_stats (Logging.out
"\n!!!!WARNING: found statement %s. \nTranslation need to be improved.... \n" "\n!!!!WARNING: found statement %s. \nTranslation need to be improved.... \n"
(Ast_utils.string_of_stmt instr); (Ast_utils.string_of_stmt instr);
compoundStmt_trans trans_state stmts) compoundStmt_trans trans_state stmts)
@ -2639,7 +2639,7 @@ struct
| VAArgExpr (_, _, expr_info) -> | VAArgExpr (_, _, expr_info) ->
trans_into_undefined_expr trans_state expr_info trans_into_undefined_expr trans_state expr_info
| s -> (Printing.log_stats | s -> (Logging.out
"\n!!!!WARNING: found statement %s. \nACTION REQUIRED: \ "\n!!!!WARNING: found statement %s. \nACTION REQUIRED: \
Translation need to be defined. Statement ignored.... \n" Translation need to be defined. Statement ignored.... \n"
(Ast_utils.string_of_stmt s); (Ast_utils.string_of_stmt s);

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

@ -22,7 +22,7 @@ module L = Logging
let extract_item_from_singleton l warning_string failure_val = let extract_item_from_singleton l warning_string failure_val =
match l with match l with
| [item] -> item | [item] -> item
| _ -> Printing.log_err "%s" warning_string; failure_val | _ -> Logging.err_debug "%s" warning_string; failure_val
let dummy_exp = (Exp.minus_one, Typ.Tint Typ.IInt) let dummy_exp = (Exp.minus_one, Typ.Tint Typ.IInt)
@ -211,11 +211,11 @@ struct
let try_claim_priority_node trans_state stmt_info = let try_claim_priority_node trans_state stmt_info =
match trans_state.priority with match trans_state.priority with
| Free -> | Free ->
Printing.log_out "Priority is free. Locking priority node in %d\n@." Logging.out_debug "Priority is free. Locking priority node in %d\n@."
stmt_info.Clang_ast_t.si_pointer; stmt_info.Clang_ast_t.si_pointer;
{ trans_state with priority = Busy stmt_info.Clang_ast_t.si_pointer } { trans_state with priority = Busy stmt_info.Clang_ast_t.si_pointer }
| _ -> | _ ->
Printing.log_out "Priority busy in %d. No claim possible\n@." Logging.out_debug "Priority busy in %d. No claim possible\n@."
stmt_info.Clang_ast_t.si_pointer; stmt_info.Clang_ast_t.si_pointer;
trans_state trans_state
@ -434,7 +434,7 @@ let cast_operation trans_state cast_kind exps cast_typ sil_loc is_objc_bridged =
let instrs, deref_exp = dereference_var_sil (exp, typ) sil_loc in let instrs, deref_exp = dereference_var_sil (exp, typ) sil_loc in
instrs, (deref_exp, cast_typ) instrs, (deref_exp, cast_typ)
| _ -> | _ ->
Printing.log_err Logging.err_debug
"\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); (Clang_ast_j.string_of_cast_kind cast_kind);
([], (exp, cast_typ)) ([], (exp, cast_typ))
@ -570,7 +570,7 @@ let rec get_type_from_exp_stmt stmt =
| ImplicitCastExpr(_, stmt_list, _, _) -> | ImplicitCastExpr(_, stmt_list, _, _) ->
get_type_from_exp_stmt (extract_stmt_from_singleton stmt_list "WARNING: We expect only one stmt.") get_type_from_exp_stmt (extract_stmt_from_singleton stmt_list "WARNING: We expect only one stmt.")
| DeclRefExpr(_, _, _, info) -> do_decl_ref_exp info | DeclRefExpr(_, _, _, info) -> do_decl_ref_exp info
| _ -> Printing.log_err "Failing with: %s \n%!" (Clang_ast_j.string_of_stmt stmt); | _ -> Logging.err_debug "Failing with: %s \n%!" (Clang_ast_j.string_of_stmt stmt);
Printing.print_failure_info ""; Printing.print_failure_info "";
assert false assert false
@ -747,7 +747,7 @@ let var_or_zero_in_init_list tenv e typ ~return_zero:return_zero =
let extract_item_from_option op warning_string = let extract_item_from_option op warning_string =
match op with match op with
| Some item -> item | Some item -> item
| _ -> Printing.log_err warning_string; assert false | _ -> Logging.err_debug warning_string; assert false
let extract_id_from_singleton id_list warning_string = let extract_id_from_singleton id_list warning_string =
extract_item_from_singleton id_list warning_string (dummy_id ()) extract_item_from_singleton id_list warning_string (dummy_id ())

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

@ -143,11 +143,11 @@ and decl_ptr_to_sil_type translate_decl tenv decl_ptr =
| Some (ObjCCategoryImplDecl _ as d) | Some (ObjCCategoryImplDecl _ as d)
| Some (EnumDecl _ as d) -> translate_decl tenv d | Some (EnumDecl _ as d) -> translate_decl tenv d
| Some _ -> | Some _ ->
Printing.log_err "Warning: Wrong decl found for pointer %s " Logging.err_debug "Warning: Wrong decl found for pointer %s "
(Clang_ast_j.string_of_pointer decl_ptr); (Clang_ast_j.string_of_pointer decl_ptr);
Typ.Tvoid Typ.Tvoid
| None -> | None ->
Printing.log_err "Warning: Decl pointer %s not found." Logging.err_debug "Warning: Decl pointer %s not found."
(Clang_ast_j.string_of_pointer decl_ptr); (Clang_ast_j.string_of_pointer decl_ptr);
Typ.Tvoid Typ.Tvoid
@ -166,7 +166,7 @@ and prebuilt_type_to_sil_type type_ptr =
try try
Clang_ast_types.TypePointerMap.find type_ptr !CFrontend_config.sil_types_map Clang_ast_types.TypePointerMap.find type_ptr !CFrontend_config.sil_types_map
with Not_found -> with Not_found ->
Printing.log_stats "Prebuilt type %s not found\n" Logging.out "Prebuilt type %s not found\n"
(Clang_ast_types.type_ptr_to_string type_ptr); (Clang_ast_types.type_ptr_to_string type_ptr);
assert false assert false

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

@ -27,7 +27,7 @@ let classname_of_type typ =
| Typ.Tstruct name -> Typename.name name | Typ.Tstruct name -> Typename.name name
| Typ.Tfun _ -> CFrontend_config.objc_object | Typ.Tfun _ -> CFrontend_config.objc_object
| _ -> | _ ->
Printing.log_out Logging.out_debug
"Classname of type cannot be extracted in type %s" (Typ.to_string typ); "Classname of type cannot be extracted in type %s" (Typ.to_string typ);
"undefined" "undefined"
@ -50,11 +50,11 @@ let rec return_type_of_function_type_ptr type_ptr =
| Some BlockPointerType (_, in_type_ptr) -> | Some BlockPointerType (_, in_type_ptr) ->
return_type_of_function_type_ptr in_type_ptr return_type_of_function_type_ptr in_type_ptr
| Some _ -> | Some _ ->
Printing.log_err "Warning: Type pointer %s is not a function type." Logging.err_debug "Warning: Type pointer %s is not a function type."
(Clang_ast_types.type_ptr_to_string type_ptr); (Clang_ast_types.type_ptr_to_string type_ptr);
`ErrorType `ErrorType
| None -> | None ->
Printing.log_err "Warning: Type pointer %s not found." Logging.err_debug "Warning: Type pointer %s not found."
(Clang_ast_types.type_ptr_to_string type_ptr); (Clang_ast_types.type_ptr_to_string type_ptr);
`ErrorType `ErrorType
@ -83,9 +83,9 @@ let get_name_from_type_pointer custom_type_pointer =
let rec get_type_list nn ll = let rec get_type_list nn ll =
match ll with match ll with
| [] -> [] | [] -> []
| (n, t):: ll' -> (* Printing.log_out ">>>>>Searching for type '%s'. Seen '%s'.@." nn n; *) | (n, t):: ll' -> (* Logging.out_debug ">>>>>Searching for type '%s'. Seen '%s'.@." nn n; *)
if n = nn then ( if n = nn then (
Printing.log_out ">>>>>>>>>>>>>>>>>>>>>>>NOW Found, Its type is: '%s'@." Logging.out_debug ">>>>>>>>>>>>>>>>>>>>>>>NOW Found, Its type is: '%s'@."
(Typ.to_string t); (Typ.to_string t);
[t] [t]
) else get_type_list nn ll' ) else get_type_list nn ll'

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

@ -87,7 +87,7 @@ let get_class_methods class_name decl_list =
| Clang_ast_t.CXXConversionDecl (_, name_info, _, fdi, mdi) | Clang_ast_t.CXXConversionDecl (_, name_info, _, fdi, mdi)
| Clang_ast_t.CXXDestructorDecl (_, name_info, _, fdi, mdi) -> | Clang_ast_t.CXXDestructorDecl (_, name_info, _, fdi, mdi) ->
let method_name = name_info.Clang_ast_t.ni_name in let method_name = name_info.Clang_ast_t.ni_name in
Printing.log_out " ...Declaring method '%s'.\n" method_name; Logging.out_debug " ...Declaring method '%s'.\n" method_name;
let mangled = General_utils.get_mangled_method_name fdi mdi in let mangled = General_utils.get_mangled_method_name fdi mdi in
let procname = let procname =
General_utils.mk_procname_from_cpp_method class_name method_name ~meth_decl mangled in General_utils.mk_procname_from_cpp_method class_name method_name ~meth_decl mangled in

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

@ -84,7 +84,7 @@ let process_category type_ptr_to_sil_type tenv curr_class decl_info decl_list =
ignore( ignore(
Tenv.mk_struct tenv Tenv.mk_struct tenv
~default:struct_typ ~fields:new_fields ~statics:[] ~methods:new_methods class_tn_name ); ~default:struct_typ ~fields:new_fields ~statics:[] ~methods:new_methods class_tn_name );
Printing.log_out " Updating info for class '%s' in tenv\n" class_name Logging.out_debug " Updating info for class '%s' in tenv\n" class_name
| _ -> ()); | _ -> ());
Typ.Tstruct class_tn_name Typ.Tstruct class_tn_name
@ -94,7 +94,7 @@ let category_decl type_ptr_to_sil_type tenv decl =
| ObjCCategoryDecl (decl_info, name_info, decl_list, _, cdi) -> | ObjCCategoryDecl (decl_info, name_info, decl_list, _, cdi) ->
let name = Ast_utils.get_qualified_name name_info in let name = Ast_utils.get_qualified_name name_info in
let curr_class = get_curr_class_from_category_decl name cdi in let curr_class = get_curr_class_from_category_decl name cdi in
Printing.log_out "ADDING: ObjCCategoryDecl for '%s'\n" name; Logging.out_debug "ADDING: ObjCCategoryDecl for '%s'\n" name;
let _ = add_class_decl type_ptr_to_sil_type tenv cdi in let _ = add_class_decl type_ptr_to_sil_type tenv cdi in
let typ = process_category type_ptr_to_sil_type tenv curr_class decl_info decl_list in let typ = process_category type_ptr_to_sil_type tenv curr_class decl_info decl_list in
let _ = add_category_implementation type_ptr_to_sil_type tenv cdi in let _ = add_category_implementation type_ptr_to_sil_type tenv cdi in
@ -107,7 +107,7 @@ let category_impl_decl type_ptr_to_sil_type tenv decl =
| ObjCCategoryImplDecl (decl_info, name_info, decl_list, _, cii) -> | ObjCCategoryImplDecl (decl_info, name_info, decl_list, _, cii) ->
let name = Ast_utils.get_qualified_name name_info in let name = Ast_utils.get_qualified_name name_info in
let curr_class = get_curr_class_from_category_impl name cii in let curr_class = get_curr_class_from_category_impl name cii in
Printing.log_out "ADDING: ObjCCategoryImplDecl for '%s'\n" name; Logging.out_debug "ADDING: ObjCCategoryImplDecl for '%s'\n" name;
let _ = add_category_decl type_ptr_to_sil_type tenv cii in let _ = add_category_decl type_ptr_to_sil_type tenv cii in
let typ = process_category type_ptr_to_sil_type tenv curr_class decl_info decl_list in let typ = process_category type_ptr_to_sil_type tenv curr_class decl_info decl_list in
typ typ

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

@ -96,7 +96,7 @@ let create_supers_fields type_ptr_to_sil_type tenv curr_class decl_list
(* Adds pairs (interface name, interface_type_info) to the global environment. *) (* Adds pairs (interface name, interface_type_info) to the global environment. *)
let add_class_to_tenv type_ptr_to_sil_type tenv curr_class decl_info name_info decl_list ocidi = let add_class_to_tenv type_ptr_to_sil_type tenv curr_class decl_info name_info decl_list ocidi =
let class_name = Ast_utils.get_qualified_name name_info in let class_name = Ast_utils.get_qualified_name name_info in
Printing.log_out "ADDING: ObjCInterfaceDecl for '%s'\n" class_name; Logging.out_debug "ADDING: ObjCInterfaceDecl for '%s'\n" class_name;
let interface_name = CTypes.mk_classname class_name Csu.Objc in let interface_name = CTypes.mk_classname class_name Csu.Objc in
let decl_key = `DeclPtr decl_info.Clang_ast_t.di_pointer in let decl_key = `DeclPtr decl_info.Clang_ast_t.di_pointer in
Ast_utils.update_sil_types_map decl_key (Typ.Tstruct interface_name); Ast_utils.update_sil_types_map decl_key (Typ.Tstruct interface_name);
@ -107,8 +107,8 @@ let add_class_to_tenv type_ptr_to_sil_type tenv curr_class decl_info name_info d
let methods = ObjcProperty_decl.get_methods curr_class decl_list in let methods = ObjcProperty_decl.get_methods curr_class decl_list in
let fields_sc = CField_decl.fields_superclass tenv ocidi Csu.Objc in let fields_sc = CField_decl.fields_superclass tenv ocidi Csu.Objc in
IList.iter (fun (fn, ft, _) -> IList.iter (fun (fn, ft, _) ->
Printing.log_out "----->SuperClass field: '%s' " (Ident.fieldname_to_string fn); Logging.out_debug "----->SuperClass field: '%s' " (Ident.fieldname_to_string fn);
Printing.log_out "type: '%s'\n" (Typ.to_string ft)) fields_sc; Logging.out_debug "type: '%s'\n" (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 *) (*In case we found categories, or partial definition of this class earlier and they are already in the tenv *)
let fields, (supers : Typename.t list), methods = let fields, (supers : Typename.t list), methods =
match Tenv.lookup tenv interface_name with match Tenv.lookup tenv interface_name with
@ -121,19 +121,19 @@ let add_class_to_tenv type_ptr_to_sil_type tenv curr_class decl_info name_info d
(* We add the special hidden counter_field for implementing reference counting *) (* We add the special hidden counter_field for implementing reference counting *)
let modelled_fields = StructTyp.objc_ref_counter_field :: CField_decl.modelled_field name_info in let modelled_fields = StructTyp.objc_ref_counter_field :: CField_decl.modelled_field name_info in
let all_fields = General_utils.append_no_duplicates_fields modelled_fields fields in let all_fields = General_utils.append_no_duplicates_fields modelled_fields fields in
Printing.log_out "Class %s field:\n" class_name; Logging.out_debug "Class %s field:\n" class_name;
IList.iter (fun (fn, _, _) -> IList.iter (fun (fn, _, _) ->
Printing.log_out "-----> field: '%s'\n" (Ident.fieldname_to_string fn)) all_fields; Logging.out_debug "-----> field: '%s'\n" (Ident.fieldname_to_string fn)) all_fields;
ignore( ignore(
Tenv.mk_struct tenv Tenv.mk_struct tenv
~fields: all_fields ~supers ~methods ~annots:Annot.Class.objc interface_name ); ~fields: all_fields ~supers ~methods ~annots:Annot.Class.objc interface_name );
Printing.log_out Logging.out_debug
" >>>Verifying that Typename '%s' is in tenv\n" (Typename.to_string interface_name); " >>>Verifying that Typename '%s' is in tenv\n" (Typename.to_string interface_name);
(match Tenv.lookup tenv interface_name with (match Tenv.lookup tenv interface_name with
| Some st -> | Some st ->
Printing.log_out " >>>OK. Found typ='%a'\n" Logging.out_debug " >>>OK. Found typ='%a'\n"
(StructTyp.pp pe_text (fun _ () -> ()) interface_name) st (StructTyp.pp pe_text (fun _ () -> ()) interface_name) st
| None -> Printing.log_out " >>>NOT Found!!\n"); | None -> Logging.out_debug " >>>NOT Found!!\n");
Typ.Tstruct interface_name Typ.Tstruct interface_name
let add_missing_methods tenv class_name ck decl_info decl_list curr_class = let add_missing_methods tenv class_name ck decl_info decl_list curr_class =
@ -173,7 +173,7 @@ let interface_impl_declaration type_ptr_to_sil_type tenv decl =
match decl with match decl with
| ObjCImplementationDecl (decl_info, name_info, decl_list, _, idi) -> | ObjCImplementationDecl (decl_info, name_info, decl_list, _, idi) ->
let class_name = Ast_utils.get_qualified_name name_info in let class_name = Ast_utils.get_qualified_name name_info in
Printing.log_out "ADDING: ObjCImplementationDecl for class '%s'\n" class_name; Logging.out_debug "ADDING: ObjCImplementationDecl for class '%s'\n" class_name;
let _ = add_class_decl type_ptr_to_sil_type tenv idi in let _ = add_class_decl type_ptr_to_sil_type tenv idi in
let curr_class = get_curr_class_impl idi in let curr_class = get_curr_class_impl idi in
let fields = CField_decl.get_fields type_ptr_to_sil_type tenv curr_class decl_list in let fields = CField_decl.get_fields type_ptr_to_sil_type tenv curr_class decl_list in

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

@ -40,7 +40,7 @@ let get_methods curr_class decl_list =
let is_instance = method_decl_info.Clang_ast_t.omdi_is_instance_method in let is_instance = method_decl_info.Clang_ast_t.omdi_is_instance_method in
let method_kind = Procname.objc_method_kind_of_bool is_instance in let method_kind = Procname.objc_method_kind_of_bool is_instance in
let method_name = name_info.Clang_ast_t.ni_name in let method_name = name_info.Clang_ast_t.ni_name in
Printing.log_out " ...Adding Method '%s' \n" (class_name^"_"^method_name); Logging.out_debug " ...Adding Method '%s' \n" (class_name^"_"^method_name);
let meth_name = General_utils.mk_procname_from_objc_method class_name method_name method_kind in let meth_name = General_utils.mk_procname_from_objc_method class_name method_name method_kind in
meth_name:: list_methods meth_name:: list_methods
| _ -> list_methods in | _ -> list_methods in

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

@ -27,7 +27,7 @@ let protocol_decl type_ptr_to_sil_type tenv decl =
(* Protocol_type_info contains the methods composing the protocol. *) (* Protocol_type_info contains the methods composing the protocol. *)
(* Here we are giving a similar treatment as interfaces (see above)*) (* Here we are giving a similar treatment as interfaces (see above)*)
(* It may turn out that we need a more specific treatment for protocols*) (* It may turn out that we need a more specific treatment for protocols*)
Printing.log_out "ADDING: ObjCProtocolDecl for '%s'\n" name; Logging.out_debug "ADDING: ObjCProtocolDecl for '%s'\n" name;
let mang_name = Mangled.from_string name in let mang_name = Mangled.from_string name in
let protocol_name = Typename.TN_csu (Csu.Protocol, mang_name) in let protocol_name = Typename.TN_csu (Csu.Protocol, mang_name) in
let decl_key = `DeclPtr decl_info.Clang_ast_t.di_pointer in let decl_key = `DeclPtr decl_info.Clang_ast_t.di_pointer in

23
infer/src/clang/printing.ml
Unescape View File

@ -12,15 +12,6 @@ open! Utils
module L = Logging module L = Logging
module F = Format module F = Format
let log_out fmt =
let pp = if Config.debug_mode then Format.fprintf else Format.ifprintf in
pp Format.std_formatter fmt
let log_err fmt =
let pp = if Config.debug_mode then Format.fprintf else Format.ifprintf in
pp Format.err_formatter fmt
let annotation_to_string ((annotation: Annot.t), _) = let annotation_to_string ((annotation: Annot.t), _) =
"< " ^ annotation.class_name ^ " : " ^ "< " ^ annotation.class_name ^ " : " ^
(IList.to_string (fun x -> x) annotation.parameters) ^ " >" (IList.to_string (fun x -> x) annotation.parameters) ^ " >"
@ -29,17 +20,11 @@ let field_to_string (fieldname, typ, annotation) =
(Ident.fieldname_to_string fieldname) ^ " " ^ (Ident.fieldname_to_string fieldname) ^ " " ^
(Typ.to_string typ) ^ (IList.to_string annotation_to_string annotation) (Typ.to_string typ) ^ (IList.to_string annotation_to_string annotation)
let log_stats fmt =
let pp =
if Config.stats_mode || Config.debug_mode
then Format.fprintf else Format.ifprintf in
pp Format.std_formatter fmt
let print_tenv tenv = let print_tenv tenv =
Tenv.iter (fun typname struct_t -> Tenv.iter (fun typname struct_t ->
match typname with match typname with
| Typename.TN_csu (Csu.Class _, _) | Typename.TN_csu (Csu.Protocol, _) -> | Typename.TN_csu (Csu.Class _, _) | Typename.TN_csu (Csu.Protocol, _) ->
print_endline ( Logging.do_out "%s" (
(Typename.to_string typname) ^ " " ^ (Typename.to_string typname) ^ " " ^
(Annot.Item.to_string struct_t.annots) ^ "\n" ^ (Annot.Item.to_string struct_t.annots) ^ "\n" ^
"---> superclass and protocols " ^ (IList.to_string (fun tn -> "---> superclass and protocols " ^ (IList.to_string (fun tn ->
@ -55,7 +40,7 @@ let print_tenv_struct_unions tenv =
Tenv.iter (fun typname struct_t -> Tenv.iter (fun typname struct_t ->
match typname with match typname with
| Typename.TN_csu (Csu.Struct, _) | Typename.TN_csu (Csu.Union, _) -> | Typename.TN_csu (Csu.Struct, _) | Typename.TN_csu (Csu.Union, _) ->
print_endline ( Logging.do_out "%s" (
(Typename.to_string typname)^"\n"^ (Typename.to_string typname)^"\n"^
"\t---> fields "^(IList.to_string (fun (fieldname, typ, _) -> "\t---> fields "^(IList.to_string (fun (fieldname, typ, _) ->
match typ with match typ with
@ -70,7 +55,7 @@ let print_tenv_struct_unions tenv =
let print_procedures cfg = let print_procedures cfg =
let procs = Cfg.get_all_procs cfg in let procs = Cfg.get_all_procs cfg in
print_endline Logging.do_out "%s"
(IList.to_string (fun pdesc -> (IList.to_string (fun pdesc ->
let pname = Cfg.Procdesc.get_proc_name pdesc in let pname = Cfg.Procdesc.get_proc_name pdesc in
"name> "^ "name> "^
@ -82,7 +67,7 @@ let print_failure_info pointer =
L.err "AST Element> %s IN FILE> %s @.@." pointer !CFrontend_config.json L.err "AST Element> %s IN FILE> %s @.@." pointer !CFrontend_config.json
let print_nodes nodes = let print_nodes nodes =
IList.iter (fun node -> print_endline (Cfg.Node.get_description pe_text node)) nodes IList.iter (fun node -> Logging.do_out "%s" (Cfg.Node.get_description pe_text node)) nodes
let instrs_to_string instrs = let instrs_to_string instrs =
let pp fmt () = Format.fprintf fmt "%a" (Sil.pp_instr_list pe_text) instrs in let pp fmt () = Format.fprintf fmt "%a" (Sil.pp_instr_list pe_text) instrs in

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

@ -9,12 +9,6 @@
open! Utils open! Utils
val log_out : ('a, Format.formatter, unit) format -> 'a
val log_err : ('a, Format.formatter, unit) format -> 'a
val log_stats : ('a, Format.formatter, unit) format -> 'a
val print_failure_info : string -> unit val print_failure_info : string -> unit
val print_tenv : Tenv.t -> unit val print_tenv : Tenv.t -> unit

Write Preview
Loading…
Cancel
Save