diff --git a/infer/src/IR/Io_infer.ml b/infer/src/IR/Io_infer.ml
index c0428e443..be60cfa24 100644
--- a/infer/src/IR/Io_infer.ml
+++ b/infer/src/IR/Io_infer.ml
@@ -214,9 +214,7 @@ struct
description
(if not isvisited then "\nNOT VISITED" else "") in
F.asprintf "%t" pp in
- if not isvisited
- then F.fprintf fmt " %s" node_text
- else pp_link ~path: (path_to_root @ ["nodes"; node_fname]) fmt node_text
+ pp_link ~path: (path_to_root @ ["nodes"; node_fname]) fmt node_text
(** Print an html link to the given proc *)
let pp_proc_link path_to_root proc_name fmt text =
@@ -235,9 +233,13 @@ struct
(match text with Some s -> s | None -> linenum_str)
(** Print an html link given node id and session *)
- let pp_session_link ?(with_name = false) source path_to_root fmt (node_id, session, linenum) =
- let node_name = "node" ^ (string_of_int node_id) in
- let path_to_node = path_to_root @ ["nodes"; node_name] in
+ let pp_session_link ?(with_name = false) ?proc_name source path_to_root fmt
+ (node_id, session, linenum) =
+ let node_name = "node" ^ string_of_int node_id in
+ let node_fname = match proc_name with
+ | Some pname -> node_filename pname node_id
+ | None -> node_name in
+ let path_to_node = path_to_root @ ["nodes"; node_fname] in
let pos = "session" ^ (string_of_int session) in
pp_link
~name: (if with_name then Some pos else None)
diff --git a/infer/src/IR/Io_infer.mli b/infer/src/IR/Io_infer.mli
index ad79acf65..a76436c96 100644
--- a/infer/src/IR/Io_infer.mli
+++ b/infer/src/IR/Io_infer.mli
@@ -55,7 +55,8 @@ module Html : sig
(** Print an html link given node id and session *)
val pp_session_link :
- ?with_name: bool -> SourceFile.t -> string list -> Format.formatter -> int * int * int -> unit
+ ?with_name: bool -> ?proc_name: Typ.Procname.t -> SourceFile.t ->
+ string list -> Format.formatter -> int * int * int -> unit
(** Print start color *)
val pp_start_color : Format.formatter -> Pp.color -> unit
diff --git a/infer/src/backend/printer.ml b/infer/src/backend/printer.ml
index b6a42bc06..09bc19072 100644
--- a/infer/src/backend/printer.ml
+++ b/infer/src/backend/printer.ml
@@ -104,6 +104,18 @@ module NodesHtml : sig
end = struct
let log_files = Hashtbl.create 11
+ let pp_node_link fmt node =
+ Io_infer.Html.pp_node_link
+ [".."]
+ (Procdesc.Node.get_proc_name node)
+ ~description:""
+ ~preds:(List.map ~f:Procdesc.Node.get_id (Procdesc.Node.get_preds node) :> int list)
+ ~succs:(List.map ~f:Procdesc.Node.get_id (Procdesc.Node.get_succs node) :> int list)
+ ~exn:(List.map ~f:Procdesc.Node.get_id (Procdesc.Node.get_exn node) :> int list)
+ ~isvisited:(is_visited node)
+ ~isproof:false
+ fmt (Procdesc.Node.get_id node :> int)
+
let start_node nodeid loc proc_name preds succs exns source =
let node_fname = Io_infer.Html.node_filename proc_name nodeid in
let modified = Io_infer.Html.modified_during_analysis source ["nodes"; node_fname] in
@@ -126,41 +138,11 @@ end = struct
(Escape.escape_xml (Typ.Procname.to_string proc_name))
(Io_infer.Html.pp_line_link source [".."]) loc.Location.line;
F.fprintf fmt "
PREDS:@\n";
- List.iter ~f:(fun node ->
- Io_infer.Html.pp_node_link
- [".."]
- (Procdesc.Node.get_proc_name node)
- ~description:""
- ~preds:(List.map ~f:Procdesc.Node.get_id (Procdesc.Node.get_preds node) :> int list)
- ~succs:(List.map ~f:Procdesc.Node.get_id (Procdesc.Node.get_succs node) :> int list)
- ~exn:(List.map ~f:Procdesc.Node.get_id (Procdesc.Node.get_exn node) :> int list)
- ~isvisited:(is_visited node)
- ~isproof:false
- fmt (Procdesc.Node.get_id node :> int)) preds;
+ List.iter ~f:(pp_node_link fmt) preds;
F.fprintf fmt "
SUCCS: @\n";
- List.iter ~f:(fun node ->
- Io_infer.Html.pp_node_link
- [".."]
- (Procdesc.Node.get_proc_name node)
- ~description:""
- ~preds:(List.map ~f:Procdesc.Node.get_id (Procdesc.Node.get_preds node) :> int list)
- ~succs:(List.map ~f:Procdesc.Node.get_id (Procdesc.Node.get_succs node) :> int list)
- ~exn:(List.map ~f:Procdesc.Node.get_id (Procdesc.Node.get_exn node) :> int list)
- ~isvisited:(is_visited node)
- ~isproof:false
- fmt (Procdesc.Node.get_id node :> int)) succs;
+ List.iter ~f:(pp_node_link fmt) succs;
F.fprintf fmt "
EXN: @\n";
- List.iter ~f:(fun node ->
- Io_infer.Html.pp_node_link
- [".."]
- (Procdesc.Node.get_proc_name node)
- ~description:""
- ~preds:(List.map ~f:Procdesc.Node.get_id (Procdesc.Node.get_preds node) :> int list)
- ~succs:(List.map ~f:Procdesc.Node.get_id (Procdesc.Node.get_succs node) :> int list)
- ~exn:(List.map ~f:Procdesc.Node.get_id (Procdesc.Node.get_exn node) :> int list)
- ~isvisited:(is_visited node)
- ~isproof:false
- fmt (Procdesc.Node.get_id node :> int)) exns;
+ List.iter ~f:(pp_node_link fmt) exns;
F.fprintf fmt "
@\n";
F.pp_print_flush fmt ();
true
@@ -388,7 +370,7 @@ let start_session node (loc: Location.t) proc_name session source =
Io_infer.Html.pp_end_color ());
F.fprintf !curr_html_formatter "%a%a"
Io_infer.Html.pp_hline ()
- (Io_infer.Html.pp_session_link source ~with_name: true [".."])
+ (Io_infer.Html.pp_session_link source ~with_name: true [".."] ~proc_name)
((node_id :> int), session, loc.Location.line);
F.fprintf !curr_html_formatter "