Add variant type to traces' node_tags

Reviewed By: jvillard

Differential Revision: D4913326

fbshipit-source-id: 06a26e4

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 =

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

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

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 ->