pghs975uc
/
infer_clone
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Io_infer/Printer: Format simplifications

Browse Source 
Summary:
- Less `^`
- `pp_print_string` instead of `F.fprintf fmt "%s"`
- and stuff like that

Reviewed By: jvillard

Differential Revision: D7607336

fbshipit-source-id: 5d985ef
master
Mehdi Bouaziz 7 years ago committed by Facebook Github Bot
parent 62da9a8cfe
commit 5b908d633c
2 changed files with 70 additions and 88 deletions
Show Stats Download Patch File Download Diff File

56
infer/src/IR/Io_infer.ml
Unescape View File

@ -82,7 +82,7 @@ td.rowname { text-align:right; font-weight:bold; color:#444444; padding-right:2e
<body>
|}
in
F.fprintf fmt "%s" s ; (fd, fmt)
F.pp_print_string fmt s ; (fd, fmt)
(** Get the full html filename from a path *)
@ -125,48 +125,40 @@ td.rowname { text-align:right; font-weight:bold; color:#444444; padding-right:2e
(** Print a horizontal line *)
let pp_hline fmt () = F.fprintf fmt "<hr width=\"100%%\">@\n"
let pp_hline fmt () = F.pp_print_string fmt "<hr width=\"100%\">\n"
(** Print start color *)
let pp_start_color fmt color = F.fprintf fmt "%s" ("<span class='" ^ Pp.color_string color ^ "'>")
let pp_start_color fmt color = F.fprintf fmt "<span class='%s'>" (Pp.color_string color)
(** Print end color *)
let pp_end_color fmt () = F.fprintf fmt "%s" "</span>"
let pp_end_color fmt () = F.pp_print_string fmt "</span>"
let pp_link ?(name= None) ?(pos= None) ~path fmt text =
let pos_str = match pos with None -> "" | Some s -> "#" ^ s in
let escaped_path = List.map ~f:Escape.escape_url path in
let link_str =
let escaped_path = List.map ~f:Escape.escape_url path in
DB.filename_to_string (DB.Results_dir.path_to_filename DB.Results_dir.Rel escaped_path)
^ ".html" ^ pos_str
in
let name_str = match name with None -> "" | Some n -> "name=\"" ^ n ^ "\"" in
let pr_str = "<a " ^ name_str ^ "href=\"" ^ link_str ^ "\">" ^ text ^ "</a>" in
F.fprintf fmt " %s" pr_str
let pp_name fmt = Option.iter ~f:(F.fprintf fmt "name=\"%s\" ") in
let pp_pos fmt = Option.iter ~f:(F.fprintf fmt "#%s") in
F.fprintf fmt "<a %ahref=\"%s.html%a\">%s</a>" pp_name name link_str pp_pos pos text
(** File name for the node, given the procedure name and node id *)
let node_filename pname id = Typ.Procname.to_filename pname ^ "_node" ^ string_of_int id
let node_filename pname id = F.sprintf "%s_node%d" (Typ.Procname.to_filename pname) id
(** Print an html link to the given node. *)
let pp_node_link path_to_root pname ~description ~preds ~succs ~exn ~isvisited ~isproof fmt id =
let display_name =
(if String.equal description "" then "N" else String.sub description ~pos:0 ~len:1) ^ "_"
^ string_of_int id
in
let node_fname = node_filename pname id in
let style_class =
if not isvisited then "dangling" else if isproof then "visitedproof" else "visited"
in
let node_text =
let pp fmt =
Format.fprintf fmt
"<span class='%s'>%s<span class='expansion'>node%d preds:%a succs:%a exn:%a \
%s%s</span></span>" style_class display_name id (Pp.seq Format.pp_print_int) preds
(Pp.seq Format.pp_print_int) succs (Pp.seq Format.pp_print_int) exn description
(if not isvisited then "\nNOT VISITED" else "")
let descr = if String.equal description "" then "N" else String.prefix description 1 in
let style_class =
if not isvisited then "dangling" else if isproof then "visitedproof" else "visited"
in
F.asprintf "%t" pp
F.asprintf
"<span class='%s'>%s_%d<span class='expansion'>node%d preds:%a succs:%a exn:%a \
%s%s</span></span>" style_class descr id id (Pp.seq F.pp_print_int) preds
(Pp.seq F.pp_print_int) succs (Pp.seq F.pp_print_int) exn description
(if not isvisited then "\nNOT VISITED" else "")
in
pp_link ~path:(path_to_root @ ["nodes"; node_fname]) fmt node_text
@ -193,15 +185,17 @@ td.rowname { text-align:right; font-weight:bold; color:#444444; padding-right:2e
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
let text = F.sprintf "%s#%s" node_name pos in
let path_to_node =
let node_fname =
match proc_name with Some pname -> node_filename pname node_id | None -> node_name
in
path_to_root @ ["nodes"; node_fname]
in
pp_link
~name:(if with_name then Some pos else None)
~pos:(Some pos) ~path:path_to_node fmt
(node_name ^ "#" ^ pos) ;
~pos:(Some pos) ~path:path_to_node fmt text ;
F.fprintf fmt "(%a)" (pp_line_link source path_to_root) linenum
end

102
infer/src/backend/printer.ml
Unescape View File

@ -92,6 +92,27 @@ let is_visited node =
visited_fp || visited_re
let pp_node_link path_to_root ?proof_cover ~description fmt node =
let description =
if description then Procdesc.Node.get_description (Pp.html Black) node else ""
in
let isproof =
match proof_cover with
| Some proof_cover ->
Specs.Visitedset.mem (Procdesc.Node.get_id node, []) proof_cover
| None ->
false
in
Io_infer.Html.pp_node_link path_to_root
(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 fmt
(Procdesc.Node.get_id node :> int)
(* =============== START of module NodesHtml =============== *)
(** Print information into html files for nodes
@ -105,16 +126,7 @@ 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 pp_node_link fmt node = pp_node_link [".."] ~description:false fmt node
let start_node nodeid loc proc_name preds succs exns source =
let node_fname = Io_infer.Html.node_filename proc_name nodeid in
@ -129,17 +141,17 @@ end = struct
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 ;
F.fprintf fmt "PROC: %a LINE:%a@\n"
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 ;
F.fprintf fmt "<br>PREDS:@\n" ;
List.iter ~f:(pp_node_link fmt) preds ;
Pp.seq pp_node_link fmt preds ;
F.fprintf fmt "<br>SUCCS: @\n" ;
List.iter ~f:(pp_node_link fmt) succs ;
Pp.seq pp_node_link fmt succs ;
F.fprintf fmt "<br>EXN: @\n" ;
List.iter ~f:(pp_node_link fmt) exns ;
Pp.seq pp_node_link fmt exns ;
F.fprintf fmt "<br>@\n" ;
F.pp_print_flush fmt () ;
true )
@ -180,9 +192,7 @@ let force_delayed_print fmt =
Sil.pp_hpred pe_default fmt hpred
| L.PTincrease_indent, n ->
let n : int = Obj.obj n in
let s = ref "" in
for _ = 1 to n do s := " " ^ !s done ;
F.fprintf fmt "%s@[" !s
F.fprintf fmt "%s@[" (String.make (2 * n) ' ')
| L.PTinstr, i ->
let i : Sil.instr = Obj.obj i in
if Config.write_html then
@ -212,7 +222,7 @@ let force_delayed_print fmt =
F.fprintf fmt "%a%a%a" Io_infer.Html.pp_start_color Pp.Green
(Procdesc.Node.pp_instrs (Pp.html Green) io ~sub_instrs:b)
n Io_infer.Html.pp_end_color ()
else F.fprintf fmt "%a" (Procdesc.Node.pp_instrs Pp.text io ~sub_instrs:b) n
else Procdesc.Node.pp_instrs Pp.text io ~sub_instrs:b fmt n
| L.PToff, off ->
let off : Sil.offset = Obj.obj off in
Sil.pp_offset pe_default fmt off
@ -236,7 +246,7 @@ let force_delayed_print fmt =
Propgraph.pp_proplist pe_default "PROP" (p, false) fmt pl
| L.PTprop_list_with_typ, plist ->
let pl : Prop.normal Prop.t list = Obj.obj plist in
F.fprintf fmt "%a" (Prop.pp_proplist_with_typ pe_default) pl
Prop.pp_proplist_with_typ pe_default fmt pl
| L.PTprop_with_typ, p ->
let p : Prop.normal Prop.t = Obj.obj p in
Prop.pp_prop_with_typ pe_default fmt p
@ -257,12 +267,12 @@ let force_delayed_print fmt =
Specs.pp_spec (if Config.write_html then Pp.html Blue else Pp.text) None fmt spec
| L.PTstr, s ->
let s : string = Obj.obj s in
F.fprintf fmt "%s" s
F.pp_print_string fmt s
| L.PTstr_color, s ->
let (s: string), (c: Pp.color) = Obj.obj s in
if Config.write_html then
F.fprintf fmt "%a%s%a" Io_infer.Html.pp_start_color c s Io_infer.Html.pp_end_color ()
else F.fprintf fmt "%s" s
else F.pp_print_string fmt s
| L.PTstrln, s ->
let s : string = Obj.obj s in
F.fprintf fmt "%s@\n" s
@ -371,16 +381,7 @@ let write_proc_html pdesc =
~text:(Some (Escape.escape_xml (Typ.Procname.to_string pname)))
[])
linenum ;
List.iter
~f:(fun n ->
Io_infer.Html.pp_node_link [] (Procdesc.Node.get_proc_name n)
~description:(Procdesc.Node.get_description (Pp.html Black) n)
~preds:(List.map ~f:Procdesc.Node.get_id (Procdesc.Node.get_preds n) :> int list)
~succs:(List.map ~f:Procdesc.Node.get_id (Procdesc.Node.get_succs n) :> int list)
~exn:(List.map ~f:Procdesc.Node.get_id (Procdesc.Node.get_exn n) :> int list)
~isvisited:(is_visited n) ~isproof:false fmt
(Procdesc.Node.get_id n :> int) )
nodes ;
Pp.seq (pp_node_link [] ~description:true) fmt nodes ;
match Specs.get_summary pname with
| None ->
()
@ -394,7 +395,7 @@ 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) =
let err_str =
key.err_name.IssueType.unique_id ^ " " ^ F.asprintf "%a" Localise.pp_error_desc key.err_desc
F.asprintf "%s %a" key.err_name.IssueType.unique_id Localise.pp_error_desc key.err_desc
in
try
let set = Hashtbl.find err_per_line err_data.loc.Location.line in
@ -406,8 +407,8 @@ let create_table_err_per_line err_log =
(** Create error message for html file *)
let create_err_message err_string =
"\n<div class=\"msg\" style=\"margin-left:9ex\">" ^ err_string ^ "</div>"
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 proof_cover table_nodes_at_linenum global_err_log proc_desc =
@ -466,24 +467,11 @@ let write_html_file linereader filename procs =
String.Set.elements errset
with Not_found -> []
in
let linenum_str = string_of_int line_number in
let line_str = "LINE" ^ linenum_str in
let str =
"<tr><td class=\"num\" id=\"" ^ line_str ^ "\">" ^ linenum_str ^ "</td><td class=\"line\">"
^ line_html
in
F.fprintf fmt "%s" str ;
List.iter
~f:(fun n ->
let isproof = Specs.Visitedset.mem (Procdesc.Node.get_id n, []) !proof_cover in
Io_infer.Html.pp_node_link [fname_encoding] (Procdesc.Node.get_proc_name n)
~description:(Procdesc.Node.get_description (Pp.html Black) n)
~preds:(List.map ~f:Procdesc.Node.get_id (Procdesc.Node.get_preds n) :> int list)
~succs:(List.map ~f:Procdesc.Node.get_id (Procdesc.Node.get_succs n) :> int list)
~exn:(List.map ~f:Procdesc.Node.get_id (Procdesc.Node.get_exn n) :> int list)
~isvisited:(is_visited n) ~isproof fmt
(Procdesc.Node.get_id n :> int) )
nodes_at_linenum ;
F.fprintf fmt "<tr><td class=\"num\" id=\"LINE%d\">%d</td><td class=\"line\">%s " line_number
line_number line_html ;
Pp.seq
(pp_node_link [fname_encoding] ~proof_cover:!proof_cover ~description:true)
fmt nodes_at_linenum ;
List.iter
~f:(fun n ->
match Procdesc.Node.get_kind n with
@ -496,16 +484,16 @@ let write_html_file linereader filename procs =
List.length (Specs.get_specs_from_payload summary)
in
let label =
Escape.escape_xml (Typ.Procname.to_string proc_name) ^ ": " ^ string_of_int num_specs
^ " specs"
F.sprintf "%s: %d specs"
(Escape.escape_xml (Typ.Procname.to_string proc_name))
num_specs
in
F.pp_print_char fmt ' ' ;
Io_infer.Html.pp_proc_link [fname_encoding] proc_name fmt label
| _ ->
() )
nodes_at_linenum ;
List.iter
~f:(fun err_string -> F.fprintf fmt "%s" (create_err_message err_string))
errors_at_linenum ;
List.iter ~f:(pp_err_message fmt) errors_at_linenum ;
F.fprintf fmt "</td></tr>@\n"
in
pp_prelude () ;

Write Preview
Loading…
Cancel
Save