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

@ -25,25 +25,39 @@ val make_trace_element : int -> Location.t -> string -> (string * string) list -
(** Trace of locations *) (** Trace of locations *)
type loc_trace = loc_trace_elem list 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 of the error log *)
type t [@@deriving compare] type t[@@deriving compare]
(** Empty error log *) (** Empty error log *)
val empty : unit -> t val empty : unit -> t
(** type of the function to be passed to iter *) (** type of the function to be passed to iter *)
type iter_fun = type iter_fun = err_key -> err_data -> unit
(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
(** Apply f to nodes and error names *) (** Apply f to nodes and error names *)
val iter : iter_fun -> t -> unit 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 *) (** whether to print the bug key together with the error message *)
let print_key = false let print_key = false
(** pretty print an error given its (id,key), location, kind, name, description, and optional ml location *) (** pretty print an error *)
let pp_err (_, node_key) loc ekind ex_name desc ml_loc_opt fmt () = 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 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 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" 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 *) (** print a description of the exception to the html output *)
val print_exception_html : string -> exn -> unit val print_exception_html : string -> exn -> unit
(** pretty print an error given its (id,key), location, kind, name, description, (** pretty print an error *)
and optional ml location *) val pp_err : node_key:int -> Location.t -> err_kind -> Localise.t -> Localise.error_desc ->
val pp_err : int * int -> Location.t -> err_kind -> Localise.t -> Localise.error_desc ->
Logging.ml_loc option -> Format.formatter -> unit -> unit Logging.ml_loc option -> Format.formatter -> unit -> unit
(** Turn an exception into an error name, error description, (** Turn an exception into an error name, error description,

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

Loading…
Cancel
Save