diff --git a/infer/src/IR/Errlog.ml b/infer/src/IR/Errlog.ml index b4db2ddd0..55a1bb6b1 100644 --- a/infer/src/IR/Errlog.ml +++ b/infer/src/IR/Errlog.ml @@ -13,12 +13,18 @@ module Hashtbl = Caml.Hashtbl module L = Logging module F = Format +type node_tag = + | Condition of bool + | Exception of Typ.name + | Procedure_start of Typ.Procname.t + | Procedure_end of Typ.Procname.t + (** Element of a loc trace *) type loc_trace_elem = { lt_level : int; (** nesting level of procedure calls *) lt_loc : Location.t; (** source location at the current step in the trace *) lt_description : string; (** description of the current step in the trace *) - lt_node_tags : (string * string) list (** tags describing the node at the current location *) + lt_node_tags : node_tag list (** tags describing the node at the current location *) } let make_trace_element lt_level lt_loc lt_description lt_node_tags = diff --git a/infer/src/IR/Errlog.mli b/infer/src/IR/Errlog.mli index dd93ecf5e..e1acf4163 100644 --- a/infer/src/IR/Errlog.mli +++ b/infer/src/IR/Errlog.mli @@ -11,16 +11,22 @@ open! IStd (** Module for error logs. *) +type node_tag = + | Condition of bool + | Exception of Typ.name + | Procedure_start of Typ.Procname.t + | Procedure_end of Typ.Procname.t + (** Element of a loc trace *) type loc_trace_elem = private { lt_level : int; (** nesting level of procedure calls *) lt_loc : Location.t; (** source location at the current step in the trace *) lt_description : string; (** description of the current step in the trace *) - lt_node_tags : (string * string) list (** tags describing the node at the current location *) + lt_node_tags : node_tag list (** tags describing the node at the current location *) } (** build a loc_trace_elem from its constituents (unambiguously identified by their types). *) -val make_trace_element : int -> Location.t -> string -> (string * string) list -> loc_trace_elem +val make_trace_element : int -> Location.t -> string -> node_tag list -> loc_trace_elem (** Trace of locations *) type loc_trace = loc_trace_elem list diff --git a/infer/src/backend/InferPrint.re b/infer/src/backend/InferPrint.re index f17ac75f3..30c9d7f39 100644 --- a/infer/src/backend/InferPrint.re +++ b/infer/src/backend/InferPrint.re @@ -95,15 +95,37 @@ let loc_trace_to_jsonbug_record trace_list ekind => switch ekind { | Exceptions.Kinfo => [] | _ => - /* writes a trace as a record for atdgen conversion */ - let node_tags_to_records tags_list => - List.map f::(fun tag => {Jsonbug_j.tag: fst tag, value: snd tag}) tags_list; + let tag_value_records_of_node_tag nt => + switch nt { + | Errlog.Condition cond => [ + {Jsonbug_j.tag: Io_infer.Xml.tag_kind, value: "condition"}, + {Jsonbug_j.tag: Io_infer.Xml.tag_branch, value: Printf.sprintf "%B" cond} + ] + | Errlog.Exception exn_name => + let res = [{Jsonbug_j.tag: Io_infer.Xml.tag_kind, value: "exception"}]; + let exn_str = Typ.Name.name exn_name; + if (String.is_empty exn_str) { + res + } else { + [{Jsonbug_j.tag: Io_infer.Xml.tag_name, value: exn_str}, ...res] + } + | Errlog.Procedure_start pname => [ + {Jsonbug_j.tag: Io_infer.Xml.tag_kind, value: "procedure_start"}, + {Jsonbug_j.tag: Io_infer.Xml.tag_name, value: Typ.Procname.to_string pname}, + {Jsonbug_j.tag: Io_infer.Xml.tag_name_id, value: Typ.Procname.to_filename pname} + ] + | Errlog.Procedure_end pname => [ + {Jsonbug_j.tag: Io_infer.Xml.tag_kind, value: "procedure_end"}, + {Jsonbug_j.tag: Io_infer.Xml.tag_name, value: Typ.Procname.to_string pname}, + {Jsonbug_j.tag: Io_infer.Xml.tag_name_id, value: Typ.Procname.to_filename pname} + ] + }; let trace_item_to_record trace_item => { Jsonbug_j.level: trace_item.Errlog.lt_level, filename: SourceFile.to_string trace_item.Errlog.lt_loc.Location.file, line_number: trace_item.Errlog.lt_loc.Location.line, description: trace_item.Errlog.lt_description, - node_tags: node_tags_to_records trace_item.Errlog.lt_node_tags + node_tags: List.concat_map f::tag_value_records_of_node_tag trace_item.Errlog.lt_node_tags }; let record_list = List.rev (List.rev_map f::trace_item_to_record trace_list); record_list diff --git a/infer/src/backend/paths.ml b/infer/src/backend/paths.ml index 31bb75ea0..c3c74779f 100644 --- a/infer/src/backend/paths.ml +++ b/infer/src/backend/paths.ml @@ -466,13 +466,9 @@ end = struct match Procdesc.Node.get_kind curr_node with | Procdesc.Node.Join_node -> () (* omit join nodes from error traces *) | Procdesc.Node.Start_node pname -> - let name = Typ.Procname.to_string pname in - let name_id = Typ.Procname.to_filename pname in let descr = "start of procedure " ^ (Typ.Procname.to_simplified_string pname) in let node_tags = - [(Io_infer.Xml.tag_kind,"procedure_start"); - (Io_infer.Xml.tag_name, name); - (Io_infer.Xml.tag_name_id, name_id)] in + [Errlog.Procedure_start pname] in trace := Errlog.make_trace_element level curr_loc descr node_tags :: !trace | Procdesc.Node.Prune_node (is_true_branch, if_kind, _) -> let descr = match is_true_branch, if_kind with @@ -486,18 +482,11 @@ end = struct | false, Sil.Ik_switch -> "Switch condition is false. Skipping switch case" | true, (Sil.Ik_bexp | Sil.Ik_land_lor) -> "Condition is true" | false, (Sil.Ik_bexp | Sil.Ik_land_lor) -> "Condition is false" in - let node_tags = - [(Io_infer.Xml.tag_kind,"condition"); - (Io_infer.Xml.tag_branch, if is_true_branch then "true" else "false")] in + let node_tags = [Errlog.Condition is_true_branch] in trace := Errlog.make_trace_element level curr_loc descr node_tags :: !trace | Procdesc.Node.Exit_node pname -> let descr = "return from a call to " ^ (Typ.Procname.to_string pname) in - let name = Typ.Procname.to_string pname in - let name_id = Typ.Procname.to_filename pname in - let node_tags = - [(Io_infer.Xml.tag_kind,"procedure_end"); - (Io_infer.Xml.tag_name, name); - (Io_infer.Xml.tag_name_id, name_id)] in + let node_tags = [Errlog.Procedure_end pname] in trace := Errlog.make_trace_element level curr_loc descr node_tags :: !trace | _ -> let descr, node_tags = @@ -505,12 +494,9 @@ end = struct | None -> "", [] | Some exn_name -> let exn_str = Typ.Name.name exn_name in - if String.equal exn_str "" - then "exception", [(Io_infer.Xml.tag_kind,"exception")] - else - "exception " ^ exn_str, - [(Io_infer.Xml.tag_kind,"exception"); - (Io_infer.Xml.tag_name, exn_str)] in + let desc = + if String.is_empty exn_str then "exception" else "exception " ^ exn_str in + desc, [Errlog.Exception exn_name] in let descr = match get_description path with | Some path_descr ->