Preparatory changes in Printer

Summary: No-op changes in preparation for another diff

Reviewed By: jvillard

Differential Revision: D15279321

fbshipit-source-id: bd51c8f30
master
Mehdi Bouaziz 6 years ago committed by Facebook Github Bot
parent b27c02ad35
commit 12687b2948

@ -37,9 +37,7 @@ module LineReader = struct
lines := line :: !lines
done ;
assert false (* execution never reaches here *)
with End_of_file ->
In_channel.close cin ;
Array.of_list (List.rev !lines)
with End_of_file -> In_channel.close cin ; Array.of_list_rev !lines
let file_data (hash : t) fname =
@ -51,18 +49,19 @@ module LineReader = struct
with exn when SymOp.exn_not_failure exn -> None )
let from_file_linenum_original hash fname linenum =
let from_file_linenum hash fname linenum =
match file_data hash fname with
| None ->
| Some lines_arr when linenum > 0 && linenum <= Array.length lines_arr ->
Some lines_arr.(linenum - 1)
| _ ->
None
| Some lines_arr ->
if linenum > 0 && linenum <= Array.length lines_arr then Some lines_arr.(linenum - 1)
else None
let from_file_linenum hash fname linenum = from_file_linenum_original hash fname linenum
let from_loc hash loc = from_file_linenum hash loc.Location.file loc.Location.line
let iter hash fname ~f =
file_data hash fname
|> Option.iter ~f:(Array.iteri ~f:(fun linenum line -> f (linenum + 1) line))
end
(** Current formatter for the html output *)
@ -79,12 +78,12 @@ let is_visited node =
Summary.Stats.is_visited stats node_id
let pp_node_link_seq =
let compare_node =
let key node = (Procdesc.Node.get_wto_index node, Procdesc.Node.get_id node) in
fun node1 node2 -> [%compare: int * Procdesc.Node.id] (key node1) (key node2)
let pp_node_link_seq path_to_root ~description fmt nodes =
in
fun path_to_root ~description fmt nodes ->
let nodes = List.sort nodes ~compare:compare_node in
let pp_one fmt node =
let description =
@ -101,33 +100,27 @@ let pp_node_link_seq path_to_root ~description fmt nodes =
Pp.seq pp_one fmt nodes
(* =============== START of module NodesHtml =============== *)
(** Print information into html files for nodes
when starting and finishing the processing of a node *)
module NodesHtml : sig
val start_node :
int
-> Location.t
-> Typ.Procname.t
-> Procdesc.Node.t list
-> Procdesc.Node.t list
-> Procdesc.Node.t list
-> Instrs.not_reversed_t
-> SourceFile.t
-> unit
val finish_node : Typ.Procname.t -> int -> SourceFile.t -> unit
val start_session : pp_name:(Format.formatter -> unit) -> Procdesc.Node.t -> int -> unit
val finish_session : Procdesc.Node.t -> unit
end = struct
let log_files = Hashtbl.create 11
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 instrs source =
let start_session ~pp_name node session =
let loc = Procdesc.Node.get_loc node in
let source = loc.Location.file in
let line = loc.Location.line in
let proc_name = Procdesc.Node.get_proc_name node in
let nodeid = (Procdesc.Node.get_id node :> int) in
let node_fname = Io_infer.Html.node_filename proc_name nodeid in
let needs_initialization, (fd, fmt) =
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 node_path)
else (true, Io_infer.Html.create source node_path)
in
@ -136,79 +129,47 @@ end = struct
if needs_initialization then (
F.fprintf fmt "<center><h1>Cfg Node %a</h1></center>"
(Io_infer.Html.pp_line_link source ~text:(Some (string_of_int nodeid)) [".."])
loc.Location.line ;
line ;
F.fprintf fmt "PROC: %a LINE: %a@\n"
(Io_infer.Html.pp_proc_link [".."] proc_name)
(Escape.escape_xml (Typ.Procname.to_string proc_name))
(Io_infer.Html.pp_line_link source [".."])
loc.Location.line ;
line ;
F.fprintf fmt "<br>PREDS:@\n" ;
pp_node_link_seq fmt preds ;
pp_node_link_seq fmt (Procdesc.Node.get_preds node) ;
F.fprintf fmt "<br>SUCCS:@\n" ;
pp_node_link_seq fmt succs ;
pp_node_link_seq fmt (Procdesc.Node.get_succs node) ;
F.fprintf fmt "<br>EXN:@\n" ;
pp_node_link_seq fmt exns ;
pp_node_link_seq fmt (Procdesc.Node.get_exn node) ;
F.fprintf fmt "<br>@\n" ;
F.fprintf fmt "<LISTING class='%s'>%a</LISTING>" (Pp.color_string Green)
(Instrs.pp (Pp.html Green))
instrs )
let finish_node proc_name nodeid source =
let node_fname = Io_infer.Html.node_filename proc_name nodeid in
let fd = Hashtbl.find log_files (node_fname, source) in
Unix.close fd ;
curr_html_formatter := F.std_formatter
end
(* =============== END of module NodesHtml =============== *)
(* =============== Printing functions =============== *)
(** Execute the delayed print actions *)
let force_delayed_prints () =
F.pp_print_flush !curr_html_formatter () ;
(* flush html stream *)
L.force_and_reset_delayed_prints !curr_html_formatter ;
F.pp_print_flush !curr_html_formatter ()
(** 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
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 ()
(Procdesc.Node.get_instrs node) ) ;
F.fprintf fmt "%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 "@\n<LISTING class='%s'>" (Pp.color_string Black)
let node_start_session ~pp_name node session =
if Config.write_html then
let loc = Procdesc.Node.get_loc node in
let source = loc.Location.file in
let pname = Procdesc.Node.get_proc_name node in
start_session ~pp_name node loc pname session source
(nodeid, session, line) pp_name ;
F.fprintf fmt "@\n<LISTING class='%s'>" (Pp.color_string Black)
(** Finish a session, and perform delayed print actions if required *)
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 (
let finish_session node =
F.fprintf !curr_html_formatter "</LISTING>@?" ;
let fd =
let source = (Procdesc.Node.get_loc node).file in
NodesHtml.finish_node
(Procdesc.Node.get_proc_name node)
(Procdesc.Node.get_id node :> int)
source )
let node_fname =
let proc_name = Procdesc.Node.get_proc_name node in
let nodeid = (Procdesc.Node.get_id node :> int) in
Io_infer.Html.node_filename proc_name nodeid
in
Hashtbl.find log_files (node_fname, source)
in
Unix.close fd ;
curr_html_formatter := F.std_formatter
end
(** Write html file for the procedure. *)
let write_proc_html pdesc =
if Config.write_html then (
module ProcsHtml : sig
val write : Procdesc.t -> unit
end = struct
let write pdesc =
let pname = Procdesc.get_proc_name pdesc in
let source = (Procdesc.get_loc pdesc).file in
let nodes = List.sort ~compare:Procdesc.Node.compare (Procdesc.get_nodes pdesc) in
@ -227,10 +188,13 @@ let write_proc_html pdesc =
F.pp_print_string fmt "<br />@\n" ;
Summary.pp_html source fmt summary ) ;
F.fprintf fmt "<hr />@\n<pre>@\n%a</pre>@\n" ProcAttributes.pp (Procdesc.get_attributes pdesc) ;
Io_infer.Html.close (fd, fmt) )
Io_infer.Html.close (fd, fmt)
end
(** Creare a hash table mapping line numbers to the set of errors occurring on that line *)
module FilesHtml : sig
val write_all_html_files : SourceFile.t -> unit
end = struct
(** Create a hash table mapping line numbers to the set of errors occurring on that line *)
let create_table_err_per_line err_log =
let err_per_line = Hashtbl.create 17 in
let add_err (key : Errlog.err_key) (err_data : Errlog.err_data) =
@ -251,26 +215,27 @@ let pp_err_message fmt err_string =
F.fprintf fmt "\n<div class=\"msg\" style=\"margin-left:9ex\">%s</div>" err_string
let write_html_proc source table_nodes_at_linenum global_err_log proc_desc =
let process_proc source table_nodes_at_linenum global_err_log proc_desc =
let proc_name = Procdesc.get_proc_name proc_desc in
let _ = (* Initializes wto_indexes *) Procdesc.get_wto proc_desc in
let process_node n =
let lnum = (Procdesc.Node.get_loc n).Location.line in
let curr_nodes = try Hashtbl.find table_nodes_at_linenum lnum with Caml.Not_found -> [] in
Hashtbl.replace table_nodes_at_linenum lnum (n :: curr_nodes)
in
let proc_loc = Procdesc.get_loc proc_desc in
let proc_file = (Procdesc.get_loc proc_desc).file in
let process_proc =
Procdesc.is_defined proc_desc
&& SourceFile.equal proc_loc.Location.file source
Procdesc.is_defined proc_desc && SourceFile.equal proc_file source
&&
match Attributes.find_file_capturing_procedure proc_name with
| None ->
true
| Some (source_captured, _) ->
SourceFile.equal source_captured (Procdesc.get_loc proc_desc).file
SourceFile.equal source_captured proc_file
in
if process_proc then (
let _ = (* Initializes wto_indexes *) Procdesc.get_wto proc_desc in
let process_node n =
let lnum = (Procdesc.Node.get_loc n).Location.line in
let curr_nodes =
try Hashtbl.find table_nodes_at_linenum lnum with Caml.Not_found -> []
in
Hashtbl.replace table_nodes_at_linenum lnum (n :: curr_nodes)
in
List.iter ~f:process_node (Procdesc.get_nodes proc_desc) ;
match Summary.get proc_name with
| None ->
@ -283,31 +248,20 @@ let write_html_proc source table_nodes_at_linenum global_err_log proc_desc =
let write_html_file linereader filename procs =
let fname_encoding = DB.source_file_encoding filename in
let fd, fmt = Io_infer.Html.create filename [".."; fname_encoding] in
let pp_prelude () =
F.fprintf fmt "<center><h1>File %a </h1></center>@\n<table class=\"code\">@\n" SourceFile.pp
filename
in
let print_one_line table_nodes_at_linenum table_err_per_line line_number =
let line_html =
match LineReader.from_file_linenum linereader filename line_number with
| Some line_raw ->
Escape.escape_xml line_raw
| None ->
raise End_of_file
in
let errors_at_linenum =
try
let errset = Hashtbl.find table_err_per_line line_number in
String.Set.elements errset
with Caml.Not_found -> []
in
filename ;
let global_err_log = Errlog.empty () in
let table_nodes_at_linenum = Hashtbl.create 11 in
List.iter ~f:(process_proc filename table_nodes_at_linenum global_err_log) procs ;
let table_err_per_line = create_table_err_per_line global_err_log in
let print_one_line line_number line_raw =
let line_html = Escape.escape_xml line_raw in
F.fprintf fmt "<tr><td class=\"num\" id=\"LINE%d\">%d</td><td class=\"line\">%s " line_number
line_number line_html ;
( match Hashtbl.find table_nodes_at_linenum line_number with
| nodes_at_linenum ->
pp_node_link_seq [fname_encoding] ~description:true fmt nodes_at_linenum ;
List.iter
~f:(fun n ->
List.iter nodes_at_linenum ~f:(fun n ->
match Procdesc.Node.get_kind n with
| Procdesc.Node.Start_node ->
let proc_name = Procdesc.Node.get_proc_name n in
@ -319,43 +273,33 @@ let write_html_file linereader filename procs =
else F.fprintf fmt "no summary for %s" proc_name_escaped
| _ ->
() )
nodes_at_linenum
| exception Caml.Not_found ->
() ) ;
List.iter ~f:(pp_err_message fmt) errors_at_linenum ;
( match Hashtbl.find table_err_per_line line_number with
| errset ->
String.Set.iter errset ~f:(pp_err_message fmt)
| exception Caml.Not_found ->
() ) ;
F.fprintf fmt "</td></tr>@\n"
in
pp_prelude () ;
let global_err_log = Errlog.empty () in
let table_nodes_at_linenum = Hashtbl.create 11 in
List.iter ~f:(write_html_proc filename table_nodes_at_linenum global_err_log) procs ;
let table_err_per_line = create_table_err_per_line global_err_log in
let linenum = ref 0 in
try
while true do
incr linenum ;
print_one_line table_nodes_at_linenum table_err_per_line !linenum
done
with End_of_file ->
LineReader.iter linereader filename ~f:print_one_line ;
F.fprintf fmt "</table>@\n" ;
Errlog.pp_html filename [fname_encoding] fmt global_err_log ;
Io_infer.Html.close (fd, fmt)
(** Create the HTML debug file for the source file. *)
let write_all_html_files source_file =
let opt_whitelist_regex =
let is_whitelisted =
match Config.write_html_whitelist_regex with
| [] ->
None
fun _ -> true
| _ as reg_list ->
Some (Str.regexp (String.concat ~sep:"\\|" reg_list))
in
let is_whitelisted file =
Option.value_map opt_whitelist_regex ~default:true ~f:(fun regex ->
let regex = Str.regexp (String.concat ~sep:"\\|" reg_list) in
fun file ->
let fname = SourceFile.to_rel_path file in
Str.string_match regex fname 0 )
in
Str.string_match regex fname 0
let write_all_html_files source_file =
let linereader = LineReader.create () in
let procs_in_source = SourceFiles.proc_names_of_source source_file in
let source_files_in_cfg, pdescs_in_cfg =
@ -376,3 +320,31 @@ let write_all_html_files source_file =
SourceFile.Set.iter
(fun file -> write_html_file linereader file pdescs_in_cfg)
source_files_in_cfg
end
(* =============== Printing functions =============== *)
(** Execute the delayed print actions *)
let force_delayed_prints () =
F.pp_print_flush !curr_html_formatter () ;
(* flush html stream *)
L.force_and_reset_delayed_prints !curr_html_formatter ;
F.pp_print_flush !curr_html_formatter ()
(** Start a session, and create a new html file for the node if it does not exist yet *)
let node_start_session ~pp_name node session =
if Config.write_html then NodesHtml.start_session ~pp_name node session
(** Finish a session, and perform delayed print actions if required *)
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 NodesHtml.finish_session node
(** Write html file for the procedure. *)
let write_proc_html pdesc = if Config.write_html then ProcsHtml.write pdesc
(** Create the HTML debug file for the source file. *)
let write_all_html_files = FilesHtml.write_all_html_files

@ -18,7 +18,7 @@ module LineReader : sig
val create : unit -> t
(** create a line reader *)
val from_file_linenum_original : t -> SourceFile.t -> int -> string option
val from_file_linenum : t -> SourceFile.t -> int -> string option
(** get the line from a source file and line number *)
val from_loc : t -> Location.t -> string option

@ -30,7 +30,7 @@ let fix_method_definition_line linereader proc_name loc =
in
let regex = Str.regexp (Str.quote method_name) in
let method_is_defined_here linenum =
match Printer.LineReader.from_file_linenum_original linereader loc.Location.file linenum with
match Printer.LineReader.from_file_linenum linereader loc.Location.file linenum with
| None ->
raise Caml.Not_found
| Some line -> (

Loading…
Cancel
Save