From a6eec3042d4678460f8e2b922adf31b0d3bef1f0 Mon Sep 17 00:00:00 2001 From: Andrey Mokhov Date: Mon, 25 Oct 2021 17:26:43 +0100 Subject: [PATCH] Address feedback plus some clean up Signed-off-by: Andrey Mokhov --- bin/exec.ml | 7 +- otherlibs/stdune-unstable/user_error.ml | 6 +- src/dune_engine/action_builder.ml | 4 +- src/dune_engine/rule.ml | 61 ++++++------ src/dune_engine/sandbox.ml | 99 +++++++++++-------- .../test-cases/directory-targets.t/run.t | 45 +++++++++ 6 files changed, 143 insertions(+), 79 deletions(-) diff --git a/bin/exec.ml b/bin/exec.ml index d96a5cef0e8c..1e0f1fb400d6 100644 --- a/bin/exec.ml +++ b/bin/exec.ml @@ -72,10 +72,11 @@ let term = let not_found () = let open Memo.Build.O in let+ hints = - (* CR-someday amokhov: Currently we do not provide hints for directory - targets but it would be nice to do that. *) (* Good candidates for the "./x.exe" instead of "x.exe" error are - executables present in the current directory *) + executables present in the current directory. Note: we do not check + directory targets here; even if they do indeed include a matching + executable, they would be located in a subdirectory of [dir], so + it's unclear if that's what the user wanted. *) let+ candidates = Build_system.file_targets_of ~dir:(Path.build dir) >>| Path.Set.to_list diff --git a/otherlibs/stdune-unstable/user_error.ml b/otherlibs/stdune-unstable/user_error.ml index d287f9f5a5f3..09b11c1bc226 100644 --- a/otherlibs/stdune-unstable/user_error.ml +++ b/otherlibs/stdune-unstable/user_error.ml @@ -68,13 +68,13 @@ let has_embedded_location annots = List.exists annots ~f:(fun annot -> Annot.Has_embedded_location.check annot (fun () -> true) (fun () -> false)) +let has_location (msg : User_message.t) annots = + (not (is_loc_none msg.loc)) || has_embedded_location annots + let needs_stack_trace annots = List.exists annots ~f:(fun annot -> Annot.Needs_stack_trace.check annot (fun () -> true) (fun () -> false)) -let has_location (msg : User_message.t) annots = - (not (is_loc_none msg.loc)) || has_embedded_location annots - let () = Printexc.register_printer (function | E (t, []) -> Some (Format.asprintf "%a@?" Pp.to_fmt (User_message.pp t)) diff --git a/src/dune_engine/action_builder.ml b/src/dune_engine/action_builder.ml index fb0704daafbb..a67eb90878de 100644 --- a/src/dune_engine/action_builder.ml +++ b/src/dune_engine/action_builder.ml @@ -185,8 +185,8 @@ module With_targets = struct | xs -> let build, targets = List.fold_left xs ~init:([], Targets.empty) - ~f:(fun (acc_build, acc_targets) x -> - (x.build :: acc_build, Targets.combine acc_targets x.targets)) + ~f:(fun (builds, targets) x -> + (x.build :: builds, Targets.combine x.targets targets)) in { build = all (List.rev build); targets } diff --git a/src/dune_engine/rule.ml b/src/dune_engine/rule.ml index 92e651df1578..95750f99c231 100644 --- a/src/dune_engine/rule.ml +++ b/src/dune_engine/rule.ml @@ -101,36 +101,39 @@ let make ?(sandbox = Sandbox_config.default) ?(mode = Mode.Standard) ~context (action, deps)) }) in - match Targets.validate targets with - | No_targets -> ( - match info with - | From_dune_file loc -> - User_error.raise ~loc [ Pp.text "Rule has no targets specified" ] - | Internal - | Source_file_copy _ -> - Code_error.raise "Rule.Targets: An internal rule with no targets" []) - | Inconsistent_parent_dir -> ( - match info with - | From_dune_file loc -> - User_error.raise ~loc - [ Pp.text "Rule has targets in different directories.\nTargets:" - ; Targets.pp targets - ] - | Internal - | Source_file_copy _ -> - Code_error.raise "Rule has targets in different directories" - [ ("targets", Targets.to_dyn targets) ]) - | Valid { parent_dir = dir } -> - let loc = + let dir = + match Targets.validate targets with + | Valid { parent_dir } -> parent_dir + | No_targets -> ( match info with - | From_dune_file loc -> loc - | Internal -> - Loc.in_file - (Path.drop_optional_build_context - (Path.build (Path.Build.relative dir "_unknown_"))) - | Source_file_copy p -> Loc.in_file (Path.source p) - in - { id = Id.gen (); targets; context; action; mode; info; loc; dir } + | From_dune_file loc -> + User_error.raise ~loc [ Pp.text "Rule has no targets specified" ] + | Internal + | Source_file_copy _ -> + Code_error.raise "Rule.Targets: An internal rule with no targets" []) + | Inconsistent_parent_dir -> ( + match info with + | From_dune_file loc -> + User_error.raise ~loc + [ Pp.text "Rule has targets in different directories.\nTargets:" + ; Targets.pp targets + ] + | Internal + | Source_file_copy _ -> + Code_error.raise + "Rule.Targets: An internal rule has targets in different directories" + [ ("targets", Targets.to_dyn targets) ]) + in + let loc = + match info with + | From_dune_file loc -> loc + | Internal -> + Loc.in_file + (Path.drop_optional_build_context + (Path.build (Path.Build.relative dir "_unknown_"))) + | Source_file_copy p -> Loc.in_file (Path.source p) + in + { id = Id.gen (); targets; context; action; mode; info; loc; dir } let set_action t action = let action = Action_builder.memoize "Rule.set_action" action in diff --git a/src/dune_engine/sandbox.ml b/src/dune_engine/sandbox.ml index 926b71c90567..b2cb984c2d1d 100644 --- a/src/dune_engine/sandbox.ml +++ b/src/dune_engine/sandbox.ml @@ -114,49 +114,64 @@ let rename_optional_file ~src ~dst = (* Recursively move regular files from [src] to [dst] and return the set of moved files. *) -let rename_dir_recursively ~loc ~src_dir ~dst_dir = - let rec loop ~src ~dst ~dst_parent = - (match Fpath.mkdir dst with - | Created -> () - | Already_exists -> (* CR-someday amokhov: Should we clear it? *) () - | Missing_parent_directory -> assert false); - match Dune_filesystem_stubs.read_directory_with_kinds src with - | Ok files -> - List.concat_map files ~f:(fun (file, kind) -> - let src = Filename.concat src file in - let dst = Filename.concat dst file in - match (kind : Dune_filesystem_stubs.File_kind.t) with - | S_REG -> - Unix.rename src dst; - [ Path.Build.relative dst_parent file ] - | S_DIR -> - loop ~src ~dst ~dst_parent:(Path.Build.relative dst_parent file) - | _ -> - User_error.raise ~loc - [ Pp.textf "Rule produced a file with unrecognised kind %S" - (Dune_filesystem_stubs.File_kind.to_string kind) - ]) - | Error (ENOENT, _, _) -> - User_error.raise ~loc - [ Pp.textf "Rule failed to produce directory %S" - (Path.of_string src - |> Path.drop_optional_build_context_maybe_sandboxed - |> Path.to_string_maybe_quoted) - ] - | Error (unix_error, _, _) -> - User_error.raise ~loc - [ Pp.textf "Rule produced unreadable directory %S" - (Path.of_string src - |> Path.drop_optional_build_context_maybe_sandboxed - |> Path.to_string_maybe_quoted) - ; Pp.verbatim (Unix.error_message unix_error) - ] +let rename_dir_recursively = + let dst_dir_to_string ~dst_dir = + Path.Build.drop_build_context_exn dst_dir + |> Path.Source.to_string_maybe_quoted in - loop - ~src:(Path.Build.to_string src_dir) - ~dst:(Path.Build.to_string dst_dir) - ~dst_parent:dst_dir - |> Path.Build.Set.of_list + let src_dir_to_string ~src_dir = + Path.Build.to_string src_dir + |> Path.of_string |> Path.drop_optional_build_context_maybe_sandboxed + |> Path.to_string_maybe_quoted + in + fun ~loc ~src_dir ~dst_dir -> + let rec loop ~src_dir ~dst_dir = + (match Fpath.mkdir (Path.Build.to_string dst_dir) with + | Created -> () + | Already_exists -> + User_error.raise ~loc + ~annots:[ User_error.Annot.Needs_stack_trace.make () ] + [ Pp.textf + "This rule defines a directory target %S whose name conflicts \ + with an internal directory used by Dune. Please use a different \ + name." + (dst_dir_to_string ~dst_dir) + ] + | Missing_parent_directory -> assert false); + match + Dune_filesystem_stubs.read_directory_with_kinds + (Path.Build.to_string src_dir) + with + | Ok files -> + List.concat_map files ~f:(fun (file, kind) -> + match (kind : Dune_filesystem_stubs.File_kind.t) with + | S_REG -> + let src = Path.Build.relative src_dir file in + let dst = Path.Build.relative dst_dir file in + Unix.rename (Path.Build.to_string src) (Path.Build.to_string dst); + [ dst ] + | S_DIR -> + let src_dir = Path.Build.relative src_dir file in + let dst_dir = Path.Build.relative dst_dir file in + loop ~src_dir ~dst_dir + | _ -> + User_error.raise ~loc + [ Pp.textf "Rule produced a file with unrecognised kind %S" + (Dune_filesystem_stubs.File_kind.to_string kind) + ]) + | Error (ENOENT, _, _) -> + User_error.raise ~loc + [ Pp.textf "Rule failed to produce directory %S" + (src_dir_to_string ~src_dir) + ] + | Error (unix_error, _, _) -> + User_error.raise ~loc + [ Pp.textf "Rule produced unreadable directory %S" + (src_dir_to_string ~src_dir) + ; Pp.verbatim (Unix.error_message unix_error) + ] + in + loop ~src_dir ~dst_dir |> Path.Build.Set.of_list let move_targets_to_build_dir t ~loc ~targets = Targets.to_list_map targets diff --git a/test/blackbox-tests/test-cases/directory-targets.t/run.t b/test/blackbox-tests/test-cases/directory-targets.t/run.t index 7cf741ac57f6..afd8871121b9 100644 --- a/test/blackbox-tests/test-cases/directory-targets.t/run.t +++ b/test/blackbox-tests/test-cases/directory-targets.t/run.t @@ -315,3 +315,48 @@ and the second one because of the lack of early cutoff. running bash contents running + +Check that Dune clears stale files from directory targets. + + $ cat > dune < (rule + > (deps src_a src_b src_c (sandbox always)) + > (targets output/*) + > (action (bash "echo running; mkdir -p output/subdir; cat src_a > output/new-a; cat src_b > output/subdir/b"))) + > (rule + > (deps output) + > (target contents) + > (action (bash "echo running; echo 'new-a:' > contents; cat output/new-a >> contents; echo 'b:' >> contents; cat output/subdir/b >> contents"))) + > EOF + + $ dune build contents + bash output + running + bash contents + running + +Note that the stale "output/a" file got removed. + + $ ls _build/default/output | sort + new-a + subdir + +Directory target whose name conflicts with an internal directory used by Dune. + + $ cat > dune < (rule + > (deps (sandbox always)) + > (targets .dune/*) + > (action (bash "mkdir .dune; echo hello > .dune/hello"))) + > EOF + + $ dune build .dune/hello + File "dune", line 1, characters 0-110: + 1 | (rule + 2 | (deps (sandbox always)) + 3 | (targets .dune/*) + 4 | (action (bash "mkdir .dune; echo hello > .dune/hello"))) + Error: This rule defines a directory target ".dune" whose name conflicts with + an internal directory used by Dune. Please use a different name. + -> required by _build/default/.dune/hello + [1]