fix(store): replace generated artefacts atomically

2 files changed, +26 −3

@@ -11,6 +11,23 @@ let rejects action message =
11	11
12	12	let read name = Syntax.load ("cases/" ^ name ^ ".sexp")
13	13
	14	+let storage folder =
	15	+ let folder = Filename.concat folder "storage" in
	16	+ let path = Filename.concat folder "nested/artefact" in
	17	+ Store.write path "first";
	18	+ let previous = open_in_bin path in
	19	+ Fun.protect ~finally:(fun () -> close_in_noerr previous) (fun () ->
	20	+ Store.write path "replacement";
	21	+ require (Store.read path = "replacement") "artefact replacement";
	22	+ require (really_input_string previous 5 = "first") "open reader retains previous artefact");
	23	+ let target = Filename.concat folder "directory" in
	24	+ Store.mkdir target;
	25	+ let failed = try Store.write target "invalid"; false with Sys_error _ -> true in
	26	+ require failed "directory cannot be replaced by an artefact";
	27	+ require (Sys.is_directory target) "failed replacement preserves destination";
	28	+ require (List.sort compare (Array.to_list (Sys.readdir folder)) = ["directory"; "nested"])
	29	+ "failed replacement removes temporary file"
	30	+
14	31	let laws () =
15	32	let source = Layout.generate ~timeout:300000 ^ Store.read "smt/machine.smt2" ^
16	33	"\n" ^ Store.read "smt/laws.smt2" in

@@ -155,6 +172,7 @@ let () =
155	172	let started = Unix.gettimeofday () in
156	173	let folder = Filename.concat (Filename.get_temp_dir_name ()) (Printf.sprintf "reorder%d" (Unix.getpid ())) in
157	174	Store.mkdir folder;
	175	+ storage folder;
158	176	codec ();
159	177	laws ();
160	178	fixtures ();

@@ -11,9 +11,14 @@ let rec mkdir path =
11	11
12	12	let write path text =
13	13	mkdir (Filename.dirname path);
14		- let channel = open_out_bin path in
15		- Fun.protect ~finally:(fun () -> close_out_noerr channel) (fun () ->
16		- output_string channel text)
	14	+ let temporary, channel = Filename.open_temp_file ~mode:[Open_binary]
	15	+ ~temp_dir:(Filename.dirname path) ".reorder" ".tmp" in
	16	+ Fun.protect ~finally:(fun () ->
	17	+ close_out_noerr channel;
	18	+ if Sys.file_exists temporary then Sys.remove temporary) (fun () ->
	19	+ output_string channel text;
	20	+ close_out channel;
	21	+ Sys.rename temporary path)
17	22
18	23	let root () =
19	24	let rec find path =

~james/reorder