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

48
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> <body>
|} |}
in in
F.fprintf fmt "%s" s ; (fd, fmt) F.pp_print_string fmt s ; (fd, fmt)
(** Get the full html filename from a path *) (** Get the full html filename from a path *)
@ -125,49 +125,41 @@ td.rowname { text-align:right; font-weight:bold; color:#444444; padding-right:2e
(** Print a horizontal line *) (** 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 *) (** 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 *) (** 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 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 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) DB.filename_to_string (DB.Results_dir.path_to_filename DB.Results_dir.Rel escaped_path)
^ ".html" ^ pos_str
in in
let name_str = match name with None -> "" | Some n -> "name=\"" ^ n ^ "\"" in let pp_name fmt = Option.iter ~f:(F.fprintf fmt "name=\"%s\" ") in
let pr_str = "<a " ^ name_str ^ "href=\"" ^ link_str ^ "\">" ^ text ^ "</a>" in let pp_pos fmt = Option.iter ~f:(F.fprintf fmt "#%s") in
F.fprintf fmt " %s" pr_str 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 *) (** 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. *) (** 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 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 node_fname = node_filename pname id in
let node_text =
let descr = if String.equal description "" then "N" else String.prefix description 1 in
let style_class = let style_class =
if not isvisited then "dangling" else if isproof then "visitedproof" else "visited" if not isvisited then "dangling" else if isproof then "visitedproof" else "visited"
in in
let node_text = F.asprintf
let pp fmt = "<span class='%s'>%s_%d<span class='expansion'>node%d preds:%a succs:%a exn:%a \
Format.fprintf fmt %s%s</span></span>" style_class descr id id (Pp.seq F.pp_print_int) preds
"<span class='%s'>%s<span class='expansion'>node%d preds:%a succs:%a exn:%a \ (Pp.seq F.pp_print_int) succs (Pp.seq F.pp_print_int) exn description
%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 "") (if not isvisited then "\nNOT VISITED" else "")
in in
F.asprintf "%t" pp
in
pp_link ~path:(path_to_root @ ["nodes"; node_fname]) fmt node_text 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 let pp_session_link ?(with_name= false) ?proc_name source path_to_root fmt
(node_id, session, linenum) = (node_id, session, linenum) =
let node_name = "node" ^ string_of_int node_id in let node_name = "node" ^ string_of_int node_id 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 = let node_fname =
match proc_name with Some pname -> node_filename pname node_id | None -> node_name match proc_name with Some pname -> node_filename pname node_id | None -> node_name
in in
let path_to_node = path_to_root @ ["nodes"; node_fname] in path_to_root @ ["nodes"; node_fname]
let pos = "session" ^ string_of_int session in in
pp_link pp_link
~name:(if with_name then Some pos else None) ~name:(if with_name then Some pos else None)
~pos:(Some pos) ~path:path_to_node fmt ~pos:(Some pos) ~path:path_to_node fmt text ;
(node_name ^ "#" ^ pos) ;
F.fprintf fmt "(%a)" (pp_line_link source path_to_root) linenum F.fprintf fmt "(%a)" (pp_line_link source path_to_root) linenum
end end

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

@ -92,6 +92,27 @@ let is_visited node =
visited_fp || visited_re 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 =============== *) (* =============== START of module NodesHtml =============== *)
(** Print information into html files for nodes (** Print information into html files for nodes
@ -105,16 +126,7 @@ module NodesHtml : sig
end = struct end = struct
let log_files = Hashtbl.create 11 let log_files = Hashtbl.create 11
let pp_node_link fmt node = let pp_node_link fmt node = pp_node_link [".."] ~description:false 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 start_node nodeid loc proc_name preds succs exns source =
let node_fname = Io_infer.Html.node_filename proc_name nodeid in 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>" F.fprintf fmt "<center><h1>Cfg Node %a</h1></center>"
(Io_infer.Html.pp_line_link source ~text:(Some (string_of_int nodeid)) [".."]) (Io_infer.Html.pp_line_link source ~text:(Some (string_of_int nodeid)) [".."])
loc.Location.line ; 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) (Io_infer.Html.pp_proc_link [".."] proc_name)
(Escape.escape_xml (Typ.Procname.to_string proc_name)) (Escape.escape_xml (Typ.Procname.to_string proc_name))
(Io_infer.Html.pp_line_link source [".."]) (Io_infer.Html.pp_line_link source [".."])
loc.Location.line ; loc.Location.line ;
F.fprintf fmt "<br>PREDS:@\n" ; 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" ; 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" ; 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.fprintf fmt "<br>@\n" ;
F.pp_print_flush fmt () ; F.pp_print_flush fmt () ;
true ) true )
@ -180,9 +192,7 @@ let force_delayed_print fmt =
Sil.pp_hpred pe_default fmt hpred Sil.pp_hpred pe_default fmt hpred
| L.PTincrease_indent, n -> | L.PTincrease_indent, n ->
let n : int = Obj.obj n in let n : int = Obj.obj n in
let s = ref "" in F.fprintf fmt "%s@[" (String.make (2 * n) ' ')
for _ = 1 to n do s := " " ^ !s done ;
F.fprintf fmt "%s@[" !s
| L.PTinstr, i -> | L.PTinstr, i ->
let i : Sil.instr = Obj.obj i in let i : Sil.instr = Obj.obj i in
if Config.write_html then 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 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) (Procdesc.Node.pp_instrs (Pp.html Green) io ~sub_instrs:b)
n Io_infer.Html.pp_end_color () 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 -> | L.PToff, off ->
let off : Sil.offset = Obj.obj off in let off : Sil.offset = Obj.obj off in
Sil.pp_offset pe_default fmt off 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 Propgraph.pp_proplist pe_default "PROP" (p, false) fmt pl
| L.PTprop_list_with_typ, plist -> | L.PTprop_list_with_typ, plist ->
let pl : Prop.normal Prop.t list = Obj.obj plist in 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 -> | L.PTprop_with_typ, p ->
let p : Prop.normal Prop.t = Obj.obj p in let p : Prop.normal Prop.t = Obj.obj p in
Prop.pp_prop_with_typ pe_default fmt p 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 Specs.pp_spec (if Config.write_html then Pp.html Blue else Pp.text) None fmt spec
| L.PTstr, s -> | L.PTstr, s ->
let s : string = Obj.obj s in let s : string = Obj.obj s in
F.fprintf fmt "%s" s F.pp_print_string fmt s
| L.PTstr_color, s -> | L.PTstr_color, s ->
let (s: string), (c: Pp.color) = Obj.obj s in let (s: string), (c: Pp.color) = Obj.obj s in
if Config.write_html then 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 () 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 -> | L.PTstrln, s ->
let s : string = Obj.obj s in let s : string = Obj.obj s in
F.fprintf fmt "%s@\n" s 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))) ~text:(Some (Escape.escape_xml (Typ.Procname.to_string pname)))
[]) [])
linenum ; linenum ;
List.iter Pp.seq (pp_node_link [] ~description:true) fmt nodes ;
~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 ;
match Specs.get_summary pname with match Specs.get_summary pname with
| None -> | None ->
() ()
@ -394,7 +395,7 @@ let create_table_err_per_line err_log =
let err_per_line = Hashtbl.create 17 in let err_per_line = Hashtbl.create 17 in
let add_err (key: Errlog.err_key) (err_data: Errlog.err_data) = let add_err (key: Errlog.err_key) (err_data: Errlog.err_data) =
let err_str = 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 in
try try
let set = Hashtbl.find err_per_line err_data.loc.Location.line in 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 *) (** Create error message for html file *)
let create_err_message err_string = let pp_err_message fmt err_string =
"\n<div class=\"msg\" style=\"margin-left:9ex\">" ^ err_string ^ "</div>" 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 = 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 String.Set.elements errset
with Not_found -> [] with Not_found -> []
in in
let linenum_str = string_of_int line_number in F.fprintf fmt "<tr><td class=\"num\" id=\"LINE%d\">%d</td><td class=\"line\">%s " line_number
let line_str = "LINE" ^ linenum_str in line_number line_html ;
let str = Pp.seq
"<tr><td class=\"num\" id=\"" ^ line_str ^ "\">" ^ linenum_str ^ "</td><td class=\"line\">" (pp_node_link [fname_encoding] ~proof_cover:!proof_cover ~description:true)
^ line_html fmt nodes_at_linenum ;
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 ;
List.iter List.iter
~f:(fun n -> ~f:(fun n ->
match Procdesc.Node.get_kind n with 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) List.length (Specs.get_specs_from_payload summary)
in in
let label = let label =
Escape.escape_xml (Typ.Procname.to_string proc_name) ^ ": " ^ string_of_int num_specs F.sprintf "%s: %d specs"
^ " specs" (Escape.escape_xml (Typ.Procname.to_string proc_name))
num_specs
in in
F.pp_print_char fmt ' ' ;
Io_infer.Html.pp_proc_link [fname_encoding] proc_name fmt label Io_infer.Html.pp_proc_link [fname_encoding] proc_name fmt label
| _ -> | _ ->
() ) () )
nodes_at_linenum ; nodes_at_linenum ;
List.iter List.iter ~f:(pp_err_message fmt) errors_at_linenum ;
~f:(fun err_string -> F.fprintf fmt "%s" (create_err_message err_string))
errors_at_linenum ;
F.fprintf fmt "</td></tr>@\n" F.fprintf fmt "</td></tr>@\n"
in in
pp_prelude () ; pp_prelude () ;

Write Preview
Loading…
Cancel
Save