[refactoring] add make_trace_element to Errlog

Summary:
It was defined in two places and I'm about to add a third, so let's share
instead.

Reviewed By: sblackshear

Differential Revision: D4153420

fbshipit-source-id: 3d2c519
master
Jules Villard 8 years ago committed by Facebook Github Bot
parent 25c9d8ae49
commit caf9537305

@ -20,6 +20,10 @@ type loc_trace_elem = {
lt_node_tags : (string * string) list (** tags describing the node at the current location *) lt_node_tags : (string * string) list (** tags describing the node at the current location *)
} }
let make_trace_element lt_level lt_loc lt_description lt_node_tags =
{ 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

@ -12,13 +12,16 @@ open! Utils
(** Module for error logs. *) (** Module for error logs. *)
(** Element of a loc trace *) (** Element of a loc trace *)
type loc_trace_elem = { type loc_trace_elem = private {
lt_level : int; (** nesting level of procedure calls *) lt_level : int; (** nesting level of procedure calls *)
lt_loc : Location.t; (** source location at the current step in the trace *) 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_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 : (string * string) 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
(** Trace of locations *) (** Trace of locations *)
type loc_trace = loc_trace_elem list type loc_trace = loc_trace_elem list

@ -445,11 +445,6 @@ end = struct
let create_loc_trace path pos_opt : Errlog.loc_trace = let create_loc_trace path pos_opt : Errlog.loc_trace =
let trace = ref [] in let trace = ref [] in
let mk_trace_elem level loc descr node_tags =
{ Errlog.lt_level = level;
Errlog.lt_loc = loc;
Errlog.lt_description = descr;
Errlog.lt_node_tags = node_tags } in
let g level path _ exn_opt = let g level path _ exn_opt =
match curr_node path with match curr_node path with
| Some curr_node -> | Some curr_node ->
@ -465,7 +460,7 @@ end = struct
[(Io_infer.Xml.tag_kind,"procedure_start"); [(Io_infer.Xml.tag_kind,"procedure_start");
(Io_infer.Xml.tag_name, name); (Io_infer.Xml.tag_name, name);
(Io_infer.Xml.tag_name_id, name_id)] in (Io_infer.Xml.tag_name_id, name_id)] in
trace := mk_trace_elem level curr_loc descr node_tags :: !trace trace := Errlog.make_trace_element level curr_loc descr node_tags :: !trace
| Procdesc.Node.Prune_node (is_true_branch, if_kind, _) -> | Procdesc.Node.Prune_node (is_true_branch, if_kind, _) ->
let descr = match is_true_branch, if_kind with let descr = match is_true_branch, if_kind with
| true, Sil.Ik_if -> "Taking true branch" | true, Sil.Ik_if -> "Taking true branch"
@ -481,7 +476,7 @@ end = struct
let node_tags = let node_tags =
[(Io_infer.Xml.tag_kind,"condition"); [(Io_infer.Xml.tag_kind,"condition");
(Io_infer.Xml.tag_branch, if is_true_branch then "true" else "false")] in (Io_infer.Xml.tag_branch, if is_true_branch then "true" else "false")] in
trace := mk_trace_elem level curr_loc descr node_tags :: !trace trace := Errlog.make_trace_element level curr_loc descr node_tags :: !trace
| Procdesc.Node.Exit_node pname -> | Procdesc.Node.Exit_node pname ->
let descr = "return from a call to " ^ (Procname.to_string pname) in let descr = "return from a call to " ^ (Procname.to_string pname) in
let name = Procname.to_string pname in let name = Procname.to_string pname in
@ -490,7 +485,7 @@ end = struct
[(Io_infer.Xml.tag_kind,"procedure_end"); [(Io_infer.Xml.tag_kind,"procedure_end");
(Io_infer.Xml.tag_name, name); (Io_infer.Xml.tag_name, name);
(Io_infer.Xml.tag_name_id, name_id)] in (Io_infer.Xml.tag_name_id, name_id)] in
trace := mk_trace_elem level curr_loc descr node_tags :: !trace trace := Errlog.make_trace_element level curr_loc descr node_tags :: !trace
| _ -> | _ ->
let descr, node_tags = let descr, node_tags =
match exn_opt with match exn_opt with
@ -508,7 +503,7 @@ end = struct
| Some path_descr -> | Some path_descr ->
if String.length descr > 0 then descr^" "^path_descr else path_descr if String.length descr > 0 then descr^" "^path_descr else path_descr
| None -> descr in | None -> descr in
trace := mk_trace_elem level curr_loc descr node_tags :: !trace trace := Errlog.make_trace_element level curr_loc descr node_tags :: !trace
end end
| None -> | None ->
() in () in

@ -179,13 +179,7 @@ let lookup_annotation_calls annot pname : CallSite.t list =
let update_trace loc trace = let update_trace loc trace =
if Location.equal loc Location.dummy then trace if Location.equal loc Location.dummy then trace
else else
let trace_elem = { Errlog.make_trace_element 0 loc "" [] :: trace
Errlog.lt_level = 0;
lt_loc = loc;
lt_description = "";
lt_node_tags = [];
} in
trace_elem :: trace
let string_of_pname = let string_of_pname =
Procname.to_simplified_string ~withclass:true Procname.to_simplified_string ~withclass:true

@ -131,18 +131,12 @@ module ST = struct
is_method_suppressed || is_field_suppressed || is_class_suppressed in is_method_suppressed || is_field_suppressed || is_class_suppressed in
let trace = let trace =
let make_trace_element loc description =
[{
Errlog.lt_level = 0;
Errlog.lt_loc = loc;
Errlog.lt_description = description;
Errlog.lt_node_tags = []
}] in
let origin_elements = let origin_elements =
match origin_loc with match origin_loc with
| Some oloc -> make_trace_element oloc "origin" | Some oloc -> [Errlog.make_trace_element 0 oloc "origin" []]
| None -> [] in | None -> [] in
origin_elements @ (make_trace_element loc description) in origin_elements @ [Errlog.make_trace_element 0 loc description []]
in
if not suppressed then if not suppressed then
begin begin

@ -111,11 +111,7 @@ let log_frontend_issue translation_unit_context method_decl_opt key issue_desc =
issue_desc.CIssue.suggestion loc in issue_desc.CIssue.suggestion loc in
let name = CIssue.to_string issue in let name = CIssue.to_string issue in
let exn = Exceptions.Frontend_warning (name, err_desc, __POS__) in let exn = Exceptions.Frontend_warning (name, err_desc, __POS__) in
let trace = [ let trace = [ Errlog.make_trace_element 0 issue_desc.CIssue.loc "" [] ] in
{ Errlog.lt_level = 0;
Errlog.lt_loc = issue_desc.CIssue.loc;
Errlog.lt_description = "";
Errlog.lt_node_tags = []}] in
let err_kind = CIssue.severity_of_issue issue in let err_kind = CIssue.severity_of_issue issue in
let method_name = Ast_utils.full_name_of_decl_opt method_decl_opt in let method_name = Ast_utils.full_name_of_decl_opt method_decl_opt in
let key = Hashtbl.hash (key ^ method_name) in let key = Hashtbl.hash (key ^ method_name) in

Loading…
Cancel
Save