[IR] Convert err_data into a record for more clarity

Reviewed By: jvillard

Differential Revision: D4746675

fbshipit-source-id: f193efb
master
Dulma Churchill 8 years ago committed by Facebook Github Bot
parent 22c3c26359
commit e155e8ea46

@ -27,15 +27,33 @@ let make_trace_element lt_level lt_loc lt_description lt_node_tags =
(** Trace of locations *)
type loc_trace = loc_trace_elem list
type node_id_key = {
node_id : int;
node_key : int
}
type err_key = {
err_kind : Exceptions.err_kind;
in_footprint : bool;
err_name : Localise.t;
err_desc : Localise.error_desc;
severity : string
}[@@deriving compare]
(** Data associated to a specific error *)
type err_data =
(int * int) * int * Location.t * L.ml_loc option * loc_trace *
Exceptions.err_class * Exceptions.visibility * string option (* linters def file *)
type err_data = {
node_id_key : node_id_key;
session : int;
loc : Location.t;
loc_in_ml_source : L.ml_loc option;
loc_trace : loc_trace;
err_class : Exceptions.err_class;
visibility : Exceptions.visibility;
linters_def_file : string option
}
let compare_err_data
(_, _, loc1, _, _, _, _, _)
(_, _, loc2, _, _, _, _, _) =
Location.compare loc1 loc2
let compare_err_data err_data1 err_data2 =
Location.compare err_data1.loc err_data2.loc
module ErrDataSet = (* set err_data with no repeated loc *)
Caml.Set.Make(struct
@ -46,21 +64,18 @@ module ErrDataSet = (* set err_data with no repeated loc *)
(** Hash table to implement error logs *)
module ErrLogHash = struct
module Key = struct
type t = Exceptions.err_kind * bool * Localise.t * Localise.error_desc * string
[@@deriving compare]
type t = err_key[@@deriving compare]
(* NOTE: changing the hash function can change the order in which issues are reported. *)
let hash (ekind, in_footprint, err_name, desc, _) =
Hashtbl.hash (ekind, in_footprint, err_name, Localise.error_desc_hash desc)
let hash key =
Hashtbl.hash
(key.err_kind, key.in_footprint, key.err_name, Localise.error_desc_hash key.err_desc)
let equal
(ekind1, in_footprint1, err_name1, desc1, _)
(ekind2, in_footprint2, err_name2, desc2, _) =
let equal key1 key2 =
[%compare.equal : Exceptions.err_kind * bool * Localise.t]
(ekind1, in_footprint1, err_name1)
(ekind2, in_footprint2, err_name2) &&
Localise.error_desc_equal desc1 desc2
(key1.err_kind, key1.in_footprint, key1.err_name)
(key2.err_kind, key2.in_footprint, key2.err_name) &&
Localise.error_desc_equal key1.err_desc key2.err_desc
end
include Hashtbl.Make (Key)
@ -79,77 +94,69 @@ let compare x y =
let empty () = ErrLogHash.create 13
(** type of the function to be passed to iter *)
type iter_fun =
(int * int) ->
Location.t ->
L.ml_loc option ->
Exceptions.err_kind ->
bool ->
Localise.t -> Localise.error_desc -> string ->
loc_trace ->
Exceptions.err_class ->
Exceptions.visibility ->
string option ->
unit
type iter_fun = err_key -> err_data -> unit
(** Apply f to nodes and error names *)
let iter (f: iter_fun) (err_log: t) =
ErrLogHash.iter (fun (ekind, in_footprint, err_name, desc, severity) set ->
ErrDataSet.iter
(fun (node_id_key, _, loc, ml_loc_opt, ltr, eclass, visibility, linters_def_opt) ->
f
node_id_key loc ml_loc_opt ekind in_footprint err_name
desc severity ltr eclass visibility linters_def_opt)
set)
ErrLogHash.iter (fun err_key set ->
ErrDataSet.iter (fun err_data -> f err_key err_data) set)
err_log
let iter_filter (f: iter_fun) (err_log: t) =
ErrLogHash.iter (fun err_key set ->
ErrDataSet.iter (fun err_data -> f err_key err_data) set)
err_log
(** Return the number of elements in the error log which satisfy [filter] *)
let size filter (err_log: t) =
let count = ref 0 in
ErrLogHash.iter (fun (ekind, in_footprint, _, _, _) eds ->
if filter ekind in_footprint then count := !count + (ErrDataSet.cardinal eds)) err_log;
ErrLogHash.iter (fun key err_datas ->
if filter key.err_kind key.in_footprint
then count := !count + (ErrDataSet.cardinal err_datas)) err_log;
!count
(** Print errors from error log *)
let pp_errors fmt (errlog : t) =
let f (ekind, _, ename, _, _) _ =
if Exceptions.equal_err_kind ekind Exceptions.Kerror then
F.fprintf fmt "%a@ " Localise.pp ename in
let f key _ =
if Exceptions.equal_err_kind key.err_kind Exceptions.Kerror then
F.fprintf fmt "%a@ " Localise.pp key.err_name in
ErrLogHash.iter f errlog
(** Print warnings from error log *)
let pp_warnings fmt (errlog : t) =
let f (ekind, _, ename, desc, _) _ =
if Exceptions.equal_err_kind ekind Exceptions.Kwarning then
F.fprintf fmt "%a %a@ " Localise.pp ename Localise.pp_error_desc desc in
let f key _ =
if Exceptions.equal_err_kind key.err_kind Exceptions.Kwarning then
F.fprintf fmt "%a %a@ " Localise.pp key.err_name Localise.pp_error_desc key.err_desc in
ErrLogHash.iter f errlog
(** Print an error log in html format *)
let pp_html source path_to_root fmt (errlog: t) =
let pp_eds fmt eds =
let pp_eds fmt err_datas =
let pp_nodeid_session_loc
fmt ((nodeid, _), session, loc, _, _, _, _, _) =
Io_infer.Html.pp_session_link source path_to_root fmt (nodeid, session, loc.Location.line) in
ErrDataSet.iter (pp_nodeid_session_loc fmt) eds in
let f do_fp ek (ekind, infp, err_name, desc, _) eds =
if Exceptions.equal_err_kind ekind ek && Bool.equal do_fp infp
fmt err_data =
Io_infer.Html.pp_session_link
source path_to_root fmt
(err_data.node_id_key.node_id, err_data.session, err_data.loc.Location.line) in
ErrDataSet.iter (pp_nodeid_session_loc fmt) err_datas in
let pp_err_log do_fp ek key err_datas =
if Exceptions.equal_err_kind key.err_kind ek && Bool.equal do_fp key.in_footprint
then
F.fprintf fmt "<br>%a %a %a"
Localise.pp err_name
Localise.pp_error_desc desc
pp_eds eds in
Localise.pp key.err_name
Localise.pp_error_desc key.err_desc
pp_eds err_datas in
F.fprintf fmt "%aERRORS DURING FOOTPRINT@\n" Io_infer.Html.pp_hline ();
ErrLogHash.iter (f true Exceptions.Kerror) errlog;
ErrLogHash.iter (pp_err_log true Exceptions.Kerror) errlog;
F.fprintf fmt "%aERRORS DURING RE-EXECUTION@\n" Io_infer.Html.pp_hline ();
ErrLogHash.iter (f false Exceptions.Kerror) errlog;
ErrLogHash.iter (pp_err_log false Exceptions.Kerror) errlog;
F.fprintf fmt "%aWARNINGS DURING FOOTPRINT@\n" Io_infer.Html.pp_hline ();
ErrLogHash.iter (f true Exceptions.Kwarning) errlog;
ErrLogHash.iter (pp_err_log true Exceptions.Kwarning) errlog;
F.fprintf fmt "%aWARNINGS DURING RE-EXECUTION@\n" Io_infer.Html.pp_hline ();
ErrLogHash.iter (f false Exceptions.Kwarning) errlog;
ErrLogHash.iter (pp_err_log false Exceptions.Kwarning) errlog;
F.fprintf fmt "%aINFOS DURING FOOTPRINT@\n" Io_infer.Html.pp_hline ();
ErrLogHash.iter (f true Exceptions.Kinfo) errlog;
ErrLogHash.iter (pp_err_log true Exceptions.Kinfo) errlog;
F.fprintf fmt "%aINFOS DURING RE-EXECUTION@\n" Io_infer.Html.pp_hline ();
ErrLogHash.iter (f false Exceptions.Kinfo) errlog
ErrLogHash.iter (pp_err_log false Exceptions.Kinfo) errlog
(* I use string in case we want to display a different name to the user*)
@ -160,41 +167,39 @@ let severity_to_str severity = match severity with
(** Add an error description to the error log unless there is
one already at the same node + session; return true if added *)
let add_issue tbl (ekind, in_footprint, err_name, desc, severity) (eds: ErrDataSet.t) : bool =
let add_issue tbl err_key (err_datas: ErrDataSet.t) : bool =
try
let current_eds = ErrLogHash.find tbl (ekind, in_footprint, err_name, desc, severity) in
if ErrDataSet.subset eds current_eds then false
let current_eds = ErrLogHash.find tbl err_key in
if ErrDataSet.subset err_datas current_eds then false
else
begin
ErrLogHash.replace tbl
(ekind, in_footprint, err_name, desc, severity)
(ErrDataSet.union eds current_eds);
ErrLogHash.replace tbl err_key (ErrDataSet.union err_datas current_eds);
true
end
with Not_found ->
begin
ErrLogHash.add tbl (ekind, in_footprint, err_name, desc, severity) eds;
ErrLogHash.add tbl err_key err_datas;
true
end
(** Update an old error log with a new one *)
let update errlog_old errlog_new =
ErrLogHash.iter
(fun (ekind, infp, s, desc, severity) l ->
ignore (add_issue errlog_old (ekind, infp, s, desc, severity) l)) errlog_new
(fun err_key l ->
ignore (add_issue errlog_old err_key l)) errlog_new
let log_issue _ekind err_log loc node_id_key session ltr ?linters_def_file exn =
let err_name, desc, ml_loc_opt, visibility, severity, force_kind, eclass =
let log_issue err_kind err_log loc (node_id, node_key) session ltr ?linters_def_file exn =
let err_name, err_desc, ml_loc_opt, visibility, severity, force_kind, eclass =
Exceptions.recognize_exception exn in
let ekind = match force_kind with
| Some ekind -> ekind
| _ -> _ekind in
let err_kind = match force_kind with
| Some err_kind -> err_kind
| _ -> err_kind in
let hide_java_loc_zero = (* hide java errors at location zero unless in -developer_mode *)
not Config.developer_mode &&
Config.curr_language_is Config.Java &&
Int.equal loc.Location.line 0 in
let hide_memory_error =
match Localise.error_desc_get_bucket desc with
match Localise.error_desc_get_bucket err_desc with
| Some bucket when String.equal bucket Mleak_buckets.ml_bucket_unknown_origin ->
not Mleak_buckets.should_raise_leak_unknown_origin
| _ -> false in
@ -204,26 +209,41 @@ let log_issue _ekind err_log loc node_id_key session ltr ?linters_def_file exn =
Exceptions.equal_visibility visibility Exceptions.Exn_developer) in
if log_it && not hide_java_loc_zero && not hide_memory_error then begin
let added =
add_issue err_log
(ekind, !Config.footprint, err_name, desc, severity_to_str severity)
(ErrDataSet.singleton
(node_id_key, session, loc, ml_loc_opt, ltr, eclass, visibility,
linters_def_file)) in
let node_id_key = {node_id; node_key} in
let err_data = {
node_id_key;
session;
loc;
loc_in_ml_source = ml_loc_opt;
loc_trace = ltr;
err_class = eclass;
visibility;
linters_def_file;
} in
let err_key = {
err_kind;
in_footprint = !Config.footprint;
err_name;
err_desc;
severity = severity_to_str severity
} in
add_issue err_log err_key (ErrDataSet.singleton err_data) in
let should_print_now =
match exn with
| Exceptions.Internal_error _ -> true
| _ -> added in
let print_now () =
let ex_name, desc, ml_loc_opt, _, _, _, _ = Exceptions.recognize_exception exn in
L.err "@\n%a@\n@?" (Exceptions.pp_err node_id_key loc ekind ex_name desc ml_loc_opt) ();
if _ekind <> Exceptions.Kerror then begin
L.err "@\n%a@\n@?"
(Exceptions.pp_err ~node_key loc err_kind ex_name desc ml_loc_opt) ();
if err_kind <> Exceptions.Kerror then begin
let warn_str =
let pp fmt =
Format.fprintf fmt "%s %a"
(Localise.to_issue_id err_name)
Localise.pp_error_desc desc in
F.asprintf "%t" pp in
let d = match ekind with
let d = match err_kind with
| Exceptions.Kerror -> L.d_error
| Exceptions.Kwarning -> L.d_warning
| Exceptions.Kinfo | Exceptions.Kadvice -> L.d_info in
@ -251,9 +271,9 @@ module Err_table = struct
let err_string = Localise.to_issue_id err_name in
let count = try String.Map.find_exn !err_name_map err_string with Not_found -> 0 in
err_name_map := String.Map.add ~key:err_string ~data:(count + n) !err_name_map in
let count (ekind', in_footprint, err_name, _, _) eds =
if Exceptions.equal_err_kind ekind ekind' && in_footprint
then count_err err_name (ErrDataSet.cardinal eds) in
let count key err_datas =
if Exceptions.equal_err_kind ekind key.err_kind && key.in_footprint
then count_err key.err_name (ErrDataSet.cardinal err_datas) in
ErrLogHash.iter count err_table;
let pp ~key:err_string ~data:count = F.fprintf fmt " %s:%d" err_string count in
String.Map.iteri ~f:pp !err_name_map
@ -271,8 +291,8 @@ module Err_table = struct
let map_warn_re = ref LocMap.empty in
let map_info = ref LocMap.empty in
let map_advice = ref LocMap.empty in
let add_err nslm (ekind , in_fp, err_name, desc, _) =
let map = match in_fp, ekind with
let add_err nslm key =
let map = match key.in_footprint, key.err_kind with
| true, Exceptions.Kerror -> map_err_fp
| false, Exceptions.Kerror -> map_err_re
| true, Exceptions.Kwarning -> map_warn_fp
@ -281,16 +301,18 @@ module Err_table = struct
| _, Exceptions.Kadvice -> map_advice in
try
let err_list = LocMap.find nslm !map in
map := LocMap.add nslm ((err_name, desc) :: err_list) !map
map := LocMap.add nslm ((key.err_name, key.err_desc) :: err_list) !map
with Not_found ->
map := LocMap.add nslm [(err_name, desc)] !map in
map := LocMap.add nslm [(key.err_name, key.err_desc)] !map in
let f err_name eds =
ErrDataSet.iter (fun loc -> add_err loc err_name) eds in
ErrLogHash.iter f err_table;
let pp ekind (nodeidkey, _, loc, ml_loc_opt, _, _, _, _) fmt err_names =
let pp ekind err_data fmt err_names =
List.iter ~f:(fun (err_name, desc) ->
Exceptions.pp_err nodeidkey loc ekind err_name desc ml_loc_opt fmt ()) err_names in
Exceptions.pp_err
~node_key:err_data.node_id_key.node_key err_data.loc ekind err_name desc
err_data.loc_in_ml_source fmt ()) err_names in
F.fprintf fmt "@.Detailed errors during footprint phase:@.";
LocMap.iter (fun nslm err_names ->
F.fprintf fmt "%a" (pp Exceptions.Kerror nslm) err_names) !map_err_fp;

@ -25,6 +25,31 @@ val make_trace_element : int -> Location.t -> string -> (string * string) list -
(** Trace of locations *)
type loc_trace = loc_trace_elem list
type node_id_key = private {
node_id : int;
node_key : int
}
type err_key = private {
err_kind : Exceptions.err_kind;
in_footprint : bool;
err_name : Localise.t;
err_desc : Localise.error_desc;
severity : string
}[@@deriving compare]
(** Data associated to a specific error *)
type err_data = private {
node_id_key : node_id_key;
session : int;
loc : Location.t;
loc_in_ml_source : Logging.ml_loc option;
loc_trace : loc_trace;
err_class : Exceptions.err_class;
visibility : Exceptions.visibility;
linters_def_file : string option
}
(** Type of the error log *)
type t[@@deriving compare]
@ -32,18 +57,7 @@ type t [@@deriving compare]
val empty : unit -> t
(** type of the function to be passed to iter *)
type iter_fun =
(int * int) ->
Location.t ->
Logging.ml_loc option ->
Exceptions.err_kind ->
bool ->
Localise.t -> Localise.error_desc -> string ->
loc_trace ->
Exceptions.err_class ->
Exceptions.visibility ->
string option ->
unit
type iter_fun = err_key -> err_data -> unit
(** Apply f to nodes and error names *)
val iter : iter_fun -> t -> unit

@ -344,8 +344,8 @@ let err_class_string = function
(** whether to print the bug key together with the error message *)
let print_key = false
(** pretty print an error given its (id,key), location, kind, name, description, and optional ml location *)
let pp_err (_, node_key) loc ekind ex_name desc ml_loc_opt fmt () =
(** pretty print an error *)
let pp_err ~node_key loc ekind ex_name desc ml_loc_opt fmt () =
let kind = err_kind_string (if equal_err_kind ekind Kinfo then Kwarning else ekind) in
let pp_key fmt k = if print_key then F.fprintf fmt " key: %d " k else () in
F.fprintf fmt "%a:%d: %s: %a %a%a%a@\n"

@ -109,9 +109,8 @@ val handle_exception : exn -> bool
(** print a description of the exception to the html output *)
val print_exception_html : string -> exn -> unit
(** pretty print an error given its (id,key), location, kind, name, description,
and optional ml location *)
val pp_err : int * int -> Location.t -> err_kind -> Localise.t -> Localise.error_desc ->
(** pretty print an error *)
val pp_err : node_key:int -> Location.t -> err_kind -> Localise.t -> Localise.error_desc ->
Logging.ml_loc option -> Format.formatter -> unit -> unit
(** Turn an exception into an error name, error description,

@ -385,51 +385,59 @@ let module IssuesCsv = {
/** Write bug report in csv format */
let pp_issues_of_error_log fmt error_filter _ proc_loc_opt procname err_log => {
let pp x => F.fprintf fmt x;
let pp_row (_, node_key) loc _ ekind in_footprint error_name error_desc severity ltr eclass _ _ => {
let pp_row (key: Errlog.err_key) (err_data: Errlog.err_data) => {
let source_file =
switch proc_loc_opt {
| Some proc_loc => proc_loc.Location.file
| None => loc.Location.file
| None => err_data.loc.Location.file
};
if (
in_footprint &&
error_filter source_file error_desc error_name &&
should_report ekind error_name error_desc eclass && report_filter source_file
key.in_footprint &&
error_filter source_file key.err_desc key.err_name &&
should_report key.err_kind key.err_name key.err_desc err_data.err_class &&
report_filter source_file
) {
let err_desc_string = error_desc_to_csv_string error_desc;
let err_advice_string = error_advice_to_csv_string error_desc;
let err_desc_string = error_desc_to_csv_string key.err_desc;
let err_advice_string = error_advice_to_csv_string key.err_desc;
let qualifier_tag_xml = {
let xml_node =
Io_infer.Xml.create_tree
Io_infer.Xml.tag_qualifier_tags [] (error_desc_to_xml_tags error_desc);
Io_infer.Xml.tag_qualifier_tags [] (error_desc_to_xml_tags key.err_desc);
let p fmt => F.fprintf fmt "%a" (Io_infer.Xml.pp_document false) xml_node;
let s = F.asprintf "%t" p;
Escape.escape_csv s
};
let kind = Exceptions.err_kind_string ekind;
let type_str = Localise.to_issue_id error_name;
let kind = Exceptions.err_kind_string key.err_kind;
let type_str = Localise.to_issue_id key.err_name;
let procedure_id = Typ.Procname.to_filename procname;
let filename = SourceFile.to_string source_file;
let always_report =
switch (Localise.error_desc_extract_tag_value error_desc "always_report") {
switch (Localise.error_desc_extract_tag_value key.err_desc "always_report") {
| "" => "false"
| v => v
};
let trace = Jsonbug_j.string_of_json_trace {trace: loc_trace_to_jsonbug_record ltr ekind};
let trace = Jsonbug_j.string_of_json_trace {
trace: loc_trace_to_jsonbug_record err_data.loc_trace key.err_kind
};
incr csv_issues_id;
pp "%s," (Exceptions.err_class_string eclass);
pp "%s," (Exceptions.err_class_string err_data.err_class);
pp "%s," kind;
pp "%s," type_str;
pp "\"%s\"," err_desc_string;
pp "%s," severity;
pp "%d," loc.Location.line;
pp "%s," key.severity;
pp "%d," err_data.loc.Location.line;
pp "\"%s\"," (Escape.escape_csv (Typ.Procname.to_string procname));
pp "\"%s\"," (Escape.escape_csv procedure_id);
pp "%s," filename;
pp "\"%s\"," (Escape.escape_csv trace);
pp "\"%d\"," node_key;
pp "\"%d\"," err_data.node_id_key.node_key;
pp "\"%s\"," qualifier_tag_xml;
pp "\"%d\"," (get_bug_hash kind type_str procedure_id filename node_key error_desc);
pp
"\"%d\","
(
get_bug_hash
kind type_str procedure_id filename err_data.node_id_key.node_key key.err_desc
);
pp "\"%d\"," !csv_issues_id; /* bug id */
pp "\"%s\"," always_report;
pp "\"%s\"@\n" err_advice_string
@ -447,65 +455,55 @@ let module IssuesJson = {
/** Write bug report in JSON format */
let pp_issues_of_error_log fmt error_filter _ proc_loc_opt procname err_log => {
let pp x => F.fprintf fmt x;
let pp_row
(_, node_key)
loc
ml_loc_opt
ekind
in_footprint
error_name
error_desc
severity
ltr
eclass
visibility
linters_def_file => {
let pp_row (key: Errlog.err_key) (err_data: Errlog.err_data) => {
let (source_file, procedure_start_line) =
switch proc_loc_opt {
| Some proc_loc => (proc_loc.Location.file, proc_loc.Location.line)
| None => (loc.Location.file, 0)
| None => (err_data.loc.Location.file, 0)
};
let should_report_source_file =
not (SourceFile.is_infer_model source_file) ||
Config.debug_mode || Config.debug_exceptions;
if (
in_footprint &&
error_filter source_file error_desc error_name &&
key.in_footprint &&
error_filter source_file key.err_desc key.err_name &&
should_report_source_file &&
should_report ekind error_name error_desc eclass && report_filter source_file
should_report key.err_kind key.err_name key.err_desc err_data.err_class &&
report_filter source_file
) {
let kind = Exceptions.err_kind_string ekind;
let bug_type = Localise.to_issue_id error_name;
let kind = Exceptions.err_kind_string key.err_kind;
let bug_type = Localise.to_issue_id key.err_name;
let procedure_id = Typ.Procname.to_filename procname;
let file = SourceFile.to_string source_file;
let json_ml_loc =
switch ml_loc_opt {
switch err_data.loc_in_ml_source {
| Some (file, lnum, cnum, enum) when Config.reports_include_ml_loc =>
Some Jsonbug_j.{file, lnum, cnum, enum}
| _ => None
};
let visibility = Exceptions.string_of_visibility visibility;
let visibility = Exceptions.string_of_visibility err_data.visibility;
let bug = {
Jsonbug_j.bug_class: Exceptions.err_class_string eclass,
Jsonbug_j.bug_class: Exceptions.err_class_string err_data.err_class,
kind,
bug_type,
qualifier: error_desc_to_plain_string error_desc,
severity,
qualifier: error_desc_to_plain_string key.err_desc,
severity: key.severity,
visibility,
line: loc.Location.line,
column: loc.Location.col,
line: err_data.loc.Location.line,
column: err_data.loc.Location.col,
procedure: Typ.Procname.to_string procname,
procedure_id,
procedure_start_line,
file,
bug_trace: loc_trace_to_jsonbug_record ltr ekind,
key: node_key,
qualifier_tags: error_desc_to_qualifier_tags_records error_desc,
hash: get_bug_hash kind bug_type procedure_id file node_key error_desc,
dotty: error_desc_to_dotty_string error_desc,
bug_trace: loc_trace_to_jsonbug_record err_data.loc_trace key.err_kind,
key: err_data.node_id_key.node_key,
qualifier_tags: error_desc_to_qualifier_tags_records key.err_desc,
hash:
get_bug_hash kind bug_type procedure_id file err_data.node_id_key.node_key key.err_desc,
dotty: error_desc_to_dotty_string key.err_desc,
infer_source_loc: json_ml_loc,
bug_type_hum: Localise.to_human_readable_string error_name,
linters_def_file
bug_type_hum: Localise.to_human_readable_string key.err_name,
linters_def_file: err_data.linters_def_file
};
if (not !is_first_item) {
pp ","
@ -576,14 +574,22 @@ let module IssuesTxt = {
/** Write bug report in text format */
let pp_issues_of_error_log fmt error_filter _ proc_loc_opt _ err_log => {
let pp_row (node_id, node_key) loc _ ekind in_footprint error_name error_desc _ _ _ _ _ => {
let pp_row (key: Errlog.err_key) (err_data: Errlog.err_data) => {
let source_file =
switch proc_loc_opt {
| Some proc_loc => proc_loc.Location.file
| None => loc.Location.file
};
if (in_footprint && error_filter source_file error_desc error_name) {
Exceptions.pp_err (node_id, node_key) loc ekind error_name error_desc None fmt ()
| None => err_data.loc.Location.file
};
if (key.in_footprint && error_filter source_file key.err_desc key.err_name) {
Exceptions.pp_err
node_key::err_data.node_id_key.node_key
err_data.loc
key.err_kind
key.err_name
key.err_desc
None
fmt
()
}
};
Errlog.iter pp_row err_log
@ -645,41 +651,44 @@ let module IssuesXml = {
/** print issues from summary in xml */
let pp_issues_of_error_log fmt error_filter linereader proc_loc_opt proc_name err_log => {
let do_row (_, node_key) loc _ ekind in_footprint error_name error_desc severity ltr eclass _ _ => {
let do_row (key: Errlog.err_key) (err_data: Errlog.err_data) => {
let source_file =
switch proc_loc_opt {
| Some proc_loc => proc_loc.Location.file
| None => loc.Location.file
| None => err_data.loc.Location.file
};
if (in_footprint && error_filter source_file error_desc error_name) {
let err_desc_string = error_desc_to_xml_string error_desc;
if (key.in_footprint && error_filter source_file key.err_desc key.err_name) {
let err_desc_string = error_desc_to_xml_string key.err_desc;
let subtree label contents =>
Io_infer.Xml.create_tree label [] [Io_infer.Xml.String contents];
let kind = Exceptions.err_kind_string ekind;
let type_str = Localise.to_issue_id error_name;
let kind = Exceptions.err_kind_string key.err_kind;
let type_str = Localise.to_issue_id key.err_name;
let tree = {
incr xml_issues_id;
let attributes = [("id", string_of_int !xml_issues_id)];
let error_class = Exceptions.err_class_string eclass;
let error_line = string_of_int loc.Location.line;
let error_class = Exceptions.err_class_string err_data.err_class;
let error_line = string_of_int err_data.loc.Location.line;
let procedure_name = Typ.Procname.to_string proc_name;
let procedure_id = Typ.Procname.to_filename proc_name;
let filename = SourceFile.to_string source_file;
let bug_hash = get_bug_hash kind type_str procedure_id filename node_key error_desc;
let bug_hash =
get_bug_hash
kind type_str procedure_id filename err_data.node_id_key.node_key key.err_desc;
let forest = [
subtree Io_infer.Xml.tag_class error_class,
subtree Io_infer.Xml.tag_kind kind,
subtree Io_infer.Xml.tag_type type_str,
subtree Io_infer.Xml.tag_qualifier err_desc_string,
subtree Io_infer.Xml.tag_severity severity,
subtree Io_infer.Xml.tag_severity key.severity,
subtree Io_infer.Xml.tag_line error_line,
subtree Io_infer.Xml.tag_procedure (Escape.escape_xml procedure_name),
subtree Io_infer.Xml.tag_procedure_id (Escape.escape_xml procedure_id),
subtree Io_infer.Xml.tag_file filename,
Io_infer.Xml.create_tree Io_infer.Xml.tag_trace [] (loc_trace_to_xml linereader ltr),
subtree Io_infer.Xml.tag_key (string_of_int node_key),
Io_infer.Xml.create_tree
Io_infer.Xml.tag_qualifier_tags [] (error_desc_to_xml_tags error_desc),
Io_infer.Xml.tag_trace [] (loc_trace_to_xml linereader err_data.loc_trace),
subtree Io_infer.Xml.tag_key (string_of_int err_data.node_id_key.node_key),
Io_infer.Xml.create_tree
Io_infer.Xml.tag_qualifier_tags [] (error_desc_to_xml_tags key.err_desc),
subtree Io_infer.Xml.tag_hash (string_of_int bug_hash)
];
Io_infer.Xml.create_tree "bug" attributes forest
@ -786,21 +795,22 @@ let module Stats = {
};
let process_err_log error_filter linereader err_log stats => {
let found_errors = ref false;
let process_row _ loc _ ekind in_footprint error_name error_desc _ ltr _ _ _ => {
let type_str = Localise.to_issue_id error_name;
if (in_footprint && error_filter error_desc error_name) {
switch ekind {
let process_row (key: Errlog.err_key) (err_data: Errlog.err_data) => {
let type_str = Localise.to_issue_id key.err_name;
if (key.in_footprint && error_filter key.err_desc key.err_name) {
switch key.err_kind {
| Exceptions.Kerror =>
found_errors := true;
stats.nerrors = stats.nerrors + 1;
let error_strs = {
let pp1 fmt => F.fprintf fmt "%d: %s" stats.nerrors type_str;
let pp2 fmt =>
F.fprintf fmt " %a:%d" SourceFile.pp loc.Location.file loc.Location.line;
let pp3 fmt => F.fprintf fmt " (%a)" Localise.pp_error_desc error_desc;
F.fprintf
fmt " %a:%d" SourceFile.pp err_data.loc.Location.file err_data.loc.Location.line;
let pp3 fmt => F.fprintf fmt " (%a)" Localise.pp_error_desc key.err_desc;
[F.asprintf "%t" pp1, F.asprintf "%t" pp2, F.asprintf "%t" pp3]
};
let trace = loc_trace_to_string_list linereader 1 ltr;
let trace = loc_trace_to_string_list linereader 1 err_data.loc_trace;
stats.saved_errors = List.rev_append (error_strs @ trace @ [""]) stats.saved_errors
| Exceptions.Kwarning => stats.nwarnings = stats.nwarnings + 1
| Exceptions.Kinfo => stats.ninfos = stats.ninfos + 1

@ -453,16 +453,16 @@ let write_proc_html source pdesc =
(** Creare a hash table mapping line numbers to the set of errors occurring on that line *)
let create_table_err_per_line err_log =
let err_per_line = Hashtbl.create 17 in
let add_err _ loc _ _ _ err_name desc _ _ _ _ _ =
let add_err (key : Errlog.err_key) (err_data : Errlog.err_data) =
let err_str =
Localise.to_issue_id err_name ^
Localise.to_issue_id key.err_name ^
" " ^
(F.asprintf "%a" Localise.pp_error_desc desc) in
(F.asprintf "%a" Localise.pp_error_desc key.err_desc) in
try
let set = Hashtbl.find err_per_line loc.Location.line in
Hashtbl.replace err_per_line loc.Location.line (String.Set.add set err_str)
let set = Hashtbl.find err_per_line err_data.loc.Location.line in
Hashtbl.replace err_per_line err_data.loc.Location.line (String.Set.add set err_str)
with Not_found ->
Hashtbl.add err_per_line loc.Location.line (String.Set.singleton err_str) in
Hashtbl.add err_per_line err_data.loc.Location.line (String.Set.singleton err_str) in
Errlog.iter add_err err_log;
err_per_line

Loading…
Cancel
Save