[config] split non-json creating stuff out of InferPrint.ml

Summary:
At this point in the stack, here's what's left in InferPrint.ml:
1. how to output report.json and costs_report.json
2. how to print summaries from the command line (`infer report`)
3. how to print --issues-tests stuff (`infer report --issues-tests`)

Keep only 1. in there. 2. goes to SpecsFiles.ml directly from infer.ml,
and 3. goes to its own module (also the fields to output in
--issues-tests get a non-poly variant).

1. does some extra stuff sometimes, eg in test-determinator mode. Keep
this for now.

Reviewed By: ngorogiannis

Differential Revision: D20362642

fbshipit-source-id: 0d9f0e8e2
master
Jules Villard 5 years ago committed by Facebook GitHub Bot
parent 339ebe74ec
commit 19e8ae652c

@ -277,72 +277,6 @@ module JsonCostsPrinter = MakeJsonListPrinter (struct
None None
end) end)
let pp_custom_of_report fmt report fields =
let pp_custom_of_issue fmt (issue : Jsonbug_t.jsonbug) =
let open Jsonbug_t in
let comma_separator index = if index > 0 then ", " else "" in
let pp_trace fmt trace comma =
let pp_trace_elem fmt {description} = F.pp_print_string fmt description in
let trace_without_empty_descs =
List.filter ~f:(fun {description} -> not (String.is_empty description)) trace
in
F.fprintf fmt "%s[%a]" comma (Pp.comma_seq pp_trace_elem) trace_without_empty_descs
in
let pp_field index field =
match field with
| `Issue_field_bug_type ->
Format.fprintf fmt "%s%s" (comma_separator index) issue.bug_type
| `Issue_field_bucket ->
let bucket =
match
String.lsplit2 issue.qualifier ~on:']'
|> Option.map ~f:fst
|> Option.bind ~f:(String.chop_prefix ~prefix:"[")
with
| Some bucket ->
bucket
| None ->
"no_bucket"
in
Format.fprintf fmt "%s%s" (comma_separator index) bucket
| `Issue_field_qualifier ->
Format.fprintf fmt "%s%s" (comma_separator index) issue.qualifier
| `Issue_field_severity ->
Format.fprintf fmt "%s%s" (comma_separator index) issue.severity
| `Issue_field_line ->
Format.fprintf fmt "%s%d" (comma_separator index) issue.line
| `Issue_field_column ->
Format.fprintf fmt "%s%d" (comma_separator index) issue.column
| `Issue_field_procedure ->
Format.fprintf fmt "%s%s" (comma_separator index) issue.procedure
| `Issue_field_procedure_start_line ->
Format.fprintf fmt "%s%d" (comma_separator index) issue.procedure_start_line
| `Issue_field_file ->
Format.fprintf fmt "%s%s" (comma_separator index) issue.file
| `Issue_field_bug_trace ->
pp_trace fmt issue.bug_trace (comma_separator index)
| `Issue_field_key ->
Format.fprintf fmt "%s%s" (comma_separator index) (Caml.Digest.to_hex issue.key)
| `Issue_field_hash ->
Format.fprintf fmt "%s%s" (comma_separator index) (Caml.Digest.to_hex issue.hash)
| `Issue_field_line_offset ->
Format.fprintf fmt "%s%d" (comma_separator index) (issue.line - issue.procedure_start_line)
| `Issue_field_qualifier_contains_potential_exception_note ->
Format.pp_print_bool fmt
(String.is_substring issue.qualifier ~substring:potential_exception_message)
in
List.iteri ~f:pp_field fields ; Format.fprintf fmt "@."
in
List.iter ~f:(pp_custom_of_issue fmt) report
let tests_jsonbug_compare (bug1 : Jsonbug_t.jsonbug) (bug2 : Jsonbug_t.jsonbug) =
let open Jsonbug_t in
[%compare: string * string * int * string * Caml.Digest.t]
(bug1.file, bug1.procedure, bug1.line - bug1.procedure_start_line, bug1.bug_type, bug1.hash)
(bug2.file, bug2.procedure, bug2.line - bug2.procedure_start_line, bug2.bug_type, bug2.hash)
let error_filter filters proc_name file error_name = let error_filter filters proc_name file error_name =
(Config.write_html || not (IssueType.(equal skip_function) error_name)) (Config.write_html || not (IssueType.(equal skip_function) error_name))
&& filters.Inferconfig.path_filter file && filters.Inferconfig.path_filter file
@ -350,9 +284,9 @@ let error_filter filters proc_name file error_name =
&& filters.Inferconfig.proc_filter proc_name && filters.Inferconfig.proc_filter proc_name
type report_kind = Costs | Issues | Summary [@@deriving compare] type report_kind = Costs | Issues [@@deriving compare]
type bug_format_kind = Json | Tests [@@deriving compare] type bug_format_kind = Json [@@deriving compare]
let get_outfile outfile = let get_outfile outfile =
match outfile with match outfile with
@ -369,8 +303,6 @@ let pp_issue_in_format (format_kind, (outfile_opt : Utils.outfile option)) error
let outf = get_outfile outfile_opt in let outf = get_outfile outfile_opt in
IssuesJson.pp outf.fmt IssuesJson.pp outf.fmt
{error_filter; proc_name; proc_loc_opt= Some proc_location; err_key; err_data} {error_filter; proc_name; proc_loc_opt= Some proc_location; err_key; err_data}
| Tests ->
L.die InternalError "Printing issues as tests is not implemented"
let pp_issues_in_format (format_kind, (outfile_opt : Utils.outfile option)) = let pp_issues_in_format (format_kind, (outfile_opt : Utils.outfile option)) =
@ -378,8 +310,6 @@ let pp_issues_in_format (format_kind, (outfile_opt : Utils.outfile option)) =
| Json -> | Json ->
let outf = get_outfile outfile_opt in let outf = get_outfile outfile_opt in
IssuesJson.pp_issues_of_error_log outf.fmt IssuesJson.pp_issues_of_error_log outf.fmt
| Tests ->
L.die InternalError "Printing issues as tests is not implemented"
let pp_issues_of_error_log error_filter linereader proc_loc_opt procname err_log bug_format_list = let pp_issues_of_error_log error_filter linereader proc_loc_opt procname err_log bug_format_list =
@ -398,18 +328,11 @@ let collect_issues summary issues_acc =
err_log issues_acc err_log issues_acc
let pp_summary summary =
L.result "Procedure: %a@\n%a@." Procname.pp (Summary.get_proc_name summary) Summary.pp_text
summary
let pp_costs_in_format (format_kind, (outfile_opt : Utils.outfile option)) = let pp_costs_in_format (format_kind, (outfile_opt : Utils.outfile option)) =
match format_kind with match format_kind with
| Json -> | Json ->
let outf = get_outfile outfile_opt in let outf = get_outfile outfile_opt in
JsonCostsPrinter.pp outf.fmt JsonCostsPrinter.pp outf.fmt
| Tests ->
L.die InternalError "Printing costs in tests is not implemented"
let pp_costs summary costs_format_list = let pp_costs summary costs_format_list =
@ -424,48 +347,12 @@ let pp_costs summary costs_format_list =
let pp_summary_by_report_kind formats_by_report_kind summary issues_acc = let pp_summary_by_report_kind formats_by_report_kind summary issues_acc =
let pp_summary_by_report_kind (report_kind, format_list) = let pp_summary_by_report_kind (report_kind, format_list) =
match (report_kind, format_list) with match (report_kind, format_list) with Costs, _ -> pp_costs summary format_list | _ -> ()
| Costs, _ ->
pp_costs summary format_list
| Summary, _ when InferCommand.equal Config.command Report && not Config.quiet ->
pp_summary summary
| _ ->
()
in in
List.iter ~f:pp_summary_by_report_kind formats_by_report_kind ; List.iter ~f:pp_summary_by_report_kind formats_by_report_kind ;
collect_issues summary issues_acc collect_issues summary issues_acc
let pp_json_report_by_report_kind formats_by_report_kind fname =
match Utils.read_file fname with
| Ok report_lines ->
let pp_json_issues format_list report =
let pp_json_issue (format_kind, (outfile_opt : Utils.outfile option)) =
match format_kind with
| Tests ->
let outf = get_outfile outfile_opt in
pp_custom_of_report outf.fmt report Config.issues_tests_fields
| Json ->
L.die InternalError "Printing issues from json does not support json output"
in
List.iter ~f:pp_json_issue format_list
in
let sorted_report =
let report = Jsonbug_j.report_of_string (String.concat ~sep:"\n" report_lines) in
List.sort ~compare:tests_jsonbug_compare report
in
let pp_report_by_report_kind (report_kind, format_list) =
match (report_kind, format_list) with
| Issues, _ :: _ ->
pp_json_issues format_list sorted_report
| _ ->
()
in
List.iter ~f:pp_report_by_report_kind formats_by_report_kind
| Error error ->
L.(die UserError) "Error reading '%s': %s" fname error
let pp_lint_issues_by_report_kind formats_by_report_kind error_filter linereader procname error_log let pp_lint_issues_by_report_kind formats_by_report_kind error_filter linereader procname error_log
= =
let pp_summary_by_report_kind (report_kind, format_list) = let pp_summary_by_report_kind (report_kind, format_list) =
@ -497,11 +384,7 @@ let mk_format format_kind fname =
~default:[] (Utils.create_outfile fname) ~default:[] (Utils.create_outfile fname)
let init_issues_format_list report_json = let init_issues_format_list report_json = mk_format Json report_json
let json_format = Option.value_map ~f:(mk_format Json) ~default:[] report_json in
let tests_format = Option.value_map ~f:(mk_format Tests) ~default:[] Config.issues_tests in
json_format @ tests_format
let init_files format_list_by_kind = let init_files format_list_by_kind =
let init_files_of_report_kind (report_kind, format_list) = let init_files_of_report_kind (report_kind, format_list) =
@ -513,8 +396,6 @@ let init_files format_list_by_kind =
| Json, Issues -> | Json, Issues ->
let outfile = get_outfile outfile_opt in let outfile = get_outfile outfile_opt in
IssuesJson.pp_open outfile.fmt () IssuesJson.pp_open outfile.fmt ()
| Json, Summary | Tests, _ ->
()
in in
List.iter ~f:init_files_of_format format_list List.iter ~f:init_files_of_format format_list
in in
@ -530,9 +411,7 @@ let finalize_and_close_files format_list_by_kind =
JsonCostsPrinter.pp_close outfile.fmt () JsonCostsPrinter.pp_close outfile.fmt ()
| Json, Issues -> | Json, Issues ->
let outfile = get_outfile outfile_opt in let outfile = get_outfile outfile_opt in
IssuesJson.pp_close outfile.fmt () IssuesJson.pp_close outfile.fmt () ) ;
| Json, Summary | Tests, _ ->
() ) ;
match outfile_opt with Some outfile -> Utils.close_outf outfile | None -> () match outfile_opt with Some outfile -> Utils.close_outf outfile | None -> ()
in in
List.iter ~f:close_files_of_format format_list ; List.iter ~f:close_files_of_format format_list ;
@ -568,21 +447,11 @@ let main ~report_json =
let issue_formats = init_issues_format_list report_json in let issue_formats = init_issues_format_list report_json in
let formats_by_report_kind = let formats_by_report_kind =
let costs_report_format_kind = let costs_report_format_kind =
match report_json with let file = Config.(results_dir ^/ costs_report_json) in
| Some _ ->
let file = Config.(results_dir ^/ Config.costs_report_json) in
[(Costs, mk_format Json file)] [(Costs, mk_format Json file)]
| None ->
[]
in in
costs_report_format_kind @ [(Issues, issue_formats); (Summary, [])] costs_report_format_kind @ [(Issues, issue_formats)]
in in
init_files formats_by_report_kind ; init_files formats_by_report_kind ;
( match Config.issues_tests with pp_summary_and_issues formats_by_report_kind issue_formats ;
| Some _ ->
pp_json_report_by_report_kind formats_by_report_kind Config.from_json_report
| None ->
pp_summary_and_issues formats_by_report_kind issue_formats ) ;
if Config.test_determinator && Config.process_clang_ast then
TestDeterminator.merge_test_determinator_results () ;
() ()

@ -7,9 +7,11 @@
open! IStd open! IStd
val potential_exception_message : string
val loc_trace_to_jsonbug_record : val loc_trace_to_jsonbug_record :
Errlog.loc_trace_elem list -> Exceptions.severity -> Jsonbug_t.json_trace_item list Errlog.loc_trace_elem list -> Exceptions.severity -> Jsonbug_t.json_trace_item list
val censored_reason : IssueType.t -> SourceFile.t -> string option val censored_reason : IssueType.t -> SourceFile.t -> string option
val main : report_json:string option -> unit val main : report_json:string -> unit

@ -6,6 +6,7 @@
*) *)
open! IStd open! IStd
module F = Format
module L = Logging module L = Logging
module CLOpt = CommandLineOption module CLOpt = CommandLineOption
@ -71,3 +72,9 @@ let delete pname =
(try Unix.unlink filename with Unix.Unix_error _ -> ()) ; (try Unix.unlink filename with Unix.Unix_error _ -> ()) ;
Ondemand.LocalCache.remove pname ; Ondemand.LocalCache.remove pname ;
Summary.OnDisk.remove_from_cache pname Summary.OnDisk.remove_from_cache pname
let pp_from_config fmt =
iter_from_config ~f:(fun summary ->
F.fprintf fmt "Procedure: %a@\n%a@." Procname.pp (Summary.get_proc_name summary)
Summary.pp_text summary )

@ -17,3 +17,5 @@ val iter_from_config : f:(Summary.t -> unit) -> unit
val delete : Procname.t -> unit val delete : Procname.t -> unit
(** Delete the .specs file associated with a summary and remove the summary from the caches in (** Delete the .specs file associated with a summary and remove the summary from the caches in
Summary.ml and ondemand.ml *) Summary.ml and ondemand.ml *)
val pp_from_config : Format.formatter -> unit

@ -30,24 +30,6 @@ let ml_bucket_symbols =
; ("unknown_origin", `MLeak_unknown) ] ; ("unknown_origin", `MLeak_unknown) ]
let issues_tests_fields_symbols =
[ ("bug_type", `Issue_field_bug_type)
; ("bucket", `Issue_field_bucket)
; ("qualifier", `Issue_field_qualifier)
; ("severity", `Issue_field_severity)
; ("line", `Issue_field_line)
; ("column", `Issue_field_column)
; ("procedure", `Issue_field_procedure)
; ("procedure_start_line", `Issue_field_procedure_start_line)
; ("file", `Issue_field_file)
; ("bug_trace", `Issue_field_bug_trace)
; ("key", `Issue_field_key)
; ("hash", `Issue_field_hash)
; ("line_offset", `Issue_field_line_offset)
; ( "qualifier_contains_potential_exception_note"
, `Issue_field_qualifier_contains_potential_exception_note ) ]
type os_type = Unix | Win32 | Cygwin type os_type = Unix | Win32 | Cygwin
type build_system = type build_system =
@ -1437,15 +1419,8 @@ and iphoneos_target_sdk_version_path_regex =
and issues_tests_fields = and issues_tests_fields =
CLOpt.mk_symbol_seq ~long:"issues-tests-fields" CLOpt.mk_symbol_seq ~long:"issues-tests-fields"
~in_help:InferCommand.[(Report, manual_generic)] ~in_help:InferCommand.[(Report, manual_generic)]
~default: ~default:IssuesTestField.[File; Procedure; LineOffset; BugType; Bucket; Severity; BugTrace]
[ `Issue_field_file ~symbols:IssuesTestField.all_symbols ~eq:IssuesTestField.equal
; `Issue_field_procedure
; `Issue_field_line_offset
; `Issue_field_bug_type
; `Issue_field_bucket
; `Issue_field_severity
; `Issue_field_bug_trace ]
~symbols:issues_tests_fields_symbols ~eq:PolyVariantEqual.( = )
"Fields to emit with $(b,--issues-tests)" "Fields to emit with $(b,--issues-tests)"

@ -387,22 +387,7 @@ val is_checker_enabled : Checker.t -> bool
val issues_tests : string option val issues_tests : string option
val issues_tests_fields : val issues_tests_fields : IssuesTestField.t list
[ `Issue_field_bug_type
| `Issue_field_qualifier
| `Issue_field_severity
| `Issue_field_bucket
| `Issue_field_line
| `Issue_field_column
| `Issue_field_procedure
| `Issue_field_procedure_start_line
| `Issue_field_file
| `Issue_field_bug_trace
| `Issue_field_key
| `Issue_field_hash
| `Issue_field_line_offset
| `Issue_field_qualifier_contains_potential_exception_note ]
list
val iterations : int val iterations : int

@ -0,0 +1,41 @@
(*
* Copyright (c) Facebook, Inc. and its affiliates.
*
* This source code is licensed under the MIT license found in the
* LICENSE file in the root directory of this source tree.
*)
open! IStd
type t =
| BugType
| Qualifier
| Severity
| Bucket
| Line
| Column
| Procedure
| ProcedureStartLine
| File
| BugTrace
| Key
| Hash
| LineOffset
| QualifierContainsPotentialExceptionNote
[@@deriving equal]
let all_symbols =
[ ("bug_type", BugType)
; ("bucket", Bucket)
; ("qualifier", Qualifier)
; ("severity", Severity)
; ("line", Line)
; ("column", Column)
; ("procedure", Procedure)
; ("procedure_start_line", ProcedureStartLine)
; ("file", File)
; ("bug_trace", BugTrace)
; ("key", Key)
; ("hash", Hash)
; ("line_offset", LineOffset)
; ("qualifier_contains_potential_exception_note", QualifierContainsPotentialExceptionNote) ]

@ -0,0 +1,27 @@
(*
* Copyright (c) Facebook, Inc. and its affiliates.
*
* This source code is licensed under the MIT license found in the
* LICENSE file in the root directory of this source tree.
*)
open! IStd
type t =
| BugType
| Qualifier
| Severity
| Bucket
| Line
| Column
| Procedure
| ProcedureStartLine
| File
| BugTrace
| Key
| Hash
| LineOffset
| QualifierContainsPotentialExceptionNote
[@@deriving equal]
val all_symbols : (string * t) list

@ -145,8 +145,13 @@ let () =
run Driver.Analyze run Driver.Analyze
| Capture | Compile | Run -> | Capture | Compile | Run ->
run (Lazy.force Driver.mode_from_command_line) run (Lazy.force Driver.mode_from_command_line)
| Report -> | Report -> (
InferPrint.main ~report_json:None match Config.issues_tests with
| None ->
if not Config.quiet then L.result "%t" SpecsFiles.pp_from_config
| Some out_path ->
IssuesTest.write_from_json ~json_path:Config.from_json_report ~out_path
Config.issues_tests_fields )
| ReportDiff -> | ReportDiff ->
(* at least one report must be passed in input to compute differential *) (* at least one report must be passed in input to compute differential *)
( match Config.(report_current, report_previous, costs_current, costs_previous) with ( match Config.(report_current, report_previous, costs_current, costs_previous) with

@ -321,7 +321,9 @@ let execute_analyze ~changed_files =
let report ?(suppress_console = false) () = let report ?(suppress_console = false) () =
let report_json = Config.(results_dir ^/ report_json) in let report_json = Config.(results_dir ^/ report_json) in
InferPrint.main ~report_json:(Some report_json) ; InferPrint.main ~report_json ;
if Config.(test_determinator && process_clang_ast) then
TestDeterminator.merge_test_determinator_results () ;
(* Post-process the report according to the user config. By default, calls report.py to create a (* Post-process the report according to the user config. By default, calls report.py to create a
human-readable report. human-readable report.

@ -0,0 +1,81 @@
(*
* Copyright (c) Facebook, Inc. and its affiliates.
*
* This source code is licensed under the MIT license found in the
* LICENSE file in the root directory of this source tree.
*)
open! IStd
module F = Format
let pp_custom_of_report fmt report fields =
let pp_custom_of_issue fmt (issue : Jsonbug_t.jsonbug) =
let open Jsonbug_t in
let comma_separator index = if index > 0 then ", " else "" in
let pp_trace fmt trace comma =
let pp_trace_elem fmt {description} = F.pp_print_string fmt description in
let trace_without_empty_descs =
List.filter ~f:(fun {description} -> not (String.is_empty description)) trace
in
F.fprintf fmt "%s[%a]" comma (Pp.comma_seq pp_trace_elem) trace_without_empty_descs
in
let pp_field index field =
match (field : IssuesTestField.t) with
| BugType ->
F.fprintf fmt "%s%s" (comma_separator index) issue.bug_type
| Bucket ->
let bucket =
match
String.lsplit2 issue.qualifier ~on:']'
|> Option.map ~f:fst
|> Option.bind ~f:(String.chop_prefix ~prefix:"[")
with
| Some bucket ->
bucket
| None ->
"no_bucket"
in
F.fprintf fmt "%s%s" (comma_separator index) bucket
| Qualifier ->
F.fprintf fmt "%s%s" (comma_separator index) issue.qualifier
| Severity ->
F.fprintf fmt "%s%s" (comma_separator index) issue.severity
| Line ->
F.fprintf fmt "%s%d" (comma_separator index) issue.line
| Column ->
F.fprintf fmt "%s%d" (comma_separator index) issue.column
| Procedure ->
F.fprintf fmt "%s%s" (comma_separator index) issue.procedure
| ProcedureStartLine ->
F.fprintf fmt "%s%d" (comma_separator index) issue.procedure_start_line
| File ->
F.fprintf fmt "%s%s" (comma_separator index) issue.file
| BugTrace ->
pp_trace fmt issue.bug_trace (comma_separator index)
| Key ->
F.fprintf fmt "%s%s" (comma_separator index) (Caml.Digest.to_hex issue.key)
| Hash ->
F.fprintf fmt "%s%s" (comma_separator index) (Caml.Digest.to_hex issue.hash)
| LineOffset ->
F.fprintf fmt "%s%d" (comma_separator index) (issue.line - issue.procedure_start_line)
| QualifierContainsPotentialExceptionNote ->
F.pp_print_bool fmt
(String.is_substring issue.qualifier ~substring:InferPrint.potential_exception_message)
in
List.iteri ~f:pp_field fields ; F.fprintf fmt "@."
in
List.iter ~f:(pp_custom_of_issue fmt) report
let tests_jsonbug_compare (bug1 : Jsonbug_t.jsonbug) (bug2 : Jsonbug_t.jsonbug) =
let open Jsonbug_t in
[%compare: string * string * int * string * Caml.Digest.t]
(bug1.file, bug1.procedure, bug1.line - bug1.procedure_start_line, bug1.bug_type, bug1.hash)
(bug2.file, bug2.procedure, bug2.line - bug2.procedure_start_line, bug2.bug_type, bug2.hash)
let write_from_json ~json_path ~out_path issues_tests_fields =
Utils.with_file_out out_path ~f:(fun outf ->
let report = Atdgen_runtime.Util.Json.from_file Jsonbug_j.read_report json_path in
let sorted_report = List.sort ~compare:tests_jsonbug_compare report in
pp_custom_of_report (F.formatter_of_out_channel outf) sorted_report issues_tests_fields )

@ -0,0 +1,10 @@
(*
* Copyright (c) Facebook, Inc. and its affiliates.
*
* This source code is licensed under the MIT license found in the
* LICENSE file in the root directory of this source tree.
*)
open! IStd
val write_from_json : json_path:string -> out_path:string -> IssuesTestField.t list -> unit
Loading…
Cancel
Save