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 "%a" Io_infer.Html.pp_start_color Pp.Black