Cleanup toplevel InferAnalyze and include procedures in the progress bar.

Summary:public

Cleanup toplevel of InferAnalyze:
- Make the toplevel flow of InferAnalyze more explicit (no exit).
- Always tear down the logging at the end.
- Fix printing of stats to include only the files actually analyzed with --reactive.
- In the progress bar, print F for files and . for procedures.

Example outputs:
Starting analysis (Infer version v0.7.0-b2fb8fc)
F.....
Analyzed 1 file

where it can say 0 if no file was modified.
Or F without dots if a file was modified but no procedure was.

Reviewed By: sblackshear, jvillard

Differential Revision: D3016934

fb-gh-sync-id: 32cf89c
shipit-source-id: 32cf89c

infer/src/backend/cluster.ml

@@ -15,8 +15,8 @@ module F = Format
 (** a cluster is a file *)
 type t = DB.source_dir
 
-(** type stored in .cluster file: (n,m,cl) indicates cl is cluster n out of m *)
-type serializer_t = int * int * t
+(** type stored in .cluster file: (n,cl) indicates cl is cluster n *)
+type serializer_t = int * t
 
 (** Serializer for clusters *)
 let serializer : serializer_t Serialization.serializer =
@@ -34,15 +34,10 @@ let cl_name n = "cl" ^ string_of_int n
 let cl_file n = "x" ^ (cl_name n) ^ ".cluster"
 let pp_cluster_name fmt n = Format.fprintf fmt "%s" (cl_name n)
 
-let pp_cluster nr tot_nr cluster fmt () =
+let pp_cluster fmt (nr, cluster) =
   let fname = cl_file nr in
   let pp_cl fmt n = Format.fprintf fmt "%s" (cl_name n) in
-  store_to_file (DB.filename_from_string fname) (nr, tot_nr, cluster);
+  store_to_file (DB.filename_from_string fname) (nr, cluster);
   F.fprintf fmt "%a: @\n" pp_cl nr;
   F.fprintf fmt "\t$(INFERANALYZE) -cluster %s >%a@\n" fname pp_cl nr;
   F.fprintf fmt "@\n"
-
-let print_clusters clusters =
-  let pp_cluster num =
-    L.err "cluster #%d @." num in
-  IList.iteri (fun i _ -> pp_cluster i) clusters

infer/src/backend/cluster.mli

@@ -7,7 +7,6 @@
  * of patent rights can be found in the PATENTS file in the same directory.
  *)
 
-module L = Logging
 module F = Format
 
 (** Module to process clusters of procedures. *)
@@ -15,17 +14,14 @@ module F = Format
 (** a cluster is a file *)
 type t = DB.source_dir
 
-(** type stored in .cluster file: (n,m,cl) indicates cl is cluster n out of m *)
-type serializer_t = int * int * t
+(** type stored in .cluster file: (n,cl) indicates cl is cluster n *)
+type serializer_t = int * t
 
 (** Load a cluster from a file *)
 val load_from_file : DB.filename -> serializer_t option
 
 (** Print a cluster *)
-val pp_cluster : int -> int -> t -> F.formatter -> unit -> unit
+val pp_cluster : F.formatter -> serializer_t -> unit
 
 (** Print a cluster name *)
 val pp_cluster_name : F.formatter -> int -> unit
-
-(** Print clusters *)
-val print_clusters : t list -> unit

infer/src/backend/clusterMakefile.ml

@@ -20,59 +20,59 @@ let source_file_from_pname pname =
 let source_file_to_pname fname =
   Procname.from_string_c_fun (DB.source_file_to_string fname)
 
+let cluster_should_be_analyzed cluster =
+  let fname = DB.source_dir_to_string cluster in
+  let in_ondemand_config =
+    match Lazy.force Ondemand.dirs_to_analyze with
+    | None ->
+        None
+    | Some set ->
+        Some (StringSet.mem fname set) in
+  let check_modified () =
+    let modified =
+      DB.file_was_updated_after_start (DB.filename_from_string fname) in
+    if modified &&
+       !Config.developer_mode
+    then L.stdout "Modified: %s@." fname;
+    modified in
+  begin
+    match in_ondemand_config with
+    | Some b -> (* ondemand config file is specified *)
+        b
+    | None when !Config.reactive_mode  ->
+        check_modified ()
+    | None ->
+        true
+  end
+
+
 let pp_prolog fmt clusters =
   F.fprintf fmt "INFERANALYZE= %s $(INFER_OPTIONS) -results_dir '%s'\n@."
     Sys.executable_name
-    (Escape.escape_map (fun c -> if c = '#' then Some "\\#" else None) !Config.results_dir);
-  F.fprintf fmt "OBJECTS=";
-  let filter source_dir =
-    let fname = DB.source_dir_to_string source_dir in
-    let in_ondemand_config =
-      match Ondemand.read_dirs_to_analyze () with
-      | None ->
-          None
-      | Some set ->
-          Some (StringSet.mem fname set) in
-    let check_modified () =
-      let modified =
-        DB.file_was_updated_after_start (DB.filename_from_string fname) in
-      if modified &&
-         !Config.developer_mode
-      then L.stdout "Modified: %s@." fname;
-      modified in
-    begin
-      match in_ondemand_config with
-      | Some b -> (* ondemand config file is specified *)
-          b
-      | None when !Config.reactive_mode  ->
-          check_modified ()
-      | None ->
-          true
-    end in
+    (Escape.escape_map
+       (fun c -> if c = '#' then Some "\\#" else None)
+       !Config.results_dir);
+  F.fprintf fmt "CLUSTERS=";
+
   IList.iteri
     (fun i cl ->
-       if filter cl then F.fprintf fmt "%a " Cluster.pp_cluster_name (i+1))
+       if cluster_should_be_analyzed cl
+       then F.fprintf fmt "%a " Cluster.pp_cluster_name (i+1))
     clusters;
+
   F.fprintf fmt "@.@.default: test@.@.all: test@.@.";
-  F.fprintf fmt "test: $(OBJECTS)@.";
+  F.fprintf fmt "test: $(CLUSTERS)@.";
   if !Config.show_progress_bar then F.fprintf fmt "\techo \"\"@."
 
 let pp_epilog fmt () =
-  F.fprintf fmt "@.clean:@.\trm -f $(OBJECTS)@."
+  F.fprintf fmt "@.clean:@.\trm -f $(CLUSTERS)@."
 
-let create_cluster_makefile_and_exit
-    (clusters: Cluster.t list) (fname: string) =
+let create_cluster_makefile (clusters: Cluster.t list) (fname: string) =
   let outc = open_out fname in
   let fmt = Format.formatter_of_out_channel outc in
-  let cluster_nr = ref 0 in
-  let tot_clusters_nr = IList.length clusters in
-  let do_cluster cluster =
-    incr cluster_nr;
-    let do_file source_dir =
-      F.fprintf fmt "#%s@\n" (DB.source_dir_to_string source_dir) in
-    do_file cluster;
-    Cluster.pp_cluster !cluster_nr tot_clusters_nr cluster fmt () in
+  let do_cluster cluster_nr cluster =
+    F.fprintf fmt "#%s@\n" (DB.source_dir_to_string cluster);
+    Cluster.pp_cluster fmt (cluster_nr + 1, cluster) in
   pp_prolog fmt clusters;
-  IList.iter do_cluster clusters;
-  pp_epilog fmt ();
-  exit 0
+  IList.iteri do_cluster clusters;
+  pp_epilog fmt ()

infer/src/backend/inferanalyze.ml

@@ -13,35 +13,6 @@
 module L = Logging
 module F = Format
 
-(* This module, unused by default, generates random c files with procedure calls *)
-module Codegen = struct
-  let num_files = 5000
-  let num_functions = 1000
-  let calls_per_fun = 5
-  let fun_nr = ref 0
-
-  let gen () =
-    for file_nr = 1 to num_files do
-      let fname = Printf.sprintf "file%04d.c" file_nr in
-      let fmt = open_out fname in
-      for _ = 1 to num_functions do
-        incr fun_nr;
-        let num_calls = if !fun_nr = 1 then 0 else Random.int calls_per_fun in
-        Printf.fprintf fmt "void f%04d() {\n" !fun_nr;
-        for _ = 1 to num_calls do
-          let callee_nr = 1 + Random.int (max 1 (num_calls - 1)) in
-          Printf.fprintf fmt "f%04d();\n" callee_nr
-        done;
-        Printf.fprintf fmt "}\n";
-      done;
-      close_out fmt
-    done
-
-  let dont () =
-    gen ();
-    exit 0
-end
-
 (** command line option: if true, run the analysis in checker mode *)
 let checkers = ref false
 
@@ -255,7 +226,7 @@ let () = (* parse command-line arguments *)
 
 let analyze_exe_env exe_env =
   let init_time = Unix.gettimeofday () in
-  L.log_progress_simple ".";
+  L.log_progress_file ();
   Specs.clear_spec_tbl ();
   Random.self_init ();
   let line_reader = Printer.LineReader.create () in
@@ -273,16 +244,6 @@ let analyze_exe_env exe_env =
       L.out "Interprocedural footprint analysis terminated in %f sec@." elapsed
     end
 
-let output_json_file_stats num_files num_procs num_lines =
-  let file_stats =
-    `Assoc [ ("files", `Int num_files);
-             ("procedures", `Int num_procs);
-             ("lines", `Int num_lines) ] in
-  (* write stats file to disk, intentionally overwriting old file if it already exists *)
-  let f = open_out (Filename.concat !Config.results_dir Config.proc_stats_filename) in
-  Yojson.Basic.pretty_to_channel f file_stats
-
-
 (** Create an exe_env from a cluster. *)
 let exe_env_from_cluster cluster =
   let _exe_env = Exe_env.create () in
@@ -293,28 +254,14 @@ let exe_env_from_cluster cluster =
   exe_env
 
 (** Analyze a cluster of files *)
-let analyze_cluster cluster_num tot_clusters (cluster : Cluster.t) =
-  let cluster_num_ref = ref cluster_num in
-  incr cluster_num_ref;
+let analyze_cluster cluster_num (cluster : Cluster.t) =
   let exe_env = exe_env_from_cluster cluster in
   let defined_procs = Cg.get_defined_nodes (Exe_env.get_cg exe_env) in
   let num_procs = IList.length defined_procs in
-  L.err "@.Processing cluster #%d/%d with %d procedures@."
-    !cluster_num_ref tot_clusters num_procs;
+  L.err "@.Processing cluster #%d with %d procedures@."
+    (cluster_num + 1) num_procs;
   analyze_exe_env exe_env
 
-let process_cluster_cmdline_exit () =
-  match !cluster_cmdline with
-  | None -> ()
-  | Some fname ->
-      (match Cluster.load_from_file (DB.filename_from_string fname) with
-       | None ->
-           L.err "Cannot find cluster file %s@." fname;
-           exit 0
-       | Some (nr, tot_nr, cluster) ->
-           analyze_cluster (nr - 1) tot_nr cluster;
-           exit 0)
-
 let open_output_file f fname =
   try
     let cout = open_out fname in
@@ -355,17 +302,19 @@ let teardown_logging analyzer_out_of analyzer_err_of =
       close_output_file analyzer_err_of;
     end
 
-(** Compute clusters.
-    Each cluster will contain only the name of the directory for a file. *)
-let compute_clusters clusters =
-  Cluster.print_clusters clusters;
-  let num_files = IList.length clusters in
+let output_json_makefile_stats clusters =
+  let clusters_to_analyze =
+    IList.filter ClusterMakefile.cluster_should_be_analyzed clusters in
+  let num_files = IList.length clusters_to_analyze in
   let num_procs = 0 (* can't compute it at this stage *) in
   let num_lines = 0 in
-  output_json_file_stats num_files num_procs num_lines;
-  if !makefile_cmdline <> ""
-  then ClusterMakefile.create_cluster_makefile_and_exit clusters !makefile_cmdline;
-  clusters
+  let file_stats =
+    `Assoc [ ("files", `Int num_files);
+             ("procedures", `Int num_procs);
+             ("lines", `Int num_lines) ] in
+  (* write stats file to disk, intentionally overwriting old file if it already exists *)
+  let f = open_out (Filename.concat !Config.results_dir Config.proc_stats_filename) in
+  Yojson.Basic.pretty_to_channel f file_stats
 
 let print_prolog () =
   match !cluster_cmdline with
@@ -373,6 +322,13 @@ let print_prolog () =
       L.stdout "Starting analysis (Infer version %s)@." Version.versionString;
   | Some clname -> L.stdout "Cluster %s@." clname
 
+let process_cluster_cmdline fname =
+  match Cluster.load_from_file (DB.filename_from_string fname) with
+  | None ->
+      L.err "Cannot find cluster file %s@." fname
+  | Some (nr, cluster) ->
+      analyze_cluster (nr - 1)  cluster
+
 let () =
   print_prolog ();
   RegisterCheckers.register ();
@@ -383,15 +339,28 @@ let () =
 
   let analyzer_out_of, analyzer_err_of = setup_logging () in
   if (!Config.curr_language = Config.C_CPP) then Mleak_buckets.init_buckets !ml_buckets_arg;
+  let finish_logging () =
+    teardown_logging analyzer_out_of analyzer_err_of in
 
-  process_cluster_cmdline_exit ();
-
-  let source_dirs = DB.find_source_dirs () in
-  L.err "Found %d source files in %s@." (IList.length source_dirs) !Config.results_dir;
-
-  let clusters = compute_clusters source_dirs in
+  match !cluster_cmdline with
+  | Some fname ->
+      process_cluster_cmdline fname;
+      finish_logging ()
+  | None ->
+      let clusters = DB.find_source_dirs () in
+      L.err "Found %d source files in %s@."
+        (IList.length clusters) !Config.results_dir;
+
+      if !makefile_cmdline <> ""
+      then
+        ClusterMakefile.create_cluster_makefile clusters !makefile_cmdline
+      else
+        begin
+          IList.iteri
+            (fun i cluster -> analyze_cluster i cluster)
+            clusters;
+          L.stdout "Analysis finished in %as@." pp_elapsed_time ()
+        end;
+      output_json_makefile_stats clusters;
+      finish_logging ()
 
-  let tot_clusters = IList.length clusters in
-  IList.iter (analyze_cluster 0 tot_clusters) clusters;
-  teardown_logging analyzer_out_of analyzer_err_of;
-  if !cluster_cmdline = None then L.stdout "Analysis finished in %as@." pp_elapsed_time ()

infer/src/backend/inferanalyze.mli

@@ -0,0 +1,11 @@
+(*
+ * Copyright (c) 2009 - 2013 Monoidics ltd.
+ * Copyright (c) 2013 - present Facebook, Inc.
+ * All rights reserved.
+ *
+ * This source code is licensed under the BSD style license found in the
+ * LICENSE file in the root directory of this source tree. An additional grant
+ * of patent rights can be found in the PATENTS file in the same directory.
+ *)
+
+(** Main module for the analysis after the capture phase *)

infer/src/backend/logging.ml

@@ -172,13 +172,12 @@ let d_increase_indent (indent: int) =
 let d_decrease_indent (indent: int) =
   add_print_action (PTdecrease_indent, Obj.repr indent)
 
-let log_progress text counter total =
-  if !Config.show_progress_bar then
-    (counter := !counter + 1;
-     let percentage = (100 * !counter) / total in
-     F.fprintf Format.err_formatter "%s %d%s" text percentage "%\r";
-     F.fprintf Format.err_formatter "@?")
-
 let log_progress_simple text =
   if !Config.show_progress_bar then
     F.fprintf Format.err_formatter "%s@?" text
+
+let log_progress_file () =
+  log_progress_simple "F"
+
+let log_progress_procedure () =
+  log_progress_simple "."

infer/src/backend/logging.mli

@@ -130,6 +130,8 @@ val d_increase_indent : int -> unit
 (** dump command to decrease the indentation level *)
 val d_decrease_indent : int -> unit
 
-val log_progress : string -> int ref -> int -> unit
+(** Progress bar: start of the analysis of a file. *)
+val log_progress_file : unit -> unit
 
-val log_progress_simple : string -> unit
+(** Progress bar: start of the analysis of a procedure. *)
+val log_progress_procedure : unit -> unit

infer/src/backend/ondemand.ml

@@ -20,8 +20,10 @@ let ondemand_file () = Config.get_env_variable "INFER_ONDEMAND_FILE"
 (** Read the directories to analyze from the ondemand file. *)
 let read_dirs_to_analyze () =
   let lines_opt = match ondemand_file () with
-    | None -> None
-    | Some fname ->read_file fname in
+    | None ->
+        None
+    | Some fname ->
+        read_file fname in
   match lines_opt with
   | None ->
       None
@@ -33,6 +35,10 @@ let read_dirs_to_analyze () =
       IList.iter do_line lines;
       Some !res
 
+(** Directories to analyze from the ondemand file. *)
+let dirs_to_analyze =
+  lazy (read_dirs_to_analyze ())
+
 type analyze_ondemand = Procname.t -> unit
 
 type get_cfg = Procname.t -> Cfg.cfg option
@@ -118,6 +124,8 @@ let do_analysis ~propagate_exceptions curr_pdesc callee_pname =
   let curr_pname = Cfg.Procdesc.get_proc_name curr_pdesc in
 
   let really_do_analysis callee_pdesc analyze_proc =
+    (** Dot means start of a procedure *)
+    L.log_progress_procedure ();
     if trace () then L.stderr "[%d] really_do_analysis %a -> %a@."
         !nesting
         Procname.pp curr_pname

infer/src/backend/ondemand.mli

@@ -10,7 +10,7 @@
 (** Module for on-demand analysis. *)
 
 (** Optional set of source dirs to analyze in on-demand mode. *)
-val read_dirs_to_analyze : unit -> StringSet.t option
+val dirs_to_analyze : StringSet.t option Lazy.t
 
 type analyze_ondemand = Procname.t -> unit