diff --git a/CHANGES.md b/CHANGES.md index 03f4cb12ff3..7c261dadac3 100644 --- a/CHANGES.md +++ b/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) ------------------- diff --git a/src/build.ml b/src/build.ml index 1cfff0e80bf..8778a2e49c9 100644 --- a/src/build.ml +++ b/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 diff --git a/src/build.mli b/src/build.mli index eafecaa6959..0f7e3a487e5 100644 --- a/src/build.mli +++ b/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 diff --git a/src/file_tree.ml b/src/file_tree.ml index b0a9d41dc0b..235f7a77d5b 100644 --- a/src/file_tree.ml +++ b/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))) diff --git a/src/file_tree.mli b/src/file_tree.mli index b8dd281c356..a24e2945272 100644 --- a/src/file_tree.mli +++ b/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 diff --git a/test/blackbox-tests/test-cases/github2499/run.t b/test/blackbox-tests/test-cases/github2499/run.t index 105c4165e86..1595f57f17a 100644 --- a/test/blackbox-tests/test-cases/github2499/run.t +++ b/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