Fix #2499

Signed-off-by: Jeremie Dimino <[email protected]>

CHANGES.md

@@ -82,6 +82,10 @@
 - Change default target from `@install` to `@all`. (#2449, fixes #1220,
   @rgrinberg)
 
+- Cleanup stale directories when using `(source_tree ...)` in the
+  presence of directories with only sub-directories and no files
+  (#2514, fixes #2499, @diml)
+
 1.11.0 (23/07/2019)
 -------------------
 

src/build.ml

@@ -88,6 +88,8 @@ let rec all = function
     >>>
     arr (fun (x, y) -> x :: y)
 
+let ignore x = x >>^ ignore
+
 let lazy_no_targets t = Lazy_no_targets t
 
 let deps d = Deps d
@@ -162,10 +164,35 @@ let of_result_map ?targets res ~f =
 let memoize name t =
   Memo { name; t; state = Unevaluated }
 
+(* This is to force the rules to be loaded for directories without
+   files when depending on [(source_tree x)]. Otherwise, we wouldn't
+   clean up stale directories in directories that contain no file. *)
+let depend_on_dir_without_files =
+  let pred = Predicate.create ~id:(lazy (String "false")) ~f:(fun _ -> false) in
+  fun dir ->
+    Paths_glob (File_selector.create ~dir pred) |> ignore
+
 let source_tree ~dir ~file_tree =
   let (prefix_with, dir) = Path.extract_build_context_dir_exn dir in
-  let paths = File_tree.files_recursively_in file_tree dir ~prefix_with in
-  path_set paths >>^ fun _ -> paths
+  let paths, dirs_without_files =
+    let init = Path.Set.empty, arr Fn.id in
+    match File_tree.find_dir file_tree dir with
+    | None -> init
+    | Some dir ->
+      File_tree.Dir.fold dir ~init ~traverse:Sub_dirs.Status.Set.all
+        ~f:(fun dir (acc_files, acc_dirs_without_files) ->
+          let path = Path.append_source prefix_with (File_tree.Dir.path dir) in
+          let files = File_tree.Dir.files dir in
+          match String.Set.is_empty files with
+          | true ->
+            (acc_files,
+             depend_on_dir_without_files path >>> acc_dirs_without_files)
+          | false ->
+            (String.Set.fold files ~init:acc_files ~f:(fun fn acc ->
+               Path.Set.add acc (Path.relative path fn)),
+             acc_dirs_without_files))
+  in
+  dirs_without_files >>> path_set paths >>^ fun _ -> paths
 
 let action ?dir ~targets action =
   Targets (Path.Build.Set.of_list targets)
@@ -423,8 +450,6 @@ let exec ~(eval_pred : Dep.eval_pred) (t : ('a, 'b) t) (x : 'a)
   let result = exec dyn_deps t x in
   (result, !dyn_deps)
 
-let ignore x = x >>^ ignore
-
 module S = struct
   open O
   module O = struct

src/build.mli

@@ -87,7 +87,7 @@ val declare_targets : Path.Build.Set.t -> ('a, 'a) t
 val source_tree
   :  dir:Path.t
   -> file_tree:File_tree.t
-  -> ('a, Path.Set.t) t
+  -> (unit, Path.Set.t) t
 
 (** Record dynamic dependencies *)
 val dyn_paths : ('a, Path.t list) t -> ('a, 'a) t

src/file_tree.ml

@@ -385,13 +385,3 @@ let dir_exists t path = Option.is_some (find_dir t path)
 
 let dir_is_vendored t path =
   Option.map ~f:(fun dir -> Dir.vendored dir) (find_dir t path)
-
-let files_recursively_in t ~prefix_with path =
-  match find_dir t path with
-  | None -> Path.Set.empty
-  | Some dir ->
-    Dir.fold dir ~init:Path.Set.empty ~traverse:Sub_dirs.Status.Set.all
-      ~f:(fun dir acc ->
-        let path = Path.append_source prefix_with (Dir.path dir) in
-        String.Set.fold (Dir.files dir) ~init:acc ~f:(fun fn acc ->
-          Path.Set.add acc (Path.relative path fn)))

src/file_tree.mli

@@ -109,9 +109,3 @@ val dir_is_vendored : t -> Path.Source.t -> bool option
 
 (** [true] iff the path is a file *)
 val file_exists : t -> Path.Source.t -> bool
-
-val files_recursively_in
-  :  t
-  -> prefix_with:Path.t
-  -> Path.Source.t
-  -> Path.Set.t

test/blackbox-tests/test-cases/github2499/run.t

@@ -25,4 +25,3 @@ Reproduction case for #2499: dune doesn't cleanup stale directories
   $ dune build list
   $ cat _build/default/list
   data/a/x
-  data/b/x