[sqlite] infer explore --source-files

Summary:
Add a `--source-files` option to `infer explore` to print information about the source files captured by infer.
More precisely, `infer explore --source-files` will print each row of the "source_files" table in the results database.
Option `--source-files-filter` can be used to filter output to file names matching an SQLite "LIKE" pattern.
Flags `--source-files-cfgs`, `--source-files-type-environment`, `--source-files-procedure-names` and `--source-files-freshly-captured` control which columns to print.

The printers for some existing types have been tweaked to improve the output.

Reviewed By: jvillard

Differential Revision: D7735535

fbshipit-source-id: 572389a

infer/src/IR/Cfg.ml

@@ -200,9 +200,10 @@ let inline_java_synthetic_methods cfg =
 
 
 let pp_proc_signatures fmt cfg =
-  F.fprintf fmt "METHOD SIGNATURES@\n@." ;
+  F.fprintf fmt "@[<v>METHOD SIGNATURES@;" ;
   let sorted_procs = List.sort ~compare:Procdesc.compare (get_all_proc_descs cfg) in
-  List.iter ~f:(fun pdesc -> F.fprintf fmt "%a@." Procdesc.pp_signature pdesc) sorted_procs
+  List.iter ~f:(Procdesc.pp_signature fmt) sorted_procs ;
+  F.fprintf fmt "@]"
 
 
 let merge ~src ~dst =

infer/src/IR/Procdesc.ml

@@ -195,7 +195,7 @@ module Node = struct
       | Join_node ->
           "Join"
     in
-    let pp fmt = F.fprintf fmt "%s@\n%a@?" str (pp_instrs pe None ~sub_instrs:true) node in
+    let pp fmt = F.fprintf fmt "%s@.%a" str (pp_instrs pe None ~sub_instrs:true) node in
     F.asprintf "%t" pp
 end
 
@@ -441,7 +441,7 @@ let pp_signature fmt pdesc =
   let pname = get_proc_name pdesc in
   let pname_string = Typ.Procname.to_string pname in
   let defined_string = match is_defined pdesc with true -> "defined" | false -> "undefined" in
-  Format.fprintf fmt "%s [%s, Return type: %s, %aFormals: %a, Locals: %a" pname_string
+  Format.fprintf fmt "@[%s [%s, Return type: %s, %aFormals: %a, Locals: %a" pname_string
     defined_string
     (Typ.to_string (get_ret_type pdesc))
     pp_objc_accessor attributes.ProcAttributes.objc_accessor pp_variable_list (get_formals pdesc)
@@ -451,7 +451,7 @@ let pp_signature fmt pdesc =
   let method_annotation = attributes.ProcAttributes.method_annotation in
   if not (Annot.Method.is_empty method_annotation) then
     Format.fprintf fmt ", Annotation: %a" (Annot.Method.pp pname_string) method_annotation ;
-  Format.fprintf fmt "]@\n"
+  Format.fprintf fmt "]@]@;"
 
 
 let is_specialized pdesc =

infer/src/IR/SourceFiles.ml

@@ -7,6 +7,7 @@
  * of patent rights can be found in the PATENTS file in the same directory.
  *)
 open! IStd
+module F = Format
 module L = Logging
 
 let store_statement =
@@ -128,14 +129,18 @@ let is_freshly_captured_statement =
     "SELECT freshly_captured FROM source_files WHERE source_file = :k"
 
 
+let deserialize_freshly_captured = function[@warning "-8"]
+  | Sqlite3.Data.INT p ->
+      Int64.equal p Int64.one
+
+
 let is_freshly_captured source =
   ResultsDatabase.with_registered_statement is_freshly_captured_statement ~f:(fun db load_stmt ->
       SourceFile.SQLite.serialize source |> Sqlite3.bind load_stmt 1
       |> SqliteUtils.check_sqlite_error db ~log:"load bind source file" ;
       SqliteUtils.sqlite_result_step ~finalize:false ~log:"SourceFiles.is_freshly_captured" db
         load_stmt
-      |> Option.value_map ~default:false ~f:(function [@warning "-8"] Sqlite3.Data.INT p ->
+      |> Option.value_map ~default:false ~f:deserialize_freshly_captured )
-             Int64.equal p Int64.one ) )
 
 
 let mark_all_stale_statement =
@@ -145,3 +150,46 @@ let mark_all_stale_statement =
 let mark_all_stale () =
   ResultsDatabase.with_registered_statement mark_all_stale_statement ~f:(fun db stmt ->
       SqliteUtils.sqlite_unit_step db ~finalize:false ~log:"mark_all_stale" stmt )
+
+
+let select_all_source_files_statement =
+  ResultsDatabase.register_statement
+    "SELECT * FROM source_files WHERE source_file LIKE :source_file_like"
+
+
+let pp_all ?(filter= "%") ~cfgs ~type_environment ~procedure_names ~freshly_captured fmt () =
+  ResultsDatabase.with_registered_statement select_all_source_files_statement ~f:(fun db stmt ->
+      Sqlite3.bind stmt 1 (* :source_file_like *) (Sqlite3.Data.TEXT filter)
+      |> SqliteUtils.check_sqlite_error db ~log:"source files filter" ;
+      let pp_procnames fmt procs =
+        F.fprintf fmt "@[<v>" ;
+        List.iter ~f:(F.fprintf fmt "%a@," Typ.Procname.pp) procs ;
+        F.fprintf fmt "@]"
+      in
+      let pp_if title condition deserialize pp fmt column =
+        if condition then
+          F.fprintf fmt "  @[<v2>%s@,%a@]@;" title pp (Sqlite3.column stmt column |> deserialize)
+      in
+      let rec aux fmt () =
+        match Sqlite3.step stmt with
+        | Sqlite3.Rc.ROW ->
+            F.fprintf fmt "%a@,%a%a%a%a" SourceFile.pp
+              (Sqlite3.column stmt 0 |> SourceFile.SQLite.deserialize)
+              (pp_if "cfgs" cfgs Cfg.SQLite.deserialize Cfg.pp_proc_signatures)
+              1
+              (pp_if "type_environment" type_environment Tenv.SQLite.deserialize Tenv.pp_per_file)
+              2
+              (pp_if "procedure_names" procedure_names Typ.Procname.SQLiteList.deserialize
+                 pp_procnames)
+              3
+              (pp_if "freshly_captured" freshly_captured deserialize_freshly_captured
+                 Format.pp_print_bool)
+              4 ;
+            aux fmt ()
+        | DONE ->
+            ()
+        | err ->
+            L.die InternalError "source_files_iter: %s (%s)" (Sqlite3.Rc.to_string err)
+              (Sqlite3.errmsg db)
+      in
+      Format.fprintf fmt "@[<v>%a@]" aux () )

infer/src/IR/SourceFiles.mli

@@ -27,3 +27,7 @@ val is_freshly_captured : SourceFile.t -> bool
 
 val mark_all_stale : unit -> unit
 (** mark all source files as stale; do be called at the start of a new capture phase *)
+
+val pp_all :
+  ?filter:string -> cfgs:bool -> type_environment:bool -> procedure_names:bool
+  -> freshly_captured:bool -> Format.formatter -> unit -> unit

infer/src/IR/Tenv.ml

@@ -27,8 +27,8 @@ type t = Typ.Struct.t TypenameHash.t
 let pp fmt (tenv: t) =
   TypenameHash.iter
     (fun name typ ->
-      Format.fprintf fmt "@[<6>NAME: %s@." (Typ.Name.to_string name) ;
+      Format.fprintf fmt "@[<6>NAME: %s@]@," (Typ.Name.to_string name) ;
-      Format.fprintf fmt "@[<6>TYPE: %a@." (Typ.Struct.pp Pp.text name) typ )
+      Format.fprintf fmt "@[<6>TYPE: %a@]@," (Typ.Struct.pp Pp.text name) typ )
     tenv
 
 
@@ -74,6 +74,13 @@ let add_field tenv class_tn_name field =
 
 type per_file = Global | FileLocal of t
 
+let pp_per_file fmt = function
+  | Global ->
+      Format.fprintf fmt "Global"
+  | FileLocal tenv ->
+      Format.fprintf fmt "FileLocal @[<v>%a@]" pp tenv
+
+
 module SQLite : SqliteUtils.Data with type t = per_file = struct
   type t = per_file
 

infer/src/IR/Tenv.mli

@@ -48,6 +48,10 @@ val language_is : t -> Language.t -> bool
 
 type per_file = Global | FileLocal of t
 
+val pp_per_file : Format.formatter -> per_file -> unit
+  [@@warning "-32"]
+(** print per file type environment *)
+
 val merge : src:per_file -> dst:per_file -> per_file
 (** Best-effort merge of [src] into [dst]. If a procedure is both in [dst] and [src], the one in
    [src] will get overwritten. *)

infer/src/base/Config.ml

@@ -1896,6 +1896,46 @@ and source_preview =
     "print code excerpts around trace elements"
 
 
+and source_files =
+  CLOpt.mk_bool ~long:"source-files"
+    ~in_help:InferCommand.[(Explore, manual_generic)]
+    "Print source files discovered by infer"
+
+
+and source_files_filter =
+  CLOpt.mk_string_opt ~long:"source-files-filter" ~meta:"filter"
+    ~in_help:InferCommand.[(Explore, manual_generic)]
+    "With $(b,--source-files), only print source files matching the specified $(i,filter). The \
+     filter is a pattern that should match the file path. Patterns are interpreted by SQLite: use \
+     $(b,_) to match any one character and $(b,%) to match any  sequence of characters. For \
+     instance, \"lib/%.c\" matches only C files in the lib directory."
+
+
+and source_files_cfgs =
+  CLOpt.mk_bool ~long:"source-files-cfgs"
+    ~in_help:InferCommand.[(Explore, manual_generic)]
+    "Print the Cfgs of each source file in the output of $(b,--source-files)"
+
+
+and source_files_type_environment =
+  CLOpt.mk_bool ~long:"source-files-type-environment"
+    ~in_help:InferCommand.[(Explore, manual_generic)]
+    "Print the type environment of each source file in the output of $(b,--source-files)"
+
+
+and source_files_procedure_names =
+  CLOpt.mk_bool ~long:"source-files-procedure-names"
+    ~in_help:InferCommand.[(Explore, manual_generic)]
+    "Print the names of procedure of each source file in the output of $(b,--source-files)"
+
+
+and source_files_freshly_captured =
+  CLOpt.mk_bool ~long:"source-files-freshly-captured"
+    ~in_help:InferCommand.[(Explore, manual_generic)]
+    "Print whether the source file has been captured in the most recent capture phase in the \
+     output of $(b,--source-files)."
+
+
 and sources = CLOpt.mk_string_list ~long:"sources" "Specify the list of source files"
 
 and sourcepath = CLOpt.mk_string_opt ~long:"sourcepath" "Specify the sourcepath"
@@ -2729,6 +2769,18 @@ and skip_translation_headers = !skip_translation_headers
 
 and source_preview = !source_preview
 
+and source_files = !source_files
+
+and source_files_filter = !source_files_filter
+
+and source_files_cfgs = !source_files_cfgs
+
+and source_files_type_environment = !source_files_type_environment
+
+and source_files_procedure_names = !source_files_procedure_names
+
+and source_files_freshly_captured = !source_files_freshly_captured
+
 and sources = !sources
 
 and sourcepath = !sourcepath

infer/src/base/Config.mli

@@ -210,6 +210,18 @@ val smt_output : bool
 
 val source_file_extentions : string list
 
+val source_files : bool
+
+val source_files_filter : string option
+
+val source_files_cfgs : bool
+
+val source_files_type_environment : bool
+
+val source_files_procedure_names : bool
+
+val source_files_freshly_captured : bool
+
 val sources : string list
 
 val sourcepath : string option

infer/src/infer.ml

@@ -154,6 +154,13 @@ let () =
             ~attr_kind:procedures_definedness ~source_file:procedures_source_file
             ~proc_attributes:procedures_attributes)
         ()
+  | Explore when Config.source_files ->
+      L.result "%a"
+        (SourceFiles.pp_all ?filter:Config.source_files_filter ~cfgs:Config.source_files_cfgs
+           ~type_environment:Config.source_files_type_environment
+           ~procedure_names:Config.source_files_procedure_names
+           ~freshly_captured:Config.source_files_freshly_captured)
+        ()
   | Explore ->
       let if_some key opt args =
         match opt with None -> args | Some arg -> key :: string_of_int arg :: args