ocaml · emillon · Feb 27, 2024 · Dec 14, 2023 · Nov 30, 2023 · Nov 30, 2023
diff --git a/bin/install_uninstall.ml b/bin/install_uninstall.ml
@@ -365,7 +365,7 @@ module File_ops_real (W : sig
     if Path.exists dst
     then (
       print_line "Deleting %s" (Path.to_string_maybe_quoted dst);
-      print_unix_error (fun () -> Path.unlink dst))
+      print_unix_error (fun () -> Path.unlink_exn dst))
   ;;
 
   let remove_dir_if_exists ~if_non_empty dir =

diff --git a/doc/changes/9327.md b/doc/changes/9327.md
@@ -0,0 +1,2 @@
+- When a directory is changed to a file, correctly remove it in subsequent
+  `dune build` runs. (#9327, fix #6575, @emillon)
diff --git a/otherlibs/stdune/src/fpath.ml b/otherlibs/stdune/src/fpath.ml
@@ -121,10 +121,29 @@ let win32_unlink fn =
      | _ -> raise e)
 ;;
 
-let unlink = if Stdlib.Sys.win32 then win32_unlink else Unix.unlink
+let unlink_exn = if Stdlib.Sys.win32 then win32_unlink else Unix.unlink
+
+type unlink_status =
+  | Success
+  | Does_not_exist
+  | Is_a_directory
+  | Error of exn
+
+let unlink t =
+  match unlink_exn t with
+  | () -> Success
+  | exception exn ->
+    (match exn with
+     | Unix.Unix_error (ENOENT, _, _) -> Does_not_exist
+     | Unix.Unix_error (error, _, _) ->
+       (match error, Platform.OS.value with
+        | EISDIR, _ | EPERM, Darwin -> Is_a_directory
+        | _ -> Error exn)
+     | _ -> Error exn)
+;;
 
 let unlink_no_err t =
-  try unlink t with
+  try unlink_exn t with
   | _ -> ()
 ;;
 
@@ -165,7 +184,7 @@ let rm_rf fn =
   match Unix.lstat fn with
   | exception Unix.Unix_error (ENOENT, _, _) -> ()
   | { Unix.st_kind = S_DIR; _ } -> rm_rf_dir fn
-  | _ -> unlink fn
+  | _ -> unlink_exn fn
 ;;
 
 let traverse =

diff --git a/otherlibs/stdune/src/fpath.mli b/otherlibs/stdune/src/fpath.mli
@@ -27,8 +27,18 @@ val follow_symlink : string -> (string, follow_symlink_error) result
     [Error Max_depth_exceeded] on some intermediate path). *)
 val follow_symlinks : string -> string option
 
-val unlink : string -> unit
+val unlink_exn : string -> unit
 val unlink_no_err : string -> unit
+
+type unlink_status =
+  | Success
+  | Does_not_exist
+  | Is_a_directory
+  | Error of exn
+
+(** Unlink and return error, if any. *)
+val unlink : string -> unlink_status
+
 val initial_cwd : string
 
 type clear_dir_result =

diff --git a/otherlibs/stdune/src/io.ml b/otherlibs/stdune/src/io.ml
@@ -500,7 +500,7 @@ let portable_hardlink ~src ~dst =
           destination (we also do this in the symlink case above). Perhaps, the
           list of dependencies may have duplicates? If yes, it may be better to
           filter out the duplicates first. *)
-       Path.unlink dst;
+       Path.unlink_exn dst;
        Path.link src dst
      | Unix.Unix_error (Unix.EMLINK, _, _) ->
        (* If we can't make a new hard link because we reached the limit on the

diff --git a/otherlibs/stdune/src/path.ml b/otherlibs/stdune/src/path.ml
@@ -734,6 +734,7 @@ module Build = struct
   let of_local t = t
   let chmod t ~mode = Unix.chmod (to_string t) mode
   let lstat t = Unix.lstat (to_string t)
+  let unlink t = Fpath.unlink (to_string t)
   let unlink_no_err t = Fpath.unlink_no_err (to_string t)
   let to_dyn s = Dyn.variant "In_build_dir" [ to_dyn s ]
 end
@@ -1134,7 +1135,7 @@ let is_directory t =
 ;;
 
 let rmdir t = Unix.rmdir (to_string t)
-let unlink t = Fpath.unlink (to_string t)
+let unlink_exn t = Fpath.unlink_exn (to_string t)
 
 let link src dst =
   match Unix.link (to_string src) (to_string dst) with

diff --git a/otherlibs/stdune/src/path.mli b/otherlibs/stdune/src/path.mli
@@ -195,6 +195,7 @@ module Build : sig
   val chmod : t -> mode:int -> unit
 
   val lstat : t -> Unix.stats
+  val unlink : t -> Fpath.unlink_status
   val unlink_no_err : t -> unit
 
   module Table : Hashtbl.S with type key = t
@@ -356,7 +357,7 @@ val is_dir_sep : char -> bool
 val is_directory : t -> bool
 
 val rmdir : t -> unit
-val unlink : t -> unit
+val unlink_exn : t -> unit
 val unlink_no_err : t -> unit
 val link : t -> t -> unit
 

diff --git a/src/dune_engine/action_exec.ml b/src/dune_engine/action_exec.ml
@@ -445,7 +445,7 @@ let rec exec t ~display ~ectx ~eenv : done_or_more_deps Produce.t =
     let remove_intermediate_file () =
       if optional
       then (
-        try Path.unlink (Path.build file2) with
+        try Path.unlink_exn (Path.build file2) with
         | Unix.Unix_error (ENOENT, _, _) -> ())
     in
     if diff_eq_files diff

diff --git a/src/dune_engine/build_system.ml b/src/dune_engine/build_system.ml
@@ -567,10 +567,27 @@ end = struct
           in
           let* () =
             maybe_async_rule_file_op (fun () ->
+              let remove_target_dir dir = Path.rm_rf (Path.build dir) in
+              let remove_target_file path =
+                match Path.Build.unlink path with
+                | Success -> ()
+                | Does_not_exist -> ()
+                | Is_a_directory ->
+                  (* If target changed from a directory to a file, delete
+                     in anyway. *)
+                  remove_target_dir path
+                | Error exn ->
+                  Log.info
+                    [ Pp.textf
+                        "Error while removing target %s: %s"
+                        (Path.Build.to_string path)
+                        (Printexc.to_string exn)
+                    ]
+              in
               Targets.Validated.iter
                 targets
-                ~file:Path.Build.unlink_no_err
-                ~dir:(fun dir -> Path.rm_rf (Path.build dir)))
+                ~file:remove_target_file
+                ~dir:remove_target_dir)
           in
           let* produced_targets, dynamic_deps_stages =
             (* Step III. Try to restore artifacts from the shared cache. *)

diff --git a/src/dune_engine/load_rules.ml b/src/dune_engine/load_rules.ml
@@ -205,7 +205,7 @@ let remove_old_artifacts
         match kind with
         | Unix.S_DIR ->
           if not (Subdir_set.mem subdirs_to_keep fn) then Path.rm_rf (Path.build path)
-        | _ -> Path.unlink (Path.build path)))
+        | _ -> Path.unlink_exn (Path.build path)))
 ;;
 
 (* We don't remove files in there as we don't know upfront if they are stale or

diff --git a/src/dune_engine/process.ml b/src/dune_engine/process.ml
@@ -853,7 +853,7 @@ let await { response_file; pid; _ } =
   let+ process_info, termination_reason =
     Scheduler.wait_for_build_process pid ~is_process_group_leader:true
   in
-  Option.iter response_file ~f:Path.unlink;
+  Option.iter response_file ~f:Path.unlink_exn;
   process_info, termination_reason
 ;;
 

diff --git a/src/dune_rules/pkg_rules.ml b/src/dune_rules/pkg_rules.ml
@@ -1348,7 +1348,7 @@ module Install_action = struct
                 section, file)
               |> Section.Map.of_list_multi
             in
-            let+ () = Async.async (fun () -> Path.unlink install_file) in
+            let+ () = Async.async (fun () -> Path.unlink_exn install_file) in
             map
         in
         (* TODO we should make sure that overwrites aren't allowed *)

diff --git a/src/upgrader/dune_upgrader.ml b/src/upgrader/dune_upgrader.ml
@@ -397,7 +397,7 @@ let upgrade () =
             (Path.Source.to_string_maybe_quoted new_file)
         ];
       List.iter (original_file :: extra_files_to_delete) ~f:(fun p ->
-        Path.unlink (Path.source p));
+        Path.unlink_exn (Path.source p));
       Io.write_file (Path.source new_file) contents ~binary:true);
     if !v1_updates && not last
     then (

diff --git a/test/blackbox-tests/test-cases/github6575.t b/test/blackbox-tests/test-cases/github6575.t
@@ -12,13 +12,14 @@ We turn it into a single-file test:
   $ mv sometest.t.bak/run.t sometest.t
   $ rm -r sometest.t.bak
 
-FIXME: Dune should detect the change:
+Dune detects the change:
   $ dune build @sometest
-  Error: _build/default/sometest.t: Is a directory
-  -> required by _build/default/sometest.t
-  -> required by alias sometest
-  [1]
 
-After a clean it works as expected:
-  $ dune clean
+The other way. Turn the file test into a directory test:
+
+  $ mv sometest.t sometest.t.bak
+  $ mkdir sometest.t
+  $ mv sometest.t.bak sometest.t/run.t
+
+And this works:
   $ dune build @sometest
Original file line number	Diff line number	Diff line change
		@@ -0,0 +1,2 @@
		- When a directory is changed to a file, correctly remove it in subsequent
		`dune build` runs. (#9327, fix #6575, @emillon)