[debug] new option --procedures-summary-json

Summary:
Output summaries in json format, so that other tools can exploit the
results of infer without having to be written inside infer itself.

For now the json for a summary is just one line saying "opaque" :)

Set up the infra to generate (yo)json automatically using
ppx_yojson_conv. See it in action in the next diff.

Reviewed By: ezgicicek

Differential Revision: D24503343

fbshipit-source-id: e24a2fff3

infer/man/man1/infer-debug.txt

@@ -80,6 +80,10 @@ DEBUG PROCEDURES
        --procedures-summary
            Activates: Print the summaries of each procedure in the output of
            --procedures (Conversely: --no-procedures-summary)
+
+       --procedures-summary-json
+           Activates: Emit the summaries of each procedure in the output of
+           --procedures as JSON (Conversely: --no-procedures-summary-json)
 DEBUG SOURCE FILES
        --source-files
            Activates: Print source files discovered by infer (Conversely:

infer/man/man1/infer-full.txt

@@ -884,6 +884,11 @@ OPTIONS
            Activates: Print the summaries of each procedure in the output of
            --procedures (Conversely: --no-procedures-summary)           See also infer-debug(1).
 
+       --procedures-summary-json
+           Activates: Emit the summaries of each procedure in the output of
+           --procedures as JSON (Conversely: --no-procedures-summary-json)       
+    See also infer-debug(1).
+
        --no-progress-bar,-P
            Deactivates: Show a progress bar (Conversely: --progress-bar | -p)       
     See also infer-run(1).

infer/man/man1/infer.txt

@@ -884,6 +884,11 @@ OPTIONS
            Activates: Print the summaries of each procedure in the output of
            --procedures (Conversely: --no-procedures-summary)           See also infer-debug(1).
 
+       --procedures-summary-json
+           Activates: Emit the summaries of each procedure in the output of
+           --procedures as JSON (Conversely: --no-procedures-summary-json)       
+    See also infer-debug(1).
+
        --no-progress-bar,-P
            Deactivates: Show a progress bar (Conversely: --progress-bar | -p)       
     See also infer-run(1).

infer/src/backend/Payloads.ml

@@ -27,6 +27,8 @@ type t =
   ; uninit: UninitDomain.Summary.t option }
 [@@deriving fields]
 
+let yojson_of_t = [%yojson_of: _]
+
 type 'a pp = Pp.env -> F.formatter -> 'a -> unit
 
 type field = F : {field: (t, 'a option) Field.t; name: string; pp: 'a pp} -> field

infer/src/backend/Payloads.mli

@@ -29,7 +29,7 @@ include sig
     ; starvation: StarvationDomain.summary option
     ; nullsafe: NullsafeSummary.t option
     ; uninit: UninitDomain.Summary.t option }
-  [@@deriving fields]
+  [@@deriving fields, yojson_of]
 end
 
 val pp : Pp.env -> Format.formatter -> t -> unit

infer/src/backend/Summary.ml

@@ -68,6 +68,8 @@ include struct
   [@@deriving fields]
 end
 
+let yojson_of_t {payloads} = [%yojson_of: Payloads.t] payloads
+
 type full_summary = t
 
 let get_status summary = summary.status

infer/src/backend/Summary.mli

@@ -42,6 +42,7 @@ type t =
             after per-procedure analysis). This latter category of errors should NOT be written
             here, use [IssueLog] and its serialization capabilities instead. *)
   ; mutable callee_pnames: Procname.Set.t }
+[@@deriving yojson_of]
 
 val get_proc_name : t -> Procname.t
 (** Get the procedure name *)

infer/src/backend/dune

@@ -14,7 +14,7 @@
  (libraries core IStdlib ATDGenerated IBase IR Absint Biabduction Nullsafe BO
    Checkers Costlib Quandary TOPLlib Concurrency Labs)
  (preprocess
-  (pps ppx_compare ppx_fields_conv)))
+  (pps ppx_compare ppx_fields_conv ppx_yojson_conv)))
 
 (documentation
  (package infer)

infer/src/base/Config.ml

@@ -1792,6 +1792,12 @@ and procedures_summary =
     "Print the summaries of each procedure in the output of $(b,--procedures)"
 
 
+and procedures_summary_json =
+  CLOpt.mk_bool ~long:"procedures-summary-json" ~default:false
+    ~in_help:InferCommand.[(Debug, manual_debug_procedures)]
+    "Emit the summaries of each procedure in the output of $(b,--procedures) as JSON"
+
+
 and process_clang_ast =
   CLOpt.mk_bool ~long:"process-clang-ast" ~default:false
     "process the ast to emit some info about the file (Not available for Java)"
@@ -2998,6 +3004,8 @@ and procedures_source_file = !procedures_source_file
 
 and procedures_summary = !procedures_summary
 
+and procedures_summary_json = !procedures_summary_json
+
 and process_clang_ast = !process_clang_ast
 
 and progress_bar =

infer/src/base/Config.mli

@@ -439,6 +439,8 @@ val procedures_source_file : bool
 
 val procedures_summary : bool
 
+val procedures_summary_json : bool
+
 val process_clang_ast : bool
 
 val clang_frontend_action_string : string

infer/src/deadcode/dune.in

@@ -14,4 +14,4 @@
  (modules All_infer_in_one_file)
  (preprocess
   (pps ppx_blob ppx_compare ppx_enumerate ppx_fields_conv ppx_hash
-    ppx_sexp_conv ppx_variants_conv -no-check)))
+    ppx_sexp_conv ppx_variants_conv ppx_yojson_conv -no-check)))

infer/src/infer.ml

@@ -6,12 +6,12 @@
  *)
 
 open! IStd
-
-(** Top-level driver that orchestrates build system integration, frontends, backend, and reporting *)
-
+module F = Format
 module CLOpt = CommandLineOption
 module L = Logging
 
+(** Top-level driver that orchestrates build system integration, frontends, backend, and reporting *)
+
 let run driver_mode =
   let open Driver in
   run_prologue driver_mode ;
@@ -223,16 +223,28 @@ let () =
             L.result "Global type environment:@\n@[<v>%a@]" Tenv.pp tenv ) ;
       ( if Config.procedures then
         let filter = Lazy.force Filtering.procedures_filter in
-        if Config.procedures_summary then
-          let pp_summary fmt proc_name =
-            match Summary.OnDisk.get proc_name with
-            | None ->
-                Format.fprintf fmt "No summary found: %a@\n" Procname.pp proc_name
-            | Some summary ->
-                Summary.pp_text fmt summary
+        if Config.procedures_summary || Config.procedures_summary_json then
+          let f_console_output proc_names =
+            let pp_summary fmt proc_name =
+              match Summary.OnDisk.get proc_name with
+              | None ->
+                  F.fprintf fmt "No summary found: %a@\n" Procname.pp proc_name
+              | Some summary ->
+                  Summary.pp_text fmt summary
+            in
+            L.result "%t" (fun fmt -> List.iter proc_names ~f:(pp_summary fmt))
+          in
+          let json_of_summary proc_name =
+            Summary.OnDisk.get proc_name |> Option.map ~f:Summary.yojson_of_t
+          in
+          let f_json proc_names =
+            Yojson.Safe.to_channel stdout (`List (List.filter_map ~f:json_of_summary proc_names)) ;
+            Out_channel.newline stdout ;
+            Out_channel.flush stdout
           in
-          Option.iter (Procedures.select_proc_names_interactive ~filter) ~f:(fun proc_names ->
-              L.result "%a" (fun fmt () -> List.iter proc_names ~f:(pp_summary fmt)) () )
+          Option.iter
+            (Procedures.select_proc_names_interactive ~filter)
+            ~f:(if Config.procedures_summary_json then f_json else f_console_output)
         else
           L.result "%a"
             Config.(

opam

@@ -44,6 +44,7 @@ depends: [
   "ppx_enumerate" {>= "v0.14.0" & < "v0.15"}
   "ppx_expect" {>= "v0.14.0" & < "v0.15"}
   "ppx_fields_conv" {>= "v0.14.0" & < "v0.15"}
+  "ppx_yojson_conv" {>= "v0.14.0" & < "v0.15"}
   "sawja" {>="1.5.8"}
   "sqlite3"
   "utop" {with-test}

opam.locked

@@ -60,7 +60,6 @@ depends: [
   "extlib" {= "1.7.7"}
   "fieldslib" {= "v0.14.0"}
   "integers" {= "0.4.0"}
-  "iter" {= "1.2.1"}
   "jane-street-headers" {= "v0.14.0"}
   "javalib" {= "3.2.1"}
   "jst-config" {= "v0.14.0"}
@@ -115,6 +114,8 @@ depends: [
   "ppx_tools" {= "6.2"}
   "ppx_typerep_conv" {= "v0.14.1"}
   "ppx_variants_conv" {= "v0.14.1"}
+  "ppx_yojson_conv" {= "v0.14.0"}
+  "ppx_yojson_conv_lib" {= "v0.14.0"}
   "ppxfind" {= "1.4"}
   "ppxlib" {= "0.15.0"}
   "protocol_version_header" {= "v0.14.0"}