2 files changed, 26 insertions(+), 3 deletions(-)

M check.ml
M store.ml

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


@@ 155,6 172,7 @@ let () =
   let started = Unix.gettimeofday () in
   let folder = Filename.concat (Filename.get_temp_dir_name ()) (Printf.sprintf "reorder%d" (Unix.getpid ())) in
   Store.mkdir folder;
+  storage folder;
   codec ();
   laws ();
   fixtures ();

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