diff --git a/infer/src/backend/cluster.ml b/infer/src/backend/cluster.ml index c5ab90a0f..8e7d9abbf 100644 --- a/infer/src/backend/cluster.ml +++ b/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 diff --git a/infer/src/backend/cluster.mli b/infer/src/backend/cluster.mli index f4686e488..de42b1473 100644 --- a/infer/src/backend/cluster.mli +++ b/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 diff --git a/infer/src/backend/clusterMakefile.ml b/infer/src/backend/clusterMakefile.ml index 2d3f5a990..bc8c19120 100644 --- a/infer/src/backend/clusterMakefile.ml +++ b/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 () diff --git a/infer/src/backend/inferanalyze.ml b/infer/src/backend/inferanalyze.ml index 6f88ae689..b2dfb6441 100644 --- a/infer/src/backend/inferanalyze.ml +++ b/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 () diff --git a/infer/src/backend/inferanalyze.mli b/infer/src/backend/inferanalyze.mli new file mode 100644 index 000000000..1ef17bf40 --- /dev/null +++ b/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 *) diff --git a/infer/src/backend/logging.ml b/infer/src/backend/logging.ml index 83efafc3d..1b3244c4a 100644 --- a/infer/src/backend/logging.ml +++ b/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 "." diff --git a/infer/src/backend/logging.mli b/infer/src/backend/logging.mli index 225f2ba1a..948fa336e 100644 --- a/infer/src/backend/logging.mli +++ b/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 diff --git a/infer/src/backend/ondemand.ml b/infer/src/backend/ondemand.ml index 8e4fedcf6..589f65559 100644 --- a/infer/src/backend/ondemand.ml +++ b/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 diff --git a/infer/src/backend/ondemand.mli b/infer/src/backend/ondemand.mli index 5319c5a20..a4a681795 100644 --- a/infer/src/backend/ondemand.mli +++ b/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