From bf3fa0831d09cc3c9588f295674582fe3f29ec30 Mon Sep 17 00:00:00 2001
From: David Allsopp <david.allsopp@metastack.com>
Date: Tue, 13 Jun 2017 14:06:53 +0200
Subject: [PATCH] Add Sys.force_remove

Sys.force_remove is Sys.remove, except on Windows, where it will remove
the "read-only" attribute and re-try a failed Sys.remove
---
 src/action.ml |  2 +-
 src/future.ml |  4 ++--
 src/import.ml | 16 ++++++++++++++++
 3 files changed, 19 insertions(+), 3 deletions(-)

diff --git a/src/action.ml b/src/action.ml
index 423bc1f9..af4a4dd1 100644
--- a/src/action.ml
+++ b/src/action.ml
@@ -537,7 +537,7 @@ let rec exec t ~ectx ~dir ~env_extra ~stdout_to ~stderr_to =
     return ()
   | Create_file fn ->
     let fn = Path.to_string fn in
-    if Sys.file_exists fn then Sys.remove fn;
+    if Sys.file_exists fn then Sys.force_remove fn;
     Unix.close (Unix.openfile fn [O_CREAT; O_TRUNC; O_WRONLY] 0o666);
     return ()
   | Copy (src, dst) ->
diff --git a/src/future.ml b/src/future.ml
index 3d2d70ca..c04022ba 100644
--- a/src/future.ml
+++ b/src/future.ml
@@ -225,7 +225,7 @@ module Temp = struct
       let fns = !tmp_files in
       tmp_files := String_set.empty;
       String_set.iter fns ~f:(fun fn ->
-        try Sys.remove fn with _ -> ()))
+        try Sys.force_remove fn with _ -> ()))
 
   let create prefix suffix =
     let fn = Filename.temp_file prefix suffix in
@@ -233,7 +233,7 @@ module Temp = struct
     fn
 
   let destroy fn =
-    Sys.remove fn;
+    Sys.force_remove fn;
     tmp_files := String_set.remove fn !tmp_files
 end
 
diff --git a/src/import.ml b/src/import.ml
index 9a7dbd9c..a50f77bd 100644
--- a/src/import.ml
+++ b/src/import.ml
@@ -293,6 +293,22 @@ module String = struct
     loop 0 0 ~last_is_cr:false
 end
 
+module Sys = struct
+  include Sys
+
+  let force_remove =
+    if win32 then
+      fun fn ->
+        try
+          remove fn
+        with Sys_error _ ->
+          (* Try to remove the "read-only" attribute, then retry. *)
+          (try Unix.chmod fn 0o666 with Unix.Unix_error _ -> ());
+          remove fn
+    else
+      remove
+end
+
 module Filename = struct
   include Filename