diff --git a/infer/src/IR/Errlog.ml b/infer/src/IR/Errlog.ml index ce7b4f9c2..b4db2ddd0 100644 --- a/infer/src/IR/Errlog.ml +++ b/infer/src/IR/Errlog.ml @@ -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 "
%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; diff --git a/infer/src/IR/Errlog.mli b/infer/src/IR/Errlog.mli index af6db8d7e..dd93ecf5e 100644 --- a/infer/src/IR/Errlog.mli +++ b/infer/src/IR/Errlog.mli @@ -25,25 +25,39 @@ 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] +type t[@@deriving compare] (** Empty error log *) 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 diff --git a/infer/src/IR/Exceptions.ml b/infer/src/IR/Exceptions.ml index 2a8b85b61..01dc045d9 100644 --- a/infer/src/IR/Exceptions.ml +++ b/infer/src/IR/Exceptions.ml @@ -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" diff --git a/infer/src/IR/Exceptions.mli b/infer/src/IR/Exceptions.mli index b5ece3491..0b8a13e22 100644 --- a/infer/src/IR/Exceptions.mli +++ b/infer/src/IR/Exceptions.mli @@ -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, diff --git a/infer/src/backend/InferPrint.re b/infer/src/backend/InferPrint.re index 31b6f8ec0..0034df5d4 100644 --- a/infer/src/backend/InferPrint.re +++ b/infer/src/backend/InferPrint.re @@ -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 + | None => err_data.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 () + 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 diff --git a/infer/src/backend/printer.ml b/infer/src/backend/printer.ml index e29ecb12f..5228af03b 100644 --- a/infer/src/backend/printer.ml +++ b/infer/src/backend/printer.ml @@ -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