You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
1210 lines
43 KiB
1210 lines
43 KiB
(*
|
|
* Copyright (c) 2009-2013, Monoidics ltd.
|
|
* 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 Hashtbl = Caml.Hashtbl
|
|
module L = Logging
|
|
module F = Format
|
|
|
|
let error_desc_to_plain_string error_desc =
|
|
let pp fmt = Localise.pp_error_desc fmt error_desc in
|
|
let s = F.asprintf "%t" pp in
|
|
let s = String.strip s in
|
|
let s =
|
|
(* end error description with a dot *)
|
|
if String.is_suffix ~suffix:"." s then s else s ^ "."
|
|
in
|
|
s
|
|
|
|
|
|
let error_desc_to_dotty_string error_desc = Localise.error_desc_get_dotty error_desc
|
|
|
|
let compute_key (bug_type : string) (proc_name : Typ.Procname.t) (filename : string) =
|
|
let base_filename = Filename.basename filename
|
|
and simple_procedure_name = Typ.Procname.get_method proc_name in
|
|
String.concat ~sep:"|" [base_filename; simple_procedure_name; bug_type]
|
|
|
|
|
|
let compute_hash ~(severity : string) ~(bug_type : string) ~(proc_name : Typ.Procname.t)
|
|
~(file : string) ~(qualifier : string) =
|
|
let base_filename = Filename.basename file in
|
|
let hashable_procedure_name = Typ.Procname.hashable_name proc_name in
|
|
let location_independent_qualifier =
|
|
(* Removing the line,column, and infer temporary variable (e.g., n$67) information from the
|
|
error message as well as the index of the annonymmous class to make the hash invariant
|
|
when moving the source code in the file *)
|
|
Str.global_replace (Str.regexp "\\(line \\|column \\|parameter \\|\\$\\)[0-9]+") "$_" qualifier
|
|
in
|
|
Utils.better_hash
|
|
(severity, bug_type, hashable_procedure_name, base_filename, location_independent_qualifier)
|
|
|> Caml.Digest.to_hex
|
|
|
|
|
|
let loc_trace_to_jsonbug_record trace_list ekind =
|
|
match ekind with
|
|
| Exceptions.Info ->
|
|
[]
|
|
| _ ->
|
|
let trace_item_to_record trace_item =
|
|
{ Jsonbug_j.level= trace_item.Errlog.lt_level
|
|
; filename= SourceFile.to_string trace_item.Errlog.lt_loc.Location.file
|
|
; line_number= trace_item.Errlog.lt_loc.Location.line
|
|
; column_number= trace_item.Errlog.lt_loc.Location.col
|
|
; description= trace_item.Errlog.lt_description }
|
|
in
|
|
let record_list = List.rev (List.rev_map ~f:trace_item_to_record trace_list) in
|
|
record_list
|
|
|
|
|
|
type summary_val =
|
|
{ vname: string
|
|
; vname_id: string
|
|
; vspecs: int
|
|
; vto: string
|
|
; vsymop: int
|
|
; verr: int
|
|
; vfile: string
|
|
; vline: int
|
|
; vsignature: string
|
|
; vproof_trace: string }
|
|
|
|
(** compute values from summary data to export to csv format *)
|
|
let summary_values summary =
|
|
let stats = summary.Summary.stats in
|
|
let attributes = Summary.get_attributes summary in
|
|
let err_log = Summary.get_err_log summary in
|
|
let proc_name = Summary.get_proc_name summary in
|
|
let vsignature = Summary.get_signature summary in
|
|
let specs = Tabulation.get_specs_from_payload summary in
|
|
let lines_visited =
|
|
let visited = ref BiabductionSummary.Visitedset.empty in
|
|
let do_spec spec =
|
|
visited := BiabductionSummary.Visitedset.union spec.BiabductionSummary.visited !visited
|
|
in
|
|
List.iter ~f:do_spec specs ;
|
|
let visited_lines = ref Int.Set.empty in
|
|
BiabductionSummary.Visitedset.iter
|
|
(fun (_, ls) -> List.iter ~f:(fun l -> visited_lines := Int.Set.add !visited_lines l) ls)
|
|
!visited ;
|
|
Int.Set.elements !visited_lines
|
|
in
|
|
let vproof_trace =
|
|
let pp_line fmt l = F.pp_print_int fmt l in
|
|
let pp fmt = Pp.seq pp_line fmt lines_visited in
|
|
F.asprintf "%t" pp
|
|
in
|
|
{ vname= Typ.Procname.to_string proc_name
|
|
; vname_id= Typ.Procname.to_filename proc_name
|
|
; vspecs= List.length specs
|
|
; vto= Summary.Stats.failure_kind_to_string stats
|
|
; vsymop= Summary.Stats.symops stats
|
|
; verr= Errlog.size (Exceptions.equal_severity Exceptions.Error) err_log
|
|
; vfile= SourceFile.to_string attributes.ProcAttributes.loc.Location.file
|
|
; vline= attributes.ProcAttributes.loc.Location.line
|
|
; vsignature
|
|
; vproof_trace }
|
|
|
|
|
|
module ProcsCsv = struct
|
|
(** Print the header of the procedures csv file, with column names *)
|
|
let pp_header fmt () =
|
|
Format.fprintf fmt "%s,%s,%s,%s,%s,%s,%s,%s,%s,%s,%s,%s,%s,%s,%s,%s,%s,%s@\n"
|
|
Io_infer.Xml.tag_name Io_infer.Xml.tag_name_id Io_infer.Xml.tag_specs Io_infer.Xml.tag_time
|
|
Io_infer.Xml.tag_to Io_infer.Xml.tag_symop Io_infer.Xml.tag_err Io_infer.Xml.tag_file
|
|
Io_infer.Xml.tag_line Io_infer.Xml.tag_loc Io_infer.Xml.tag_top Io_infer.Xml.tag_signature
|
|
Io_infer.Xml.tag_weight Io_infer.Xml.tag_proof_coverage Io_infer.Xml.tag_rank
|
|
Io_infer.Xml.tag_in_calls Io_infer.Xml.tag_out_calls Io_infer.Xml.tag_proof_trace
|
|
|
|
|
|
(** Write proc summary stats in csv format *)
|
|
let pp_summary fmt summary =
|
|
let pp x = F.fprintf fmt x in
|
|
let sv = summary_values summary in
|
|
pp "\"%s\"," (Escape.escape_csv sv.vname) ;
|
|
pp "\"%s\"," (Escape.escape_csv sv.vname_id) ;
|
|
pp "%d," sv.vspecs ;
|
|
pp "%s," sv.vto ;
|
|
pp "%d," sv.vsymop ;
|
|
pp "%d," sv.verr ;
|
|
pp "%s," sv.vfile ;
|
|
pp "%d," sv.vline ;
|
|
pp "\"%s\"," (Escape.escape_csv sv.vsignature) ;
|
|
pp "%s@\n" sv.vproof_trace
|
|
end
|
|
|
|
let should_report (issue_kind : Exceptions.severity) issue_type error_desc eclass =
|
|
if (not Config.filtering) || Exceptions.equal_err_class eclass Exceptions.Linters then true
|
|
else
|
|
let issue_kind_is_blacklisted =
|
|
match issue_kind with Info -> true | Advice | Error | Like | Warning -> false
|
|
in
|
|
if issue_kind_is_blacklisted then false
|
|
else
|
|
let issue_type_is_null_deref =
|
|
let null_deref_issue_types =
|
|
let open IssueType in
|
|
[ field_not_null_checked
|
|
; null_dereference
|
|
; parameter_not_null_checked
|
|
; premature_nil_termination
|
|
; empty_vector_access
|
|
; biabd_use_after_free ]
|
|
in
|
|
List.mem ~equal:IssueType.equal null_deref_issue_types issue_type
|
|
in
|
|
if issue_type_is_null_deref then Localise.error_desc_is_reportable_bucket error_desc else true
|
|
|
|
|
|
(* The reason an issue should be censored (that is, not reported). The empty
|
|
string (that is "no reason") means that the issue should be reported. *)
|
|
let censored_reason (issue_type : IssueType.t) source_file =
|
|
let filename = SourceFile.to_rel_path source_file in
|
|
let rejected_by ((issue_type_polarity, issue_type_re), (filename_polarity, filename_re), reason) =
|
|
let accepted =
|
|
(* matches issue_type_re implies matches filename_re *)
|
|
(not (Bool.equal issue_type_polarity (Str.string_match issue_type_re issue_type.unique_id 0)))
|
|
|| Bool.equal filename_polarity (Str.string_match filename_re filename 0)
|
|
in
|
|
Option.some_if (not accepted) reason
|
|
in
|
|
List.find_map Config.censor_report ~f:rejected_by
|
|
|
|
|
|
let potential_exception_message = "potential exception at line"
|
|
|
|
module type Printer = sig
|
|
type elt
|
|
|
|
val pp_open : F.formatter -> unit -> unit
|
|
|
|
val pp_close : F.formatter -> unit -> unit
|
|
|
|
val pp : F.formatter -> elt -> unit
|
|
end
|
|
|
|
module MakeJsonListPrinter (P : sig
|
|
type elt
|
|
|
|
val to_string : elt -> string option
|
|
end) : Printer with type elt = P.elt = struct
|
|
include P
|
|
|
|
let is_first_item = ref true
|
|
|
|
let pp_open fmt () =
|
|
is_first_item := true ;
|
|
F.fprintf fmt "[@?"
|
|
|
|
|
|
let pp_close fmt () = F.fprintf fmt "]@\n@?"
|
|
|
|
let pp fmt elt =
|
|
match to_string elt with
|
|
| Some s ->
|
|
if !is_first_item then is_first_item := false else F.pp_print_char fmt ',' ;
|
|
F.fprintf fmt "%s@?" s
|
|
| None ->
|
|
()
|
|
end
|
|
|
|
type json_issue_printer_typ =
|
|
{ error_filter: SourceFile.t -> IssueType.t -> bool
|
|
; proc_name: Typ.Procname.t
|
|
; proc_loc_opt: Location.t option
|
|
; err_key: Errlog.err_key
|
|
; err_data: Errlog.err_data }
|
|
|
|
let procedure_id_of_procname proc_name =
|
|
match Typ.Procname.get_language proc_name with
|
|
| Language.Java ->
|
|
Typ.Procname.to_unique_id proc_name
|
|
| _ ->
|
|
Typ.Procname.to_string proc_name
|
|
|
|
|
|
module JsonIssuePrinter = MakeJsonListPrinter (struct
|
|
type elt = json_issue_printer_typ
|
|
|
|
let to_string ({error_filter; proc_name; proc_loc_opt; err_key; err_data} : elt) =
|
|
let source_file, procedure_start_line =
|
|
match proc_loc_opt with
|
|
| Some proc_loc ->
|
|
(proc_loc.Location.file, proc_loc.Location.line)
|
|
| None ->
|
|
(err_data.loc.Location.file, 0)
|
|
in
|
|
if SourceFile.is_invalid source_file then
|
|
L.(die InternalError)
|
|
"Invalid source file for %a %a@.Trace: %a@." IssueType.pp err_key.err_name
|
|
Localise.pp_error_desc err_key.err_desc Errlog.pp_loc_trace err_data.loc_trace ;
|
|
let should_report_source_file =
|
|
(not (SourceFile.is_biabduction_model source_file))
|
|
|| Config.debug_mode || Config.debug_exceptions
|
|
in
|
|
if
|
|
error_filter source_file err_key.err_name
|
|
&& should_report_source_file
|
|
&& should_report err_key.severity err_key.err_name err_key.err_desc err_data.err_class
|
|
then
|
|
let severity = Exceptions.severity_string err_key.severity in
|
|
let bug_type = err_key.err_name.IssueType.unique_id in
|
|
let file =
|
|
SourceFile.to_string ~force_relative:Config.report_force_relative_path source_file
|
|
in
|
|
let json_ml_loc =
|
|
match err_data.loc_in_ml_source with
|
|
| Some (file, lnum, cnum, enum) when Config.reports_include_ml_loc ->
|
|
Some Jsonbug_j.{file; lnum; cnum; enum}
|
|
| _ ->
|
|
None
|
|
in
|
|
let qualifier =
|
|
let base_qualifier = error_desc_to_plain_string err_key.err_desc in
|
|
if IssueType.(equal resource_leak) err_key.err_name then
|
|
match Errlog.compute_local_exception_line err_data.loc_trace with
|
|
| None ->
|
|
base_qualifier
|
|
| Some line ->
|
|
let potential_exception_message =
|
|
Format.asprintf "%a: %s %d" MarkupFormatter.pp_bold "Note"
|
|
potential_exception_message line
|
|
in
|
|
Format.sprintf "%s@\n%s" base_qualifier potential_exception_message
|
|
else base_qualifier
|
|
in
|
|
let bug =
|
|
{ Jsonbug_j.bug_type
|
|
; qualifier
|
|
; severity
|
|
; line= err_data.loc.Location.line
|
|
; column= err_data.loc.Location.col
|
|
; procedure= procedure_id_of_procname proc_name
|
|
; procedure_start_line
|
|
; file
|
|
; bug_trace= loc_trace_to_jsonbug_record err_data.loc_trace err_key.severity
|
|
; node_key= Option.map ~f:Procdesc.NodeKey.to_string err_data.node_key
|
|
; key= compute_key bug_type proc_name file
|
|
; hash= compute_hash ~severity ~bug_type ~proc_name ~file ~qualifier
|
|
; dotty= error_desc_to_dotty_string err_key.err_desc
|
|
; infer_source_loc= json_ml_loc
|
|
; bug_type_hum= err_key.err_name.IssueType.hum
|
|
; linters_def_file= err_data.linters_def_file
|
|
; doc_url= err_data.doc_url
|
|
; traceview_id= None
|
|
; censored_reason= censored_reason err_key.err_name source_file
|
|
; access= err_data.access
|
|
; extras= err_data.extras }
|
|
in
|
|
Some (Jsonbug_j.string_of_jsonbug bug)
|
|
else None
|
|
end)
|
|
|
|
module IssuesJson = struct
|
|
include JsonIssuePrinter
|
|
|
|
(** Write bug report in JSON format *)
|
|
let pp_issues_of_error_log fmt error_filter _ proc_loc_opt proc_name err_log =
|
|
Errlog.iter
|
|
(fun err_key err_data -> pp fmt {error_filter; proc_name; proc_loc_opt; err_key; err_data})
|
|
err_log
|
|
end
|
|
|
|
type json_costs_printer_typ =
|
|
{loc: Location.t; proc_name: Typ.Procname.t; cost_opt: CostDomain.summary option}
|
|
|
|
module JsonCostsPrinter = MakeJsonListPrinter (struct
|
|
type elt = json_costs_printer_typ
|
|
|
|
let to_string {loc; proc_name; cost_opt} =
|
|
match cost_opt with
|
|
| Some {post; is_on_ui_thread} when not (Typ.Procname.is_java_access_method proc_name) ->
|
|
let hum cost =
|
|
let degree_with_term = CostDomain.BasicCost.get_degree_with_term cost in
|
|
{ Jsonbug_t.hum_polynomial= Format.asprintf "%a" CostDomain.BasicCost.pp_hum cost
|
|
; hum_degree=
|
|
Format.asprintf "%a"
|
|
(CostDomain.BasicCost.pp_degree ~only_bigO:false)
|
|
degree_with_term
|
|
; big_o=
|
|
Format.asprintf "%a" (CostDomain.BasicCost.pp_degree ~only_bigO:true) degree_with_term
|
|
}
|
|
in
|
|
let cost_info cost =
|
|
{ Jsonbug_t.polynomial_version= CostDomain.BasicCost.version
|
|
; polynomial= CostDomain.BasicCost.encode cost
|
|
; degree=
|
|
Option.map (CostDomain.BasicCost.degree cost) ~f:Polynomials.Degree.encode_to_int
|
|
; hum= hum cost }
|
|
in
|
|
let cost_item =
|
|
let file = SourceFile.to_rel_path loc.Location.file in
|
|
{ Jsonbug_t.hash= compute_hash ~severity:"" ~bug_type:"" ~proc_name ~file ~qualifier:""
|
|
; loc= {file; lnum= loc.Location.line; cnum= loc.Location.col; enum= -1}
|
|
; procedure_name= Typ.Procname.get_method proc_name
|
|
; procedure_id= procedure_id_of_procname proc_name
|
|
; is_on_ui_thread
|
|
; exec_cost= cost_info (CostDomain.get_cost_kind CostKind.OperationCost post)
|
|
; alloc_cost= cost_info (CostDomain.get_cost_kind CostKind.AllocationCost post) }
|
|
in
|
|
Some (Jsonbug_j.string_of_cost_item cost_item)
|
|
| _ ->
|
|
None
|
|
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} -> 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)
|
|
|
|
|
|
module IssuesTxt = struct
|
|
let pp_issue fmt error_filter proc_loc_opt (key : Errlog.err_key) (err_data : Errlog.err_data) =
|
|
let source_file =
|
|
match proc_loc_opt with
|
|
| Some proc_loc ->
|
|
proc_loc.Location.file
|
|
| None ->
|
|
err_data.loc.Location.file
|
|
in
|
|
if
|
|
error_filter source_file key.err_name
|
|
&& ((not Config.filtering) || Option.is_none (censored_reason key.err_name source_file))
|
|
then Exceptions.pp_err err_data.loc key.severity key.err_name key.err_desc None fmt ()
|
|
|
|
|
|
(** Write bug report in text format *)
|
|
let pp_issues_of_error_log fmt error_filter _ proc_loc_opt _ err_log =
|
|
Errlog.iter (pp_issue fmt error_filter proc_loc_opt) err_log
|
|
end
|
|
|
|
let pp_text_of_report fmt report =
|
|
let pp_row jsonbug =
|
|
let open Jsonbug_t in
|
|
F.fprintf fmt "%s:%d: %s: %s %s@\n" jsonbug.file jsonbug.line jsonbug.severity jsonbug.bug_type
|
|
jsonbug.qualifier
|
|
in
|
|
List.iter ~f:pp_row report ; F.fprintf fmt "@?"
|
|
|
|
|
|
module Stats = struct
|
|
type t =
|
|
{ files: (SourceFile.t, unit) Hashtbl.t
|
|
; mutable nchecked: int
|
|
; mutable ndefective: int
|
|
; mutable nerrors: int
|
|
; mutable ninfos: int
|
|
; mutable nadvice: int
|
|
; mutable nlikes: int
|
|
; mutable nprocs: int
|
|
; mutable nspecs: int
|
|
; mutable ntimeouts: int
|
|
; mutable nverified: int
|
|
; mutable nwarnings: int
|
|
; mutable saved_errors: string list }
|
|
|
|
let create () =
|
|
{ files= Hashtbl.create 3
|
|
; nchecked= 0
|
|
; ndefective= 0
|
|
; nerrors= 0
|
|
; ninfos= 0
|
|
; nadvice= 0
|
|
; nlikes= 0
|
|
; nprocs= 0
|
|
; nspecs= 0
|
|
; ntimeouts= 0
|
|
; nverified= 0
|
|
; nwarnings= 0
|
|
; saved_errors= [] }
|
|
|
|
|
|
let process_loc loc stats =
|
|
try Hashtbl.find stats.files loc.Location.file
|
|
with Caml.Not_found -> Hashtbl.add stats.files loc.Location.file ()
|
|
|
|
|
|
let loc_trace_to_string_list linereader indent_num ltr =
|
|
let res = ref [] in
|
|
let indent_string n =
|
|
let s = ref "" in
|
|
for _ = 1 to n do
|
|
s := " " ^ !s
|
|
done ;
|
|
!s
|
|
in
|
|
let num = ref 0 in
|
|
let loc_to_string lt =
|
|
incr num ;
|
|
let loc = lt.Errlog.lt_loc in
|
|
let level = lt.Errlog.lt_level in
|
|
let description = lt.Errlog.lt_description in
|
|
let code = match Printer.LineReader.from_loc linereader loc with Some s -> s | None -> "" in
|
|
let line =
|
|
let pp fmt =
|
|
if description <> "" then
|
|
F.fprintf fmt "%s%4s // %s@\n" (indent_string (level + indent_num)) " " description ;
|
|
F.fprintf fmt "%s%04d: %s" (indent_string (level + indent_num)) loc.Location.line code
|
|
in
|
|
F.asprintf "%t" pp
|
|
in
|
|
res := line :: "" :: !res
|
|
in
|
|
List.iter ~f:loc_to_string ltr ; List.rev !res
|
|
|
|
|
|
let process_err_log error_filter linereader err_log stats =
|
|
let found_errors = ref false in
|
|
let process_row (key : Errlog.err_key) (err_data : Errlog.err_data) =
|
|
let type_str = key.err_name.IssueType.unique_id in
|
|
if error_filter key.err_name then
|
|
match key.severity with
|
|
| Exceptions.Error ->
|
|
found_errors := true ;
|
|
stats.nerrors <- stats.nerrors + 1 ;
|
|
let error_strs =
|
|
let pp1 fmt = F.fprintf fmt "%d: %s" stats.nerrors type_str in
|
|
let pp2 fmt =
|
|
F.fprintf fmt " %a:%d" SourceFile.pp err_data.loc.Location.file
|
|
err_data.loc.Location.line
|
|
in
|
|
let pp3 fmt = F.fprintf fmt " (%a)" Localise.pp_error_desc key.err_desc in
|
|
[F.asprintf "%t" pp1; F.asprintf "%t" pp2; F.asprintf "%t" pp3]
|
|
in
|
|
let trace = loc_trace_to_string_list linereader 1 err_data.loc_trace in
|
|
stats.saved_errors <- List.rev_append (error_strs @ trace @ [""]) stats.saved_errors
|
|
| Exceptions.Warning ->
|
|
stats.nwarnings <- stats.nwarnings + 1
|
|
| Exceptions.Info ->
|
|
stats.ninfos <- stats.ninfos + 1
|
|
| Exceptions.Advice ->
|
|
stats.nadvice <- stats.nadvice + 1
|
|
| Exceptions.Like ->
|
|
stats.nlikes <- stats.nlikes + 1
|
|
in
|
|
Errlog.iter process_row err_log ; !found_errors
|
|
|
|
|
|
let process_summary error_filter summary linereader stats =
|
|
let specs = Tabulation.get_specs_from_payload summary in
|
|
let found_errors =
|
|
process_err_log error_filter linereader (Summary.get_err_log summary) stats
|
|
in
|
|
let is_defective = found_errors in
|
|
let is_verified = specs <> [] && not is_defective in
|
|
let is_checked = not (is_defective || is_verified) in
|
|
let is_timeout =
|
|
match Summary.(Stats.failure_kind summary.stats) with
|
|
| None | Some (FKcrash _) ->
|
|
false
|
|
| _ ->
|
|
true
|
|
in
|
|
stats.nprocs <- stats.nprocs + 1 ;
|
|
stats.nspecs <- stats.nspecs + List.length specs ;
|
|
if is_verified then stats.nverified <- stats.nverified + 1 ;
|
|
if is_checked then stats.nchecked <- stats.nchecked + 1 ;
|
|
if is_timeout then stats.ntimeouts <- stats.ntimeouts + 1 ;
|
|
if is_defective then stats.ndefective <- stats.ndefective + 1 ;
|
|
process_loc (Summary.get_loc summary) stats
|
|
|
|
|
|
let num_files stats = Hashtbl.length stats.files
|
|
|
|
let pp fmt stats =
|
|
F.fprintf fmt "Files: %d@\n" (num_files stats) ;
|
|
F.fprintf fmt "Specs: %d@\n" stats.nspecs ;
|
|
F.fprintf fmt "Timeouts: %d@\n" stats.ntimeouts ;
|
|
F.fprintf fmt "Procedures: %d@\n" stats.nprocs ;
|
|
F.fprintf fmt " Verified: %d@\n" stats.nverified ;
|
|
F.fprintf fmt " Checked: %d@\n" stats.nchecked ;
|
|
F.fprintf fmt " Defective: %d@\n" stats.ndefective ;
|
|
F.fprintf fmt "Errors: %d@\n" stats.nerrors ;
|
|
F.fprintf fmt "Warnings: %d@\n" stats.nwarnings ;
|
|
F.fprintf fmt "Infos: %d@\n" stats.ninfos ;
|
|
F.fprintf fmt "@\n -------------------@\n" ;
|
|
F.fprintf fmt "@\nDetailed Errors@\n@\n" ;
|
|
List.iter ~f:(fun s -> F.fprintf fmt "%s@\n" s) (List.rev stats.saved_errors)
|
|
end
|
|
|
|
module StatsLogs = struct
|
|
let process _ (summary : Summary.t) _ _ =
|
|
let num_preposts =
|
|
match summary.payloads.biabduction with Some {preposts} -> List.length preposts | None -> 0
|
|
in
|
|
let clang_method_kind =
|
|
ClangMethodKind.to_string (Summary.get_attributes summary).clang_method_kind
|
|
in
|
|
let proc_name = Summary.get_proc_name summary in
|
|
let lang = Typ.Procname.get_language proc_name in
|
|
let stats =
|
|
EventLogger.AnalysisStats
|
|
{ analysis_nodes_visited= Summary.Stats.nb_visited summary.stats
|
|
; analysis_status= Summary.Stats.failure_kind summary.stats
|
|
; analysis_total_nodes= Summary.get_proc_desc summary |> Procdesc.get_nodes_num
|
|
; clang_method_kind= (match lang with Language.Clang -> Some clang_method_kind | _ -> None)
|
|
; lang= Language.to_explicit_string lang
|
|
; method_location= Summary.get_loc summary
|
|
; method_name= Typ.Procname.to_string proc_name
|
|
; num_preposts
|
|
; symops= Summary.Stats.symops summary.stats }
|
|
in
|
|
EventLogger.log stats
|
|
end
|
|
|
|
module Report = struct
|
|
let pp_header fmt () =
|
|
F.fprintf fmt "Infer Analysis Results -- generated %a@\n@\n" Pp.current_time () ;
|
|
F.fprintf fmt "Summary Report@\n@\n"
|
|
|
|
|
|
let pp_stats fmt stats = Stats.pp fmt stats
|
|
end
|
|
|
|
(** Categorize the preconditions of specs and print stats *)
|
|
module PreconditionStats = struct
|
|
let nr_nopres = ref 0
|
|
|
|
let nr_empty = ref 0
|
|
|
|
let nr_onlyallocation = ref 0
|
|
|
|
let nr_dataconstraints = ref 0
|
|
|
|
let do_summary proc_name summary =
|
|
let specs = Tabulation.get_specs_from_payload summary in
|
|
let preconditions =
|
|
List.map ~f:(fun spec -> BiabductionSummary.Jprop.to_prop spec.BiabductionSummary.pre) specs
|
|
in
|
|
match Prop.CategorizePreconditions.categorize preconditions with
|
|
| Prop.CategorizePreconditions.Empty ->
|
|
incr nr_empty ;
|
|
L.result "Procedure: %a footprint:Empty@." Typ.Procname.pp proc_name
|
|
| Prop.CategorizePreconditions.OnlyAllocation ->
|
|
incr nr_onlyallocation ;
|
|
L.result "Procedure: %a footprint:OnlyAllocation@." Typ.Procname.pp proc_name
|
|
| Prop.CategorizePreconditions.NoPres ->
|
|
incr nr_nopres ;
|
|
L.result "Procedure: %a footprint:NoPres@." Typ.Procname.pp proc_name
|
|
| Prop.CategorizePreconditions.DataConstraints ->
|
|
incr nr_dataconstraints ;
|
|
L.result "Procedure: %a footprint:DataConstraints@." Typ.Procname.pp proc_name
|
|
|
|
|
|
let pp_stats () =
|
|
L.result "@.Precondition stats@." ;
|
|
L.result "Procedures with no preconditions: %d@." !nr_nopres ;
|
|
L.result "Procedures with empty precondition: %d@." !nr_empty ;
|
|
L.result "Procedures with only allocation conditions: %d@." !nr_onlyallocation ;
|
|
L.result "Procedures with data constraints: %d@." !nr_dataconstraints
|
|
end
|
|
|
|
module SummaryStats = struct
|
|
module MetricTypes = struct
|
|
type 't typ = Bool : bool typ | Int : int typ
|
|
end
|
|
|
|
module MakeTopN (V : PrettyPrintable.PrintableOrderedType) = struct
|
|
type 'k t = {capacity: int; filter: V.t -> bool; size: int; sorted_elements: (V.t * 'k) list}
|
|
|
|
let make capacity ~filter = {capacity; filter; size= 0; sorted_elements= []}
|
|
|
|
let add top k v =
|
|
if top.filter v then
|
|
let smaller, greater =
|
|
List.split_while top.sorted_elements ~f:(fun (v', _) -> V.compare v v' > 0)
|
|
in
|
|
if top.size >= top.capacity then
|
|
match smaller with
|
|
| [] ->
|
|
top
|
|
| _ :: tl ->
|
|
let sorted_elements = tl @ ((v, k) :: greater) in
|
|
{top with sorted_elements}
|
|
else
|
|
let sorted_elements = smaller @ ((v, k) :: greater) in
|
|
{top with size= top.size + 1; sorted_elements}
|
|
else top
|
|
|
|
|
|
let is_empty top = top.size <= 0
|
|
|
|
let pp ~pp_k f top =
|
|
if top.size > 0 then
|
|
let pp1 f (v, k) = F.fprintf f "@[%a -> %a@]" V.pp v pp_k k in
|
|
Pp.seq pp1 f (List.rev top.sorted_elements)
|
|
end
|
|
|
|
module IntTopN = MakeTopN (Int)
|
|
|
|
module MetricAggregator = struct
|
|
open MetricTypes
|
|
|
|
type ('i, 'k) t =
|
|
| A :
|
|
{ name: string
|
|
; value: 'o
|
|
; is_empty: 'o -> bool
|
|
; add: 'o -> 'k -> 'i -> 'o
|
|
; pp: pp_k:(F.formatter -> 'k -> unit) -> F.formatter -> 'o -> unit }
|
|
-> ('i, 'k) t
|
|
|
|
let add (A aggr) k i = A {aggr with value= aggr.add aggr.value k i}
|
|
|
|
let pp ~pp_k f (A {name; pp; value; is_empty}) =
|
|
if not (is_empty value) then F.fprintf f "@[%s: @[%a@]@]" name (pp ~pp_k) value
|
|
|
|
|
|
let no_k pp ~pp_k:_ = pp
|
|
|
|
let int name add = A {name; value= 0; is_empty= Int.(( = ) 0); add; pp= no_k F.pp_print_int}
|
|
|
|
let int_sum = int "sum" (fun acc _ v -> acc + v)
|
|
|
|
let int_top3 =
|
|
A
|
|
{ name= "top3"
|
|
; value= IntTopN.make 3 ~filter:(fun x -> x > 1)
|
|
; is_empty= IntTopN.is_empty
|
|
; add= IntTopN.add
|
|
; pp= IntTopN.pp }
|
|
|
|
|
|
let true_count = int "True" (fun acc _ b -> if b then acc + 1 else acc)
|
|
|
|
let false_count = int "False" (fun acc _ b -> if b then acc else acc + 1)
|
|
|
|
type 'k get = {get: 'i. 'i typ -> ('i, 'k) t list}
|
|
|
|
let aggregators =
|
|
let get : type i. i typ -> (i, _) t list = function
|
|
| Bool ->
|
|
[true_count; false_count]
|
|
| Int ->
|
|
[int_sum; int_top3]
|
|
in
|
|
{get}
|
|
|
|
|
|
let get aggregators typ = aggregators.get typ
|
|
end
|
|
|
|
module Metrics = struct
|
|
open MetricTypes
|
|
|
|
type 'i metric = M : {get: 'i -> 't; typ: 't typ} -> 'i metric
|
|
|
|
let for_fields poly_fields obj_metrics =
|
|
PolyFields.map poly_fields
|
|
{ f=
|
|
(fun field_name field_get ->
|
|
let prefix = field_name ^ ":" in
|
|
List.map obj_metrics ~f:(fun (metric_name, M {typ; get= metric_get}) ->
|
|
let name = prefix ^ metric_name in
|
|
let get r = r |> field_get |> Obj.repr |> metric_get in
|
|
(name, M {typ; get}) ) ) }
|
|
|> List.concat
|
|
end
|
|
|
|
module ObjMetrics = struct
|
|
open MetricTypes
|
|
open Metrics
|
|
|
|
let obj_is_zero = phys_equal (Obj.repr 0)
|
|
|
|
let obj_marshaled_size x = String.length (Marshal.to_string x []) - Marshal.header_size
|
|
|
|
let metrics =
|
|
let bool name get = (name, M {typ= Bool; get}) in
|
|
let int name get = (name, M {typ= Int; get}) in
|
|
[ int "reachable_words" Obj.reachable_words
|
|
; int "marshaled size" obj_marshaled_size
|
|
; bool "is_zero" obj_is_zero ]
|
|
end
|
|
|
|
module MetricResults = struct
|
|
open MetricTypes
|
|
open Metrics
|
|
module StringMap = PrettyPrintable.MakePPMap (String)
|
|
|
|
type ('i, 'k) result =
|
|
| R : {typ: 't typ; get: 'i -> 't; aggrs: ('t, 'k) MetricAggregator.t list} -> ('i, 'k) result
|
|
|
|
let init metrics aggregators =
|
|
List.fold metrics ~init:StringMap.empty ~f:(fun acc (name, M {typ; get}) ->
|
|
StringMap.add name (R {typ; get; aggrs= MetricAggregator.get aggregators typ}) acc )
|
|
|
|
|
|
let add results k x =
|
|
StringMap.map
|
|
(fun (R res) ->
|
|
let v = res.get x in
|
|
R {res with aggrs= List.map res.aggrs ~f:(fun aggr -> MetricAggregator.add aggr k v)} )
|
|
results
|
|
|
|
|
|
let pp ~pp_k f results =
|
|
let pp_value f (R {aggrs}) = Pp.seq (MetricAggregator.pp ~pp_k) f aggrs in
|
|
StringMap.pp ~pp_value f results
|
|
end
|
|
|
|
let results =
|
|
let summary_fields_obj_metrics = Metrics.for_fields Summary.poly_fields ObjMetrics.metrics in
|
|
let init = MetricResults.init summary_fields_obj_metrics MetricAggregator.aggregators in
|
|
ref init
|
|
|
|
|
|
let do_summary proc_name summary = results := MetricResults.add !results proc_name summary
|
|
|
|
let pp_stats () = L.result "%a@\n" (MetricResults.pp ~pp_k:Typ.Procname.pp) !results
|
|
end
|
|
|
|
let error_filter filters proc_name file error_name =
|
|
(Config.write_html || not (IssueType.(equal skip_function) error_name))
|
|
&& filters.Inferconfig.path_filter file
|
|
&& filters.Inferconfig.error_filter error_name
|
|
&& filters.Inferconfig.proc_filter proc_name
|
|
|
|
|
|
type report_kind = Costs | Issues | Procs | Stats | Summary [@@deriving compare]
|
|
|
|
let _string_of_report_kind = function
|
|
| Costs ->
|
|
"Costs"
|
|
| Issues ->
|
|
"Issues"
|
|
| Procs ->
|
|
"Procs"
|
|
| Stats ->
|
|
"Stats"
|
|
| Summary ->
|
|
"Summary"
|
|
|
|
|
|
type bug_format_kind = Json | Csv | Logs | Tests | Text [@@deriving compare]
|
|
|
|
let _string_of_bug_format_kind = function
|
|
| Json ->
|
|
"Json"
|
|
| Csv ->
|
|
"Csv"
|
|
| Logs ->
|
|
"Logs"
|
|
| Tests ->
|
|
"Tests"
|
|
| Text ->
|
|
"Text"
|
|
|
|
|
|
let get_outfile outfile =
|
|
match outfile with
|
|
| Some outfile ->
|
|
outfile
|
|
| None ->
|
|
L.(die InternalError) "An outfile is require for this format."
|
|
|
|
|
|
let pp_issue_in_format (format_kind, (outfile_opt : Utils.outfile option)) error_filter
|
|
{Issue.proc_name; proc_location; err_key; err_data} =
|
|
match format_kind with
|
|
| Json ->
|
|
let outf = get_outfile outfile_opt in
|
|
IssuesJson.pp outf.fmt
|
|
{error_filter; proc_name; proc_loc_opt= Some proc_location; err_key; err_data}
|
|
| Csv ->
|
|
L.(die InternalError) "Printing issues in a CSV format is not implemented"
|
|
| Tests ->
|
|
L.(die InternalError) "Printing issues as tests is not implemented"
|
|
| Logs ->
|
|
L.(die InternalError) "Printing issues as logs is not implemented"
|
|
| Text ->
|
|
let outf = get_outfile outfile_opt in
|
|
IssuesTxt.pp_issue outf.fmt error_filter (Some proc_location) err_key err_data
|
|
|
|
|
|
let pp_issues_in_format (format_kind, (outfile_opt : Utils.outfile option)) =
|
|
match format_kind with
|
|
| Json ->
|
|
let outf = get_outfile outfile_opt in
|
|
IssuesJson.pp_issues_of_error_log outf.fmt
|
|
| Csv ->
|
|
L.(die InternalError) "Printing issues in a CSV format is not implemented"
|
|
| Tests ->
|
|
L.(die InternalError) "Printing issues as tests is not implemented"
|
|
| Logs ->
|
|
L.(die InternalError) "Printing issues as logs is not implemented"
|
|
| Text ->
|
|
let outf = get_outfile outfile_opt in
|
|
IssuesTxt.pp_issues_of_error_log outf.fmt
|
|
|
|
|
|
let pp_procs_in_format (format_kind, (outfile_opt : Utils.outfile option)) =
|
|
match format_kind with
|
|
| Csv ->
|
|
let outf = get_outfile outfile_opt in
|
|
ProcsCsv.pp_summary outf.fmt
|
|
| Json | Tests | Text | Logs ->
|
|
L.(die InternalError) "Printing procs in json/tests/text/logs is not implemented"
|
|
|
|
|
|
let pp_stats_in_format (format_kind, _) =
|
|
match format_kind with
|
|
| Csv ->
|
|
Stats.process_summary
|
|
| Logs ->
|
|
StatsLogs.process
|
|
| Json | Tests | Text ->
|
|
L.(die InternalError) "Printing stats in json/tests/text is not implemented"
|
|
|
|
|
|
let pp_issues_of_error_log error_filter linereader proc_loc_opt procname err_log bug_format_list =
|
|
let pp_issues_in_format format =
|
|
pp_issues_in_format format error_filter linereader proc_loc_opt procname err_log
|
|
in
|
|
List.iter ~f:pp_issues_in_format bug_format_list
|
|
|
|
|
|
let collect_issues summary issues_acc =
|
|
let err_log = Summary.get_err_log summary in
|
|
let proc_name = Summary.get_proc_name summary in
|
|
let proc_location = Summary.get_loc summary in
|
|
Errlog.fold
|
|
(fun err_key err_data acc -> {Issue.proc_name; proc_location; err_key; err_data} :: acc)
|
|
err_log issues_acc
|
|
|
|
|
|
let pp_procs summary procs_format_list =
|
|
let pp_procs_in_format format =
|
|
let pp_procs = pp_procs_in_format format in
|
|
pp_procs summary
|
|
in
|
|
List.iter ~f:pp_procs_in_format procs_format_list
|
|
|
|
|
|
let pp_stats error_filter linereader summary stats stats_format_list =
|
|
let pp_stats_in_format format =
|
|
let pp_stats = pp_stats_in_format format in
|
|
pp_stats error_filter summary linereader stats
|
|
in
|
|
List.iter ~f:pp_stats_in_format stats_format_list
|
|
|
|
|
|
let pp_summary summary =
|
|
L.result "Procedure: %a@\n%a@." Typ.Procname.pp (Summary.get_proc_name summary) Summary.pp_text
|
|
summary
|
|
|
|
|
|
let pp_costs_in_format (format_kind, (outfile_opt : Utils.outfile option)) =
|
|
match format_kind with
|
|
| Json ->
|
|
let outf = get_outfile outfile_opt in
|
|
JsonCostsPrinter.pp outf.fmt
|
|
| Csv | Tests | Text | Logs ->
|
|
L.(die InternalError) "Printing costs in csv/tests/text/logs is not implemented"
|
|
|
|
|
|
let pp_costs summary costs_format_list =
|
|
let pp format =
|
|
pp_costs_in_format format
|
|
{ loc= Summary.get_loc summary
|
|
; proc_name= Summary.get_proc_name summary
|
|
; cost_opt= summary.Summary.payloads.Payloads.cost }
|
|
in
|
|
List.iter ~f:pp costs_format_list
|
|
|
|
|
|
let pp_summary_by_report_kind formats_by_report_kind summary error_filter linereader stats file
|
|
issues_acc =
|
|
let pp_summary_by_report_kind (report_kind, format_list) =
|
|
match (report_kind, format_list) with
|
|
| Costs, _ ->
|
|
pp_costs summary format_list
|
|
| Procs, _ :: _ ->
|
|
pp_procs summary format_list
|
|
| Stats, _ :: _ ->
|
|
pp_stats (error_filter file) linereader summary stats format_list
|
|
| Summary, _ when InferCommand.equal Config.command Report && not Config.quiet ->
|
|
pp_summary summary
|
|
| _ ->
|
|
()
|
|
in
|
|
List.iter ~f:pp_summary_by_report_kind formats_by_report_kind ;
|
|
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_fields
|
|
| Text ->
|
|
let outf = get_outfile outfile_opt in
|
|
pp_text_of_report outf.fmt report
|
|
| Json ->
|
|
L.(die InternalError) "Printing issues from json does not support json output"
|
|
| Csv ->
|
|
L.(die InternalError) "Printing issues from json does not support csv output"
|
|
| Logs ->
|
|
L.(die InternalError) "Printing issues from json does not support logs 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_summary_by_report_kind (report_kind, format_list) =
|
|
match (report_kind, format_list) with
|
|
| Issues, _ :: _ ->
|
|
pp_issues_of_error_log error_filter linereader None procname error_log format_list
|
|
| _ ->
|
|
()
|
|
in
|
|
List.iter ~f:pp_summary_by_report_kind formats_by_report_kind
|
|
|
|
|
|
(** Process lint issues of a procedure *)
|
|
let pp_lint_issues filters formats_by_report_kind linereader procname error_log =
|
|
let error_filter = error_filter filters procname in
|
|
pp_lint_issues_by_report_kind formats_by_report_kind error_filter linereader procname error_log
|
|
|
|
|
|
(** Process a summary *)
|
|
let process_summary filters formats_by_report_kind linereader stats summary issues_acc =
|
|
let file = (Summary.get_loc summary).Location.file in
|
|
let proc_name = Summary.get_proc_name summary in
|
|
let error_filter = error_filter filters proc_name in
|
|
let issues_acc' =
|
|
pp_summary_by_report_kind formats_by_report_kind summary error_filter linereader stats file
|
|
issues_acc
|
|
in
|
|
if Config.precondition_stats then PreconditionStats.do_summary proc_name summary ;
|
|
if Config.summary_stats then SummaryStats.do_summary proc_name summary ;
|
|
issues_acc'
|
|
|
|
|
|
(** Although the out_file is an Option type, the None option is strictly meant for the
|
|
logs format_kind, and all other formats should contain an outfile value. *)
|
|
let mk_format format_kind fname =
|
|
Option.value_map
|
|
~f:(fun out_file -> [(format_kind, Some out_file)])
|
|
~default:[] (Utils.create_outfile fname)
|
|
|
|
|
|
let init_issues_format_list 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
|
|
let txt_format = Option.value_map ~f:(mk_format Text) ~default:[] Config.issues_txt in
|
|
json_format @ tests_format @ txt_format
|
|
|
|
|
|
let init_procs_format_list () = Option.value_map ~f:(mk_format Csv) ~default:[] Config.procs_csv
|
|
|
|
let init_stats_format_list () =
|
|
let csv_format = Option.value_map ~f:(mk_format Csv) ~default:[] Config.stats_report in
|
|
let logs_format = if Config.log_events then [(Logs, None)] else [] in
|
|
csv_format @ logs_format
|
|
|
|
|
|
let init_files format_list_by_kind =
|
|
let init_files_of_report_kind (report_kind, format_list) =
|
|
let init_files_of_format (format_kind, (outfile_opt : Utils.outfile option)) =
|
|
match (format_kind, report_kind) with
|
|
| Csv, Issues ->
|
|
L.(die InternalError) "Printing issues in a CSV format is not implemented"
|
|
| Logs, (Issues | Procs | Summary) ->
|
|
L.(die InternalError) "Logging these reports is not implemented"
|
|
| Csv, Procs ->
|
|
let outfile = get_outfile outfile_opt in
|
|
ProcsCsv.pp_header outfile.fmt ()
|
|
| Csv, Stats ->
|
|
let outfile = get_outfile outfile_opt in
|
|
Report.pp_header outfile.fmt ()
|
|
| Json, Costs ->
|
|
let outfile = get_outfile outfile_opt in
|
|
JsonCostsPrinter.pp_open outfile.fmt ()
|
|
| Json, Issues ->
|
|
let outfile = get_outfile outfile_opt in
|
|
IssuesJson.pp_open outfile.fmt ()
|
|
| Csv, (Costs | Summary)
|
|
| Logs, (Costs | Stats)
|
|
| Json, (Procs | Stats | Summary)
|
|
| Tests, _
|
|
| Text, _ ->
|
|
()
|
|
in
|
|
List.iter ~f:init_files_of_format format_list
|
|
in
|
|
List.iter ~f:init_files_of_report_kind format_list_by_kind
|
|
|
|
|
|
let finalize_and_close_files format_list_by_kind (stats : Stats.t) =
|
|
let close_files_of_report_kind (report_kind, format_list) =
|
|
let close_files_of_format (format_kind, (outfile_opt : Utils.outfile option)) =
|
|
( match (format_kind, report_kind) with
|
|
| Logs, (Issues | Procs | Summary) ->
|
|
L.(die InternalError) "Logging these reports is not implemented"
|
|
| Csv, Stats ->
|
|
let outfile = get_outfile outfile_opt in
|
|
F.fprintf outfile.fmt "%a@?" Report.pp_stats stats
|
|
| Json, Costs ->
|
|
let outfile = get_outfile outfile_opt in
|
|
JsonCostsPrinter.pp_close outfile.fmt ()
|
|
| Json, Issues ->
|
|
let outfile = get_outfile outfile_opt in
|
|
IssuesJson.pp_close outfile.fmt ()
|
|
| Csv, (Costs | Issues | Procs | Summary)
|
|
| Logs, (Costs | Stats)
|
|
| Json, (Procs | Stats | Summary)
|
|
| Tests, _
|
|
| Text, _ ->
|
|
() ) ;
|
|
match outfile_opt with Some outfile -> Utils.close_outf outfile | None -> ()
|
|
in
|
|
List.iter ~f:close_files_of_format format_list ;
|
|
()
|
|
in
|
|
List.iter ~f:close_files_of_report_kind format_list_by_kind
|
|
|
|
|
|
let pp_summary_and_issues formats_by_report_kind issue_formats =
|
|
let stats = Stats.create () in
|
|
let linereader = Printer.LineReader.create () in
|
|
let filters = Inferconfig.create_filters () in
|
|
let all_issues = ref [] in
|
|
SpecsFiles.iter_from_config ~f:(fun summary ->
|
|
all_issues :=
|
|
process_summary filters formats_by_report_kind linereader stats summary !all_issues ) ;
|
|
all_issues := Issue.sort_filter_issues !all_issues ;
|
|
if Config.quandaryBO then all_issues := QuandaryBO.update_issues !all_issues ;
|
|
List.iter
|
|
~f:(fun ({Issue.proc_name} as issue) ->
|
|
let error_filter = error_filter filters proc_name in
|
|
List.iter
|
|
~f:(fun issue_format -> pp_issue_in_format issue_format error_filter issue)
|
|
issue_formats )
|
|
!all_issues ;
|
|
if Config.precondition_stats then PreconditionStats.pp_stats () ;
|
|
if Config.summary_stats then SummaryStats.pp_stats () ;
|
|
List.iter
|
|
[Config.lint_issues_dir_name; Config.starvation_issues_dir_name; Config.racerd_issues_dir_name]
|
|
~f:(fun dir_name ->
|
|
IssueLog.load dir_name
|
|
|> IssueLog.iter ~f:(pp_lint_issues filters formats_by_report_kind linereader) ) ;
|
|
finalize_and_close_files formats_by_report_kind stats
|
|
|
|
|
|
let register_perf_stats_report () =
|
|
let rtime_span, initial_times = (Mtime_clock.counter (), Unix.times ()) in
|
|
PerfStats.register_report (PerfStats.Time (rtime_span, initial_times)) PerfStats.Reporting
|
|
|
|
|
|
let main ~report_json =
|
|
let issue_formats = init_issues_format_list report_json in
|
|
let formats_by_report_kind =
|
|
let costs_report_format_kind =
|
|
match report_json with
|
|
| Some _ ->
|
|
let file = Config.(results_dir ^/ Config.costs_report_json) in
|
|
[(Costs, mk_format Json file)]
|
|
| None ->
|
|
[]
|
|
in
|
|
costs_report_format_kind
|
|
@ [ (Issues, issue_formats)
|
|
; (Procs, init_procs_format_list ())
|
|
; (Stats, init_stats_format_list ())
|
|
; (Summary, []) ]
|
|
in
|
|
register_perf_stats_report () ;
|
|
init_files formats_by_report_kind ;
|
|
( match Config.from_json_report with
|
|
| Some fname ->
|
|
pp_json_report_by_report_kind formats_by_report_kind fname
|
|
| 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 () ;
|
|
PerfStats.get_reporter PerfStats.Reporting ()
|