diff --git a/infer/src/IR/Io_infer.ml b/infer/src/IR/Io_infer.ml
index 0289a5c32..3bbaa166c 100644
--- a/infer/src/IR/Io_infer.ml
+++ b/infer/src/IR/Io_infer.ml
@@ -15,7 +15,7 @@ module F = Format
(* =============== START of module Html =============== *)
module Html = struct
(** Create a new html file *)
- let create pk path =
+ let create source path =
let fname, dir_path =
match List.rev path with
| fname :: path_rev ->
@@ -23,7 +23,7 @@ module Html = struct
| [] ->
raise (Failure "Html.create")
in
- let fd = DB.Results_dir.create_file pk dir_path in
+ let fd = DB.Results_dir.(create_file (Abs_source_dir source)) dir_path in
let outc = Unix.out_channel_of_descr fd in
let fmt = F.formatter_of_out_channel outc in
let s =
@@ -96,7 +96,7 @@ h1 { font-size:14pt }
(** Print a horizontal line *)
- let pp_hline fmt () = F.pp_print_string fmt "
\n"
+ let pp_hline fmt () = F.pp_print_string fmt "\n
\n"
(** Print start color *)
let pp_start_color fmt color = F.fprintf fmt "" (Pp.color_string color)
diff --git a/infer/src/IR/Io_infer.mli b/infer/src/IR/Io_infer.mli
index 558864bce..ebe2ed12b 100644
--- a/infer/src/IR/Io_infer.mli
+++ b/infer/src/IR/Io_infer.mli
@@ -14,8 +14,7 @@ module Html : sig
val close : Unix.File_descr.t * Format.formatter -> unit
(** Close an Html file *)
- val create :
- DB.Results_dir.path_kind -> DB.Results_dir.path -> Unix.File_descr.t * Format.formatter
+ val create : SourceFile.t -> DB.Results_dir.path -> Unix.File_descr.t * Format.formatter
(** Create a new html file *)
val modified_during_analysis : SourceFile.t -> DB.Results_dir.path -> bool
diff --git a/infer/src/backend/Summary.ml b/infer/src/backend/Summary.ml
index 808f3d223..bc2077f0e 100644
--- a/infer/src/backend/Summary.ml
+++ b/infer/src/backend/Summary.ml
@@ -115,7 +115,7 @@ let pp_text fmt summary =
(Payloads.pp Pp.text) summary.payloads
-let pp_html source color fmt summary =
+let pp_html source fmt summary =
Io_infer.Html.pp_start_color fmt Black ;
F.fprintf fmt "@\n%a" pp_no_stats_specs summary ;
Io_infer.Html.pp_end_color fmt () ;
@@ -123,7 +123,7 @@ let pp_html source color fmt summary =
Errlog.pp_html source [] fmt (get_err_log summary) ;
Io_infer.Html.pp_hline fmt () ;
F.fprintf fmt "@\n" ;
- Payloads.pp (Pp.html color) fmt summary.payloads ;
+ Payloads.pp (Pp.html Black) fmt summary.payloads ;
F.fprintf fmt "@\n"
diff --git a/infer/src/backend/Summary.mli b/infer/src/backend/Summary.mli
index a7936623a..a16e45346 100644
--- a/infer/src/backend/Summary.mli
+++ b/infer/src/backend/Summary.mli
@@ -86,7 +86,7 @@ val reset : Procdesc.t -> t
val load_from_file : DB.filename -> t option
-val pp_html : SourceFile.t -> Pp.color -> Format.formatter -> t -> unit
+val pp_html : SourceFile.t -> Format.formatter -> t -> unit
(** Print the summary in html format *)
val pp_text : Format.formatter -> t -> unit
diff --git a/infer/src/backend/printer.ml b/infer/src/backend/printer.ml
index 905c6bb52..5ec68d6a0 100644
--- a/infer/src/backend/printer.ml
+++ b/infer/src/backend/printer.ml
@@ -112,8 +112,9 @@ module NodesHtml : sig
-> Procdesc.Node.t list
-> Procdesc.Node.t list
-> Procdesc.Node.t list
+ -> Instrs.not_reversed_t
-> SourceFile.t
- -> bool
+ -> unit
val finish_node : Typ.Procname.t -> int -> SourceFile.t -> unit
end = struct
@@ -121,12 +122,13 @@ end = struct
let pp_node_link_seq fmt node = pp_node_link_seq [".."] ~description:false fmt node
- let start_node nodeid loc proc_name preds succs exns source =
+ let start_node nodeid loc proc_name preds succs exns instrs 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
+ let node_path = ["nodes"; node_fname] in
+ let modified = Io_infer.Html.modified_during_analysis source node_path in
let needs_initialization, (fd, fmt) =
- if modified then (false, Io_infer.Html.open_out source ["nodes"; node_fname])
- else (true, Io_infer.Html.create (DB.Results_dir.Abs_source_dir source) ["nodes"; node_fname])
+ if modified then (false, Io_infer.Html.open_out source node_path)
+ else (true, Io_infer.Html.create source node_path)
in
curr_html_formatter := fmt ;
Hashtbl.replace log_files (node_fname, source) fd ;
@@ -141,14 +143,14 @@ end = struct
loc.Location.line ;
F.fprintf fmt "
PREDS:@\n" ;
pp_node_link_seq fmt preds ;
- F.fprintf fmt "
SUCCS: @\n" ;
+ F.fprintf fmt "
SUCCS:@\n" ;
pp_node_link_seq fmt succs ;
- F.fprintf fmt "
EXN: @\n" ;
+ F.fprintf fmt "
EXN:@\n" ;
pp_node_link_seq fmt exns ;
F.fprintf fmt "
@\n" ;
- F.pp_print_flush fmt () ;
- true )
- else false
+ F.fprintf fmt "%a" (Pp.color_string Green)
+ (Instrs.pp (Pp.html Green))
+ instrs )
let finish_node proc_name nodeid source =
@@ -170,24 +172,18 @@ let force_delayed_prints () =
L.reset_delayed_prints ()
-(** Start a session, and create a new html fine for the node if it does not exist yet *)
+(** Start a session, and create a new html file for the node if it does not exist yet *)
let start_session ~pp_name node (loc : Location.t) proc_name session source =
let node_id = Procdesc.Node.get_id node in
- if
- NodesHtml.start_node
- (node_id :> int)
- loc proc_name (Procdesc.Node.get_preds node) (Procdesc.Node.get_succs node)
- (Procdesc.Node.get_exn node) source
- then
- F.fprintf !curr_html_formatter "%a%a%a" Io_infer.Html.pp_start_color
- Pp.Green
- (Instrs.pp (Pp.html Green))
- (Procdesc.Node.get_instrs node) Io_infer.Html.pp_end_color () ;
+ NodesHtml.start_node
+ (node_id :> int)
+ loc proc_name (Procdesc.Node.get_preds node) (Procdesc.Node.get_succs node)
+ (Procdesc.Node.get_exn node) (Procdesc.Node.get_instrs node) source ;
F.fprintf !curr_html_formatter "%a%a %t" Io_infer.Html.pp_hline ()
(Io_infer.Html.pp_session_link source ~with_name:true [".."] ~proc_name)
((node_id :> int), session, loc.Location.line)
pp_name ;
- F.fprintf !curr_html_formatter "%a" Io_infer.Html.pp_start_color Pp.Black
+ F.fprintf !curr_html_formatter "@\n" (Pp.color_string Black)
let node_start_session ~pp_name node session =
@@ -202,7 +198,7 @@ let node_start_session ~pp_name node session =
let node_finish_session node =
if not Config.only_cheap_debug then force_delayed_prints () else L.reset_delayed_prints () ;
if Config.write_html then (
- F.fprintf !curr_html_formatter "%a@?" Io_infer.Html.pp_end_color () ;
+ F.fprintf !curr_html_formatter "@?" ;
let source = (Procdesc.Node.get_loc node).file in
NodesHtml.finish_node
(Procdesc.Node.get_proc_name node)
@@ -217,9 +213,7 @@ let write_proc_html pdesc =
let source = (Procdesc.get_loc pdesc).file in
let nodes = List.sort ~compare:Procdesc.Node.compare (Procdesc.get_nodes pdesc) in
let linenum = (Procdesc.Node.get_loc (List.hd_exn nodes)).Location.line in
- let fd, fmt =
- Io_infer.Html.create (DB.Results_dir.Abs_source_dir source) [Typ.Procname.to_filename pname]
- in
+ let fd, fmt = Io_infer.Html.create source [Typ.Procname.to_filename pname] in
F.fprintf fmt "Procedure %a
@\n"
(Io_infer.Html.pp_line_link source
~text:(Some (Escape.escape_xml (Typ.Procname.to_string pname)))
@@ -231,7 +225,7 @@ let write_proc_html pdesc =
()
| Some summary ->
F.pp_print_string fmt "
@\n" ;
- Summary.pp_html source Black fmt summary ) ;
+ Summary.pp_html source fmt summary ) ;
F.fprintf fmt "
@\n@\n%a
@\n" ProcAttributes.pp (Procdesc.get_attributes pdesc) ;
Io_infer.Html.close (fd, fmt) )
@@ -288,9 +282,7 @@ let write_html_proc source table_nodes_at_linenum global_err_log proc_desc =
(** Create filename.ext.html. *)
let write_html_file linereader filename procs =
let fname_encoding = DB.source_file_encoding filename in
- let fd, fmt =
- Io_infer.Html.create (DB.Results_dir.Abs_source_dir filename) [".."; fname_encoding]
- in
+ let fd, fmt = Io_infer.Html.create filename [".."; fname_encoding] in
let pp_prelude () =
F.fprintf fmt "File %a
@\n@\n" SourceFile.pp
filename