diff --git a/infer/src/IR/AttributesTable.re b/infer/src/IR/AttributesTable.re index 26012e67d..23799c12b 100644 --- a/infer/src/IR/AttributesTable.re +++ b/infer/src/IR/AttributesTable.re @@ -63,7 +63,7 @@ let load_attr defined_only::defined_only proc_name => { let write_and_delete proc_name (proc_attributes: ProcAttributes.t) => { let attributes_file defined => res_dir_attr_filename defined::defined proc_name; Serialization.write_to_file - serializer (attributes_file proc_attributes.is_defined) proc_attributes; + serializer (attributes_file proc_attributes.is_defined) data::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 304c2fe47..ecb3272ea 100644 --- a/infer/src/IR/Cfg.re +++ b/infer/src/IR/Cfg.re @@ -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.write_to_file cfg_serializer filename cfg + Serialization.write_to_file cfg_serializer filename data::cfg }; diff --git a/infer/src/IR/Cg.re b/infer/src/IR/Cg.re index fd1f13352..85f078bb5 100644 --- a/infer/src/IR/Cg.re +++ b/infer/src/IR/Cg.re @@ -375,7 +375,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.write_to_file - callgraph_serializer filename (call_graph.source, get_nodes_and_edges call_graph); + callgraph_serializer filename data::(call_graph.source, get_nodes_and_edges call_graph); let pp_graph_dotty get_specs (g: t) fmt => { let nodes_with_calls = get_all_nodes g; diff --git a/infer/src/IR/LintIssues.ml b/infer/src/IR/LintIssues.ml index 0e319c575..73c948b4a 100644 --- a/infer/src/IR/LintIssues.ml +++ b/infer/src/IR/LintIssues.ml @@ -27,7 +27,7 @@ let lint_issues_serializer : (Errlog.t Procname.Map.t) Serialization.serializer (** Save issues to a file *) let store_issues filename errLogMap = - Serialization.write_to_file lint_issues_serializer filename errLogMap + Serialization.write_to_file lint_issues_serializer filename ~data:errLogMap (** Load issues from the given file *) let load_issues issues_file = diff --git a/infer/src/IR/Tenv.re b/infer/src/IR/Tenv.re index bc98af770..7b8afa5f9 100644 --- a/infer/src/IR/Tenv.re +++ b/infer/src/IR/Tenv.re @@ -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.write_to_file tenv_serializer filename tenv; + Serialization.write_to_file tenv_serializer filename data::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 24a8b00ad..f1861a156 100644 --- a/infer/src/backend/InferPrint.re +++ b/infer/src/backend/InferPrint.re @@ -1233,7 +1233,7 @@ let module AnalysisResults = { /** Save analysis_results into a file */ let store_analysis_results_to_file (filename: DB.filename) (analysis_results: t) => - Serialization.write_to_file analysis_results_serializer filename analysis_results; + Serialization.write_to_file analysis_results_serializer filename data::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 57811d30c..c627b4361 100644 --- a/infer/src/backend/cluster.ml +++ b/infer/src/backend/cluster.ml @@ -29,8 +29,8 @@ let load_from_file (filename : DB.filename) : serializer_t option = Serialization.read_from_file serializer filename (** Save a cluster into a file *) -let store_to_file (filename : DB.filename) (serializer_t: serializer_t) = - Serialization.write_to_file serializer filename serializer_t +let store_to_file (filename : DB.filename) (data: serializer_t) = + Serialization.write_to_file serializer filename ~data 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 117a266ac..3845d49f8 100644 --- a/infer/src/backend/specs.ml +++ b/infer/src/backend/specs.ml @@ -557,7 +557,7 @@ let store_summary pname (summ1: summary) = stats = { summ1.stats with stats_time = 0.0} } in let final_summary = { summ3 with status = Analyzed } in add_summary pname summ3 (* Make sure the summary in memory is identical to the saved one *); - Serialization.write_to_file summary_serializer (res_dir_specs_filename pname) final_summary + Serialization.write_to_file summary_serializer (res_dir_specs_filename pname) ~data:final_summary (** Load procedure summary from the given file *) let load_summary specs_file = diff --git a/infer/src/base/Serialization.ml b/infer/src/base/Serialization.ml index 07b5c5bf5..370753579 100644 --- a/infer/src/base/Serialization.ml +++ b/infer/src/base/Serialization.ml @@ -16,9 +16,10 @@ module F = Format (** Generic serializer *) type 'a serializer = { - read_from_string: (string -> 'a option); - read_from_file: (DB.filename -> 'a option); - write_to_file: (DB.filename -> 'a -> unit); + read_from_string: string -> 'a option; + read_from_file: DB.filename -> 'a option; + update_file : f:('a option -> 'a) -> DB.filename -> unit; + write_to_file: data:'a -> DB.filename -> unit; } module Key = struct @@ -49,6 +50,9 @@ let retry_exception ~timeout ~catch_exn ~f x = retry () in retry () +type 'a write_command = + | Replace of 'a + | Update of ('a option -> 'a) let create_serializer (key : Key.t) : 'a serializer = let read_data ((key': Key.t), (version': int), (value: 'a)) source_msg = @@ -88,17 +92,31 @@ let create_serializer (key : Key.t) : 'a serializer = SymOp.try_finally (fun () -> retry_exception ~timeout:1.0 ~catch_exn ~f:read ()) (fun () -> In_channel.close inc) in - let write_to_file (fname : DB.filename) (value : 'a) = + let execute_write_command (fname : DB.filename) (cmd : 'a write_command) = 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 *) - let fname_tmp = Filename.temp_file - ~in_dir:(Filename.dirname fname_str) (Filename.basename fname_str) ".tmp" in - let outc = open_out_bin fname_tmp in - Marshal.to_channel outc (key, version, value) []; - Out_channel.close outc; - Unix.rename ~src:fname_tmp ~dst:fname_str in - {read_from_string; read_from_file; write_to_file} + let file_descr = Unix.openfile ~mode:[Unix.O_WRONLY; Unix.O_CREAT] fname_str in + if (Unix.flock file_descr Unix.Flock_command.lock_exclusive) + then begin + let (value_to_write : 'a) = match cmd with + | Replace value -> + value + | Update upd -> + let old_value_opt = + let st_size = (Unix.fstat file_descr).st_size in + if st_size > 0L + then read_from_file fname + else None in + upd old_value_opt in + let outc = Unix.out_channel_of_descr file_descr in + Marshal.to_channel outc (key, version, value_to_write) []; + ignore (Unix.flock file_descr Unix.Flock_command.unlock); + Out_channel.close outc + end in + let write_to_file ~(data : 'a) (fname : DB.filename) = + execute_write_command fname (Replace data) in + let update_file ~f (fname : DB.filename) = + execute_write_command fname (Update f) in + {read_from_string; read_from_file; update_file; write_to_file; } let read_from_string s = @@ -107,6 +125,9 @@ let read_from_string s = let read_from_file s = s.read_from_file +let update_file s = + s.update_file + let write_to_file s = s.write_to_file diff --git a/infer/src/base/Serialization.mli b/infer/src/base/Serialization.mli index 311489348..6e00d8c1c 100644 --- a/infer/src/base/Serialization.mli +++ b/infer/src/base/Serialization.mli @@ -59,5 +59,9 @@ val read_from_file : 'a serializer -> DB.filename -> 'a option (** Deserialize a string and check the keys *) val read_from_string : 'a serializer -> string -> 'a option -(** Serialize into a file *) -val write_to_file : 'a serializer -> DB.filename -> 'a -> unit +(** Serialize into a file. + The upd function takes the old value, if any, and returns the value to write *) +val update_file : 'a serializer -> f:('a option -> 'a) -> DB.filename -> unit + +(** Serialize into a file writing value *) +val write_to_file : 'a serializer -> data:'a -> DB.filename -> unit