[python] partial rewrite of inferTraceBugs in OCaml

Summary: HTML output is missing but the rest is there.

Reviewed By: skcho

Differential Revision: D20649221

fbshipit-source-id: 6bc91161a

infer/src/infer.ml

@@ -207,23 +207,31 @@ let () =
                 DotCfg.emit_frontend_cfg source_file cfgs ) ;
             L.result "CFGs written in %s/*/%s@." Config.captured_dir Config.dotty_frontend_output )
       | false, false ->
-          let if_some key opt args =
+          (* explore bug traces *)
-            match opt with None -> args | Some arg -> key :: string_of_int arg :: args
+          if Config.html then (
-          in
+            let if_some key opt args =
-          let if_true key opt args = if not opt then args else key :: args in
+              match opt with None -> args | Some arg -> key :: string_of_int arg :: args
-          let if_false key opt args = if opt then args else key :: args in
+            in
-          let args =
+            let if_true key opt args = if not opt then args else key :: args in
-            if_some "--max-level" Config.max_nesting
+            let if_false key opt args = if opt then args else key :: args in
-            @@ if_true "--only-show" Config.only_show
+            let args =
-            @@ if_false "--no-source" Config.source_preview
+              if_some "--max-level" Config.max_nesting
-            @@ if_true "--html" Config.html
+              @@ if_true "--only-show" Config.only_show
-            @@ if_some "--select" Config.select ["-o"; Config.results_dir]
+              @@ if_false "--no-source" Config.source_preview
-          in
+              @@ if_true "--html" Config.html
-          let prog = Config.lib_dir ^/ "python" ^/ "inferTraceBugs" in
+              @@ if_some "--select" Config.select ["-o"; Config.results_dir]
-          if is_error (Unix.waitpid (Unix.fork_exec ~prog ~argv:(prog :: args) ())) then
+            in
-            L.external_error
+            let prog = Config.lib_dir ^/ "python" ^/ "inferTraceBugs" in
-              "** Error running the reporting script:@\n**   %s %s@\n** See error above@." prog
+            if is_error (Unix.waitpid (Unix.fork_exec ~prog ~argv:(prog :: args) ())) then
-              (String.concat ~sep:" " args)
+              L.external_error
+                "** Error running the reporting script:@\n**   %s %s@\n** See error above@." prog
+                (String.concat ~sep:" " args) )
+          else
+            TraceBugs.explore ~selector_limit:None
+              ~report_json:Config.(results_dir ^/ report_json)
+              ~report_txt:Config.(results_dir ^/ report_txt)
+              ~selected:Config.select ~show_source_context:Config.source_preview
+              ~max_nested_level:Config.max_nesting
       | true, true ->
           L.user_error "Options --procedures and --source-files cannot be used together.@\n" ) ) ;
   (* to make sure the exitcode=0 case is logged, explicitly invoke exit *)

infer/src/integration/TextReport.ml

@@ -57,8 +57,8 @@ let pp_jsonbug fmt {Jsonbug_t.file; severity; line; bug_type; qualifier; _} =
   F.fprintf fmt "%s:%d: %s: %s@\n  %s" file line (String.lowercase severity) bug_type qualifier
 
 
-let pp_source_context fmt {Jsonbug_t.file= source_name; lnum= report_line; cnum= report_col; enum= _}
+let pp_source_context ~indent fmt
-    =
+    {Jsonbug_t.file= source_name; lnum= report_line; cnum= report_col; enum= _} =
   let source_name =
     if Filename.is_absolute source_name then source_name else Config.project_root ^/ source_name
   in
@@ -78,7 +78,7 @@ let pp_source_context fmt {Jsonbug_t.file= source_name; lnum= report_line; cnum=
             ~f:(fun line_number line ->
               if start_line <= line_number && line_number <= end_line then (
                 (* we are inside the context to print *)
-                F.fprintf fmt "  %*d. " n_length line_number ;
+                F.fprintf fmt "%t%*d. " (pp_n_spaces indent) n_length line_number ;
                 if report_col < 0 then
                   (* no column number, print caret next to the line of the report *)
                   if Int.equal line_number report_line then F.pp_print_string fmt "> "
@@ -86,7 +86,7 @@ let pp_source_context fmt {Jsonbug_t.file= source_name; lnum= report_line; cnum=
                 F.pp_print_string fmt line ;
                 F.pp_print_newline fmt () ;
                 if Int.equal line_number report_line && report_col >= 0 then (
-                  pp_n_spaces (2 + n_length + 1 + report_col) fmt ;
+                  pp_n_spaces (indent + n_length + 1 + report_col) fmt ;
                   F.pp_print_char fmt '^' ;
                   F.pp_print_newline fmt () ) ) ;
               if line_number < end_line then Continue (line_number + 1) else Stop () ) )
@@ -96,7 +96,7 @@ let create_from_json ~quiet ~console_limit ~report_txt ~report_json =
   (* TOOD: possible optimisation: stream reading report.json to process each issue one by one *)
   let report = Atdgen_runtime.Util.Json.from_file Jsonbug_j.read_report report_json in
   let one_issue_to_report_txt fmt (jsonbug : Jsonbug_t.jsonbug) =
-    F.fprintf fmt "%a@\n%a@\n" pp_jsonbug jsonbug pp_source_context
+    F.fprintf fmt "%a@\n%a@\n" pp_jsonbug jsonbug (pp_source_context ~indent:2)
       {Jsonbug_t.file= jsonbug.file; lnum= jsonbug.line; cnum= jsonbug.column; enum= -1}
   in
   let one_issue_to_console ~console_limit i (jsonbug : Jsonbug_t.jsonbug) =
@@ -116,7 +116,7 @@ let create_from_json ~quiet ~console_limit ~report_txt ~report_json =
         F.printf "%!" ;
         ANSITerminal.print_string style (F.asprintf "%a" pp_jsonbug jsonbug) ;
         F.printf "%!" ;
-        F.printf "@\n%a@\n" pp_source_context
+        F.printf "@\n%a@\n" (pp_source_context ~indent:2)
           {Jsonbug_t.file= jsonbug.file; lnum= jsonbug.line; cnum= jsonbug.column; enum= -1}
   in
   Utils.with_file_out report_txt ~f:(fun report_txt_out ->

infer/src/integration/TextReport.mli

@@ -5,8 +5,13 @@
  * LICENSE file in the root directory of this source tree.
  *)
 open! IStd
+module F = Format
 
 val create_from_json :
   quiet:bool -> console_limit:int option -> report_txt:string -> report_json:string -> unit
 (** Read [report_json] and produce a textual output in [report_txt]. If [not quiet] then display at
     most [console_limit] issues on stdout. If [console_limit] is [None] then display all the issues. *)
+
+val pp_jsonbug : F.formatter -> Jsonbug_t.jsonbug -> unit
+
+val pp_source_context : indent:int -> F.formatter -> Jsonbug_t.loc -> unit

infer/src/integration/TraceBugs.ml

@@ -0,0 +1,93 @@
+(*
+ * Copyright (c) Facebook, Inc. and its affiliates.
+ *
+ * This source code is licensed under the MIT license found in the
+ * LICENSE file in the root directory of this source tree.
+ *)
+open! IStd
+module F = Format
+module L = Logging
+
+[@@@warning "+9"]
+
+let is_past_limit limit =
+  match limit with None -> fun _ -> false | Some limit -> fun n -> n >= limit
+
+
+let pp_trace_item ~show_source_context fmt
+    Jsonbug_t.{level; filename; line_number; column_number; description} =
+  let pp_col_number fmt c = if c >= 0 then F.fprintf fmt ":%d" c in
+  F.fprintf fmt "%s:%d%a: %s@\n" filename line_number pp_col_number column_number description ;
+  if show_source_context then
+    TextReport.pp_source_context ~indent:(2 * level) fmt
+      {Jsonbug_t.file= filename; lnum= line_number; cnum= column_number; enum= -1}
+
+
+let show_issue_with_trace ~show_source_context ~max_nested_level
+    (n_issue, (issue : Jsonbug_t.jsonbug)) =
+  L.result "#%d@\n%a@\n" n_issue TextReport.pp_jsonbug issue ;
+  if List.is_empty issue.bug_trace then L.result "@\nEmpty trace@\n%!"
+  else
+    List.iter issue.bug_trace ~f:(fun trace_item ->
+        (* subtract 1 to get inclusive limits on the nesting level *)
+        if not (is_past_limit max_nested_level (trace_item.Jsonbug_t.level - 1)) then
+          L.result "@\n%a" (pp_trace_item ~show_source_context) trace_item )
+
+
+let user_select_issue ~selector_limit report =
+  List.fold_until report
+    ~finish:(fun _ -> ())
+    ~init:0
+    ~f:(fun n issue ->
+      if is_past_limit selector_limit n then Stop ()
+      else (
+        L.result "#%d@\n%a@\n" n TextReport.pp_jsonbug issue ;
+        Continue (n + 1) ) ) ;
+  let rec ask_until_valid_input max_report =
+    L.result "@\nSelect report to display (0-%d) (default: 0): %!" max_report ;
+    let input = In_channel.input_line_exn In_channel.stdin in
+    if String.is_empty input then 0
+    else
+      match int_of_string_opt input with
+      | Some n when n >= 0 && n <= max_report ->
+          n
+      | Some n ->
+          L.progress "Error: %d is not between 0 and %d, try again.@\n%!" n max_report ;
+          ask_until_valid_input max_report
+      | None ->
+          L.progress "Error: please input a number, not '%s'.@\n%!" input ;
+          ask_until_valid_input max_report
+  in
+  let n = ask_until_valid_input (List.length report - 1) in
+  (n, List.nth_exn report n)
+
+
+let explore ~selector_limit ~report_txt:_ ~report_json ~show_source_context ~selected
+    ~max_nested_level =
+  let report = Atdgen_runtime.Util.Json.from_file Jsonbug_j.read_report report_json in
+  let issue_to_display =
+    match (selected, report) with
+    | Some n, _ -> (
+      (* an issue number has been pre-selected, use that *)
+      match List.nth report n with
+      | None ->
+          L.die UserError "Cannot select issues #%d: only %d issues in '%s'" n (List.length report)
+            report_json
+      | Some issue ->
+          Some (n, issue) )
+    | None, [] ->
+        (* empty report, can't print anything *)
+        L.progress "No issues found in '%s', exiting.@\n" report_json ;
+        None
+    | None, [issue] ->
+        (* single-issue report: no need to prompt the user to select which issue to display *)
+        L.progress "Auto-selecting the only issue in '%s'@\n%!" report_json ;
+        Some (0, issue)
+    | None, _ :: _ :: _ ->
+        (* user prompt *)
+        Some (user_select_issue ~selector_limit report)
+  in
+  Option.iter issue_to_display
+    ~f:
+      ( L.result "@\n" ;
+        show_issue_with_trace ~show_source_context ~max_nested_level )

infer/src/integration/TraceBugs.mli

@@ -0,0 +1,16 @@
+(*
+ * Copyright (c) Facebook, Inc. and its affiliates.
+ *
+ * This source code is licensed under the MIT license found in the
+ * LICENSE file in the root directory of this source tree.
+ *)
+open! IStd
+
+val explore :
+     selector_limit:int option
+  -> report_txt:string
+  -> report_json:string
+  -> show_source_context:bool
+  -> selected:int option
+  -> max_nested_level:int option
+  -> unit