diff --git a/infer/src/IR/AttributesTable.re b/infer/src/IR/AttributesTable.re index 82ba499bf..26012e67d 100644 --- a/infer/src/IR/AttributesTable.re +++ b/infer/src/IR/AttributesTable.re @@ -18,7 +18,7 @@ let module L = Logging; /** Module to manage the table of attributes. */ -let serializer: Serialization.serializer ProcAttributes.t = Serialization.create_serializer Serialization.attributes_key; +let serializer: Serialization.serializer ProcAttributes.t = Serialization.create_serializer Serialization.Key.attributes; let attributes_filename defined::defined pname_file => pname_file ^ (defined ? ".attr" : ".decl.attr"); @@ -50,9 +50,9 @@ let load_attr defined_only::defined_only proc_name => { let attributes_file defined::defined proc_name => Multilinks.resolve ( res_dir_attr_filename defined::defined proc_name ); - let attr = Serialization.from_file serializer (attributes_file defined::true proc_name); + let attr = Serialization.read_from_file serializer (attributes_file defined::true proc_name); if (is_none attr && not defined_only) { - Serialization.from_file serializer (attributes_file defined::false proc_name) + Serialization.read_from_file serializer (attributes_file defined::false proc_name) } else { attr } @@ -62,7 +62,8 @@ let load_attr defined_only::defined_only proc_name => { If defined, delete the declared file if it exists. */ let write_and_delete proc_name (proc_attributes: ProcAttributes.t) => { let attributes_file defined => res_dir_attr_filename defined::defined proc_name; - Serialization.to_file serializer (attributes_file proc_attributes.is_defined) proc_attributes; + Serialization.write_to_file + serializer (attributes_file proc_attributes.is_defined) proc_attributes; if proc_attributes.is_defined { let fname_declared = DB.filename_to_string (attributes_file false); if (Sys.file_exists fname_declared == `Yes) { diff --git a/infer/src/IR/Cfg.re b/infer/src/IR/Cfg.re index 6df00c230..304c2fe47 100644 --- a/infer/src/IR/Cfg.re +++ b/infer/src/IR/Cfg.re @@ -120,12 +120,12 @@ let check_cfg_connectedness cfg => { /** Serializer for control flow graphs */ -let cfg_serializer: Serialization.serializer cfg = Serialization.create_serializer Serialization.cfg_key; +let cfg_serializer: Serialization.serializer cfg = Serialization.create_serializer Serialization.Key.cfg; /** Load a cfg from a file */ let load_cfg_from_file (filename: DB.filename) :option cfg => - Serialization.from_file cfg_serializer filename; + Serialization.read_from_file cfg_serializer filename; /** Save the .attr files for the procedures in the cfg. */ @@ -336,7 +336,7 @@ let store_cfg_to_file source_file::source_file (filename: DB.filename) (cfg: cfg OndemandCapture module relies on it - it uses existance of .cfg file as a barrier to make sure that all attributes were written to disk (but not necessarily flushed) */ save_attributes source_file cfg; - Serialization.to_file cfg_serializer filename cfg + Serialization.write_to_file cfg_serializer filename cfg }; diff --git a/infer/src/IR/Cg.re b/infer/src/IR/Cg.re index 0e4a15a5e..fd1f13352 100644 --- a/infer/src/IR/Cg.re +++ b/infer/src/IR/Cg.re @@ -350,12 +350,12 @@ let extend cg_old cg_new => { /** Begin support for serialization */ -let callgraph_serializer: Serialization.serializer (SourceFile.t, nodes_and_edges) = Serialization.create_serializer Serialization.cg_key; +let callgraph_serializer: Serialization.serializer (SourceFile.t, nodes_and_edges) = Serialization.create_serializer Serialization.Key.cg; /** Load a call graph from a file */ let load_from_file (filename: DB.filename) :option t => - switch (Serialization.from_file callgraph_serializer filename) { + switch (Serialization.read_from_file callgraph_serializer filename) { | None => None | Some (source, (nodes, edges)) => let g = create (Some source); @@ -374,7 +374,7 @@ let load_from_file (filename: DB.filename) :option t => /** Save a call graph into a file */ let store_to_file (filename: DB.filename) (call_graph: t) => - Serialization.to_file + Serialization.write_to_file callgraph_serializer filename (call_graph.source, get_nodes_and_edges call_graph); let pp_graph_dotty get_specs (g: t) fmt => { diff --git a/infer/src/IR/LintIssues.ml b/infer/src/IR/LintIssues.ml index 936e51971..0e319c575 100644 --- a/infer/src/IR/LintIssues.ml +++ b/infer/src/IR/LintIssues.ml @@ -23,15 +23,15 @@ let get_err_log procname = errLogMap := Procname.Map.add procname errlog !errLogMap; errlog let lint_issues_serializer : (Errlog.t Procname.Map.t) Serialization.serializer = - Serialization.create_serializer Serialization.lint_issues_key + Serialization.create_serializer Serialization.Key.lint_issues (** Save issues to a file *) let store_issues filename errLogMap = - Serialization.to_file lint_issues_serializer filename errLogMap + Serialization.write_to_file lint_issues_serializer filename errLogMap (** Load issues from the given file *) let load_issues issues_file = - Serialization.from_file lint_issues_serializer issues_file + Serialization.read_from_file lint_issues_serializer issues_file (** Load all the lint issues in the given dir and update the issues map *) let load_issues_to_errlog_map dir = diff --git a/infer/src/IR/Tenv.re b/infer/src/IR/Tenv.re index 8065393cb..170815df0 100644 --- a/infer/src/IR/Tenv.re +++ b/infer/src/IR/Tenv.re @@ -115,7 +115,7 @@ let get_overriden_method tenv pname_java => { /** Serializer for type environments */ -let tenv_serializer: Serialization.serializer t = Serialization.create_serializer Serialization.tenv_key; +let tenv_serializer: Serialization.serializer t = Serialization.create_serializer Serialization.Key.tenv; let global_tenv: ref (option t) = ref None; @@ -124,11 +124,11 @@ let global_tenv: ref (option t) = ref None; let load_from_file (filename: DB.filename) :option t => if (DB.equal_filename filename DB.global_tenv_fname) { if (is_none !global_tenv) { - global_tenv := Serialization.from_file tenv_serializer DB.global_tenv_fname + global_tenv := Serialization.read_from_file tenv_serializer DB.global_tenv_fname }; !global_tenv } else { - Serialization.from_file tenv_serializer filename + Serialization.read_from_file tenv_serializer filename }; @@ -139,7 +139,7 @@ let store_to_file (filename: DB.filename) (tenv: t) => { if (DB.equal_filename filename DB.global_tenv_fname) { global_tenv := Some tenv }; - Serialization.to_file tenv_serializer filename tenv; + Serialization.write_to_file tenv_serializer filename tenv; if Config.debug_mode { let debug_filename = DB.filename_to_string (DB.filename_add_suffix filename ".debug"); let out_channel = open_out debug_filename; diff --git a/infer/src/backend/InferPrint.re b/infer/src/backend/InferPrint.re index 126d36045..d3f7abec8 100644 --- a/infer/src/backend/InferPrint.re +++ b/infer/src/backend/InferPrint.re @@ -1247,15 +1247,15 @@ let module AnalysisResults = { }; /** Serializer for analysis results */ - let analysis_results_serializer: Serialization.serializer t = Serialization.create_serializer Serialization.analysis_results_key; + let analysis_results_serializer: Serialization.serializer t = Serialization.create_serializer Serialization.Key.analysis_results; /** Load analysis_results from a file */ let load_analysis_results_from_file (filename: DB.filename) :option t => - Serialization.from_file analysis_results_serializer filename; + Serialization.read_from_file analysis_results_serializer filename; /** Save analysis_results into a file */ let store_analysis_results_to_file (filename: DB.filename) (analysis_results: t) => - Serialization.to_file analysis_results_serializer filename analysis_results; + Serialization.write_to_file analysis_results_serializer filename analysis_results; /** Return an iterator over all the summaries. If options - load_results or - save_results are used, diff --git a/infer/src/backend/cluster.ml b/infer/src/backend/cluster.ml index fd702e68a..57811d30c 100644 --- a/infer/src/backend/cluster.ml +++ b/infer/src/backend/cluster.ml @@ -22,15 +22,15 @@ type serializer_t = int * t (** Serializer for clusters *) let serializer : serializer_t Serialization.serializer = - Serialization.create_serializer Serialization.cluster_key + Serialization.create_serializer Serialization.Key.cluster (** Load a cluster from a file *) let load_from_file (filename : DB.filename) : serializer_t option = - Serialization.from_file serializer filename + Serialization.read_from_file serializer filename (** Save a cluster into a file *) let store_to_file (filename : DB.filename) (serializer_t: serializer_t) = - Serialization.to_file serializer filename serializer_t + Serialization.write_to_file serializer filename serializer_t let cl_name n = "cl" ^ string_of_int n let cl_file n = "x" ^ (cl_name n) ^ ".cluster" diff --git a/infer/src/backend/specs.ml b/infer/src/backend/specs.ml index 08ec85da1..306af6bdf 100644 --- a/infer/src/backend/specs.ml +++ b/infer/src/backend/specs.ml @@ -549,7 +549,7 @@ let summary_exists_in_models pname = Sys.file_exists (DB.filename_to_string (specs_models_filename pname)) = `Yes let summary_serializer : summary Serialization.serializer = - Serialization.create_serializer Serialization.summary_key + Serialization.create_serializer Serialization.Key.summary (** Save summary for the procedure into the spec database *) let store_summary pname (summ1: summary) = @@ -562,11 +562,11 @@ let store_summary pname (summ1: summary) = { summ2 with stats = { summ1.stats with stats_time = 0.0} } in add_summary pname summ3 (* Make sure the summary in memory is identical to the saved one *); - Serialization.to_file summary_serializer (res_dir_specs_filename pname) summ3 + Serialization.write_to_file summary_serializer (res_dir_specs_filename pname) summ3 (** Load procedure summary from the given file *) let load_summary specs_file = - Serialization.from_file summary_serializer specs_file + Serialization.read_from_file summary_serializer specs_file (** Load procedure summary for the given procedure name and update spec table *) diff --git a/infer/src/base/Serialization.ml b/infer/src/base/Serialization.ml index c5d03e089..33b6e63cb 100644 --- a/infer/src/base/Serialization.ml +++ b/infer/src/base/Serialization.ml @@ -14,16 +14,24 @@ module L = Logging module F = Format (** Generic serializer *) -type 'a serializer = (string -> 'a option) * (DB.filename -> 'a option) * (DB.filename -> 'a -> unit) +type 'a serializer = + { + read_from_string: (string -> 'a option); + read_from_file: (DB.filename -> 'a option); + write_to_file: (DB.filename -> 'a -> unit); + } -(** Serialization key, used to distinguish versions of serializers and avoid assert faults *) -type key = int +module Key = struct -(** current key for tenv, procedure summary, cfg, error trace, call graph *) -let tenv_key, summary_key, cfg_key, trace_key, cg_key, - analysis_results_key, cluster_key, attributes_key, lint_issues_key = - 425184201, 160179325, 1062389858, 221487792, 477305409, - 799050016, 579094948, 972393003, 852343110 + (** Serialization key, used to distinguish versions of serializers and avoid assert faults *) + type t = int + + (** current key for tenv, procedure summary, cfg, error trace, call graph *) + let tenv, summary, cfg, trace, cg, + analysis_results, cluster, attributes, lint_issues = + 425184201, 160179325, 1062389858, 221487792, 477305409, + 799050016, 579094948, 972393003, 852343110 +end (** version of the binary files, to be incremented for each change *) let version = 26 @@ -31,7 +39,7 @@ let version = 26 (** Retry the function while an exception filtered is thrown, or until the timeout in seconds expires. *) -let retry_exception timeout catch_exn f x = +let retry_exception ~timeout ~catch_exn ~f x = let init_time = Unix.gettimeofday () in let expired () = Unix.gettimeofday () -. init_time >= timeout in @@ -42,8 +50,8 @@ let retry_exception timeout catch_exn f x = retry () -let create_serializer (key : key) : 'a serializer = - let match_data ((key': key), (version': int), (value: 'a)) source_msg = +let create_serializer (key : Key.t) : 'a serializer = + let read_data ((key': Key.t), (version': int), (value: 'a)) source_msg = if key <> key' then begin L.err "Wrong key in when loading data from %s@\n" source_msg; @@ -55,11 +63,11 @@ let create_serializer (key : key) : 'a serializer = None end else Some value in - let from_string (str : string) : 'a option = + let read_from_string (str : string) : 'a option = try - match_data (Marshal.from_string str 0) "string" + read_data (Marshal.from_string str 0) "string" with Sys_error _ -> None in - let from_file (fname_ : DB.filename) : 'a option = + let read_from_file (fname_ : DB.filename) : 'a option = let fname = DB.filename_to_string fname_ in match open_in_bin fname with | exception Sys_error _ -> @@ -68,10 +76,9 @@ let create_serializer (key : key) : 'a serializer = let read () = try In_channel.seek inc 0L ; - match_data (Marshal.from_channel inc) fname + read_data (Marshal.from_channel inc) fname with | Sys_error _ -> None in - let timeout = 1.0 in let catch_exn = function | End_of_file -> true | Failure _ -> true (* handle input_value: truncated object *) @@ -79,9 +86,9 @@ let create_serializer (key : key) : 'a serializer = (* Retry to read for 1 second in case of end of file, *) (* which indicates that another process is writing the same file. *) SymOp.try_finally - (fun () -> retry_exception timeout catch_exn read ()) + (fun () -> retry_exception ~timeout:1.0 ~catch_exn ~f:read ()) (fun () -> In_channel.close inc) in - let to_file (fname : DB.filename) (value : 'a) = + let write_to_file (fname : DB.filename) (value : 'a) = let fname_str = DB.filename_to_string fname in (* support nonblocking reads and writes in parallel: *) (* write to a tmp file and use rename which is atomic *) @@ -91,17 +98,17 @@ let create_serializer (key : key) : 'a serializer = Marshal.to_channel outc (key, version, value) []; Out_channel.close outc; Unix.rename ~src:fname_tmp ~dst:fname_str in - (from_string, from_file, to_file) + {read_from_string; read_from_file; write_to_file} -let from_string (serializer : 'a serializer) = - let (s, _, _) = serializer in s +let read_from_string s = + s.read_from_string -let from_file (serializer : 'a serializer) = - let (_, s, _) = serializer in s +let read_from_file s = + s.read_from_file -let to_file (serializer : 'a serializer) = - let (_, _, s) = serializer in s +let write_to_file s = + s.write_to_file (* (** Generate random keys, to be used in an ocaml toplevel *) diff --git a/infer/src/base/Serialization.mli b/infer/src/base/Serialization.mli index cc5eea1ef..311489348 100644 --- a/infer/src/base/Serialization.mli +++ b/infer/src/base/Serialization.mli @@ -12,48 +12,52 @@ open! IStd (** Serialization of data stuctures *) -(** Generic serializer *) -type 'a serializer +module Key : sig -(** Serialization key, used to distinguish versions of serializers and avoid assert faults *) -type key + (** Serialization key, used to distinguish versions of serializers and avoid assert faults *) + type t -(** current key for an analysis results value *) -val analysis_results_key : key + (** current key for an analysis results value *) + val analysis_results : t -(** current key for proc attributes *) -val attributes_key : key + (** current key for proc attributes *) + val attributes : t -(** current key for a cfg *) -val cfg_key : key + (** current key for a cfg *) + val cfg : t -(** current key for a call graph *) -val cg_key : key + (** current key for a call graph *) + val cg : t -(** create a serializer from a file name - given an integer key used as double-check of the file type *) -val create_serializer : key -> 'a serializer + (** current key for a cluster *) + val cluster : t + + (** current key for lint issues *) + val lint_issues : t -(** current key for a cluster *) -val cluster_key : key + (** current key for a procedure summary *) + val summary : t -(** extract a from_file function from a serializer *) -val from_file : 'a serializer -> DB.filename -> 'a option + (** current key for tenv *) + val tenv : t -(** extract a from_string function from a serializer *) -val from_string : 'a serializer -> string -> 'a option + (** current key for an error trace *) + val trace : t -(** current key for a procedure summary *) -val summary_key : key +end -(** current key for tenv *) -val tenv_key : key +(** Generic serializer *) +type 'a serializer + +(** create a serializer from a file name + given an integer key used as double-check of the file type *) +val create_serializer : Key.t -> 'a serializer -(** extract a to_file function from a serializer *) -val to_file : 'a serializer -> DB.filename -> 'a -> unit +(** Deserialize a file and check the keys *) +val read_from_file : 'a serializer -> DB.filename -> 'a option -(** current key for an error trace *) -val trace_key : key +(** Deserialize a string and check the keys *) +val read_from_string : 'a serializer -> string -> 'a option -(** current key for lint issues *) -val lint_issues_key : key +(** Serialize into a file *) +val write_to_file : 'a serializer -> DB.filename -> 'a -> unit diff --git a/infer/src/base/ZipLib.ml b/infer/src/base/ZipLib.ml index d364f9a3d..dd0872715 100644 --- a/infer/src/base/ZipLib.ml +++ b/infer/src/base/ZipLib.ml @@ -27,7 +27,7 @@ let get_cache_dir infer_cache zip_filename = let load_from_cache serializer zip_path cache_dir zip_library = let absolute_path = Filename.concat cache_dir zip_path in - let deserialize = Serialization.from_file serializer in + let deserialize = Serialization.read_from_file serializer in let extract to_path = if (Sys.file_exists to_path) <> `Yes then begin @@ -44,7 +44,7 @@ let load_from_cache serializer zip_path cache_dir zip_library = let load_from_zip serializer zip_path zip_library = let lazy zip_channel = zip_library.zip_channel in - let deserialize = Serialization.from_string serializer in + let deserialize = Serialization.read_from_string serializer in match deserialize (Zip.read_entry zip_channel (Zip.find_entry zip_channel zip_path)) with | Some data -> Some data | None -> None