More comments and tests

Signed-off-by: Andrey Mokhov <[email protected]>

Author: snowleopard

bin/target.ml

@@ -21,6 +21,14 @@ let target_hint (_setup : Dune_rules.Main.build_system) path =
   assert (Path.is_managed path);
   let open Memo.Build.O in
   let sub_dir = Option.value ~default:path (Path.parent path) in
+  (* CR-someday amokhov: There are two issues with the code below.
+
+     (1) We first get *all* targets but then filter out only those that are
+     defined in the [sub_dir]. It would be better to just get the targets for
+     the [sub_dir] directly (the API supports this).
+
+     (2) We currently provide the same hint for all targets. It would be nice to
+     indicate whether a hint corresponds to a file or to a directory target. *)
   let+ candidates = Build_system.all_targets () >>| Path.Build.Set.to_list in
   let candidates =
     if Path.is_in_build_dir path then

src/dune_engine/build_system.ml

@@ -1571,9 +1571,13 @@ end = struct
     let action =
       match sandbox with
       | None ->
+        (* CR-someday amokhov: It may be possible to support directory targets
+           without sandboxing. We just need to make sure we clean up all stale
+           directory targets before running the rule and then we can discover
+           all created files right in the build directory. *)
         if has_directory_targets then
           User_error.raise ~loc
-            [ Pp.text "Rules with directory targets must be sandboxed" ];
+            [ Pp.text "Rules with directory targets must be sandboxed." ];
         action
       | Some sandbox -> Action.sandbox action sandbox
     in

src/dune_engine/rule.ml

@@ -101,28 +101,27 @@ let make ?(sandbox = Sandbox_config.default) ?(mode = Mode.Standard) ~context
                (action, deps))
          })
   in
+  let report_error ?(extra_pp = []) message =
+    match info with
+    | From_dune_file loc ->
+      let pp = [ Pp.text message ] @ extra_pp in
+      User_error.raise ~loc pp
+    | Internal
+    | Source_file_copy _ ->
+      Code_error.raise message
+        [ ("info", Info.to_dyn info); ("targets", Targets.to_dyn targets) ]
+  in
   let dir =
     match Targets.validate targets with
     | Valid { parent_dir } -> parent_dir
-    | 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.Targets: An internal rule has targets in different directories"
-          [ ("targets", Targets.to_dyn targets) ])
+    | No_targets -> report_error "Rule has no targets specified"
+    | Inconsistent_parent_dir ->
+      report_error "Rule has targets in different directories."
+        ~extra_pp:[ Pp.text "Targets:"; Targets.pp targets ]
+    | File_and_directory_target_with_the_same_name path ->
+      report_error
+        (sprintf "%S is declared as both a file and a directory target."
+           (Dpath.describe_target path))
   in
   let loc =
     match info with

src/dune_engine/rule.mli

@@ -76,6 +76,8 @@ val hash : t -> int
 
 val to_dyn : t -> Dyn.t
 
+(** [make] raises an error if the set of [targets] is not well-formed. See the
+    [Targets.Validation_result] for the list of possible problems. *)
 val make :
      ?sandbox:Sandbox_config.t
   -> ?mode:Mode.t

src/dune_engine/sandbox_mode.ml

@@ -86,6 +86,14 @@ module Set = struct
     ; symlink = x.symlink && y.symlink
     ; hardlink = x.hardlink && y.hardlink
     }
+
+  let to_dyn (t : t) =
+    Dyn.Record
+      [ ("none", Dyn.Bool t.none)
+      ; ("copy", Dyn.Bool t.copy)
+      ; ("symlink", Dyn.Bool t.symlink)
+      ; ("hardlink", Dyn.Bool t.hardlink)
+      ]
 end
 
 (* these should be listed in the default order of preference *)

src/dune_engine/sandbox_mode.mli

@@ -2,8 +2,10 @@
 
 (** This module describes the method used to sandbox actions. Choices include:
 
-    - not sandboxing - sandboxing by symlinking dependencies - sandboxing by
-      copying dependencies *)
+    - not sandboxing
+    - sandboxing by symlinking dependencies
+    - sandboxing by copying dependencies
+    - sandboxing by hardlinking dependencies *)
 
 open! Stdune
 
@@ -49,6 +51,8 @@ module Set : sig
   val mem : t -> key -> bool
 
   val inter : t -> t -> t
+
+  val to_dyn : t -> Dyn.t
 end
 
 val all : t list

src/dune_engine/targets.ml

@@ -51,7 +51,7 @@ let to_dyn { files; dirs } =
 let pp { files; dirs } =
   Pp.enumerate
     (Path.Build.Set.to_list files @ Path.Build.Set.to_list dirs)
-    ~f:(fun target -> Pp.text (Dpath.describe_path (Path.build target)))
+    ~f:(fun target -> Pp.text (Dpath.describe_target target))
 
 let exists { files; dirs } ~f =
   Path.Build.Set.exists files ~f || Path.Build.Set.exists dirs ~f
@@ -75,15 +75,19 @@ module Validation_result = struct
     | Valid of { parent_dir : Path.Build.t }
     | No_targets
     | Inconsistent_parent_dir
+    | File_and_directory_target_with_the_same_name of Path.Build.t
 end
 
 let validate t =
   match is_empty t with
   | true -> Validation_result.No_targets
   | false -> (
-    let parent_dir = Path.Build.parent_exn (head_exn t) in
-    match
-      exists t ~f:(fun path -> Path.Build.(parent_exn path <> parent_dir))
-    with
-    | true -> Inconsistent_parent_dir
-    | false -> Valid { parent_dir })
+    match Path.Build.Set.inter t.files t.dirs |> Path.Build.Set.choose with
+    | Some path -> File_and_directory_target_with_the_same_name path
+    | None -> (
+      let parent_dir = Path.Build.parent_exn (head_exn t) in
+      match
+        exists t ~f:(fun path -> Path.Build.(parent_exn path <> parent_dir))
+      with
+      | true -> Inconsistent_parent_dir
+      | false -> Valid { parent_dir }))

src/dune_engine/targets.mli

@@ -35,10 +35,10 @@ module Validation_result : sig
     | Valid of { parent_dir : Path.Build.t }
     | No_targets
     | Inconsistent_parent_dir
+    | File_and_directory_target_with_the_same_name of Path.Build.t
 end
 
-(** Ensure that the set of targets is non-empty and that all targets have the
-    same parent dir. *)
+(** Ensure that the set of targets is well-formed. *)
 val validate : t -> Validation_result.t
 
 (** The "head" target if [t] is non-empty. If [t] contains at least one file,

src/dune_rules/simple_rules.ml

@@ -18,15 +18,20 @@ end
 let interpret_locks ~expander =
   Memo.Build.List.map ~f:(Expander.No_deps.expand_path expander)
 
-let check_filename =
+let check_filename ~kind =
   let not_in_dir ~error_loc s =
     User_error.raise ~loc:error_loc
-      [ Pp.textf "%s does not denote a file in the current directory" s ]
+      [ (match kind with
+        | Targets_spec.Kind.File ->
+          Pp.textf "%S does not denote a file in the current directory." s
+        | Directory ->
+          Pp.textf "Directory targets must have exactly one path component.")
+      ]
   in
   fun ~error_loc ~dir -> function
     | Value.String ("." | "..") ->
       User_error.raise ~loc:error_loc
-        [ Pp.text "'.' and '..' are not valid filenames" ]
+        [ Pp.text "'.' and '..' are not valid targets" ]
     | String s ->
       if Filename.dirname s <> Filename.current_dir_name then
         not_in_dir ~error_loc s;
@@ -84,7 +89,7 @@ let user_rule sctx ?extra_bindings ~dir ~expander (rule : Rule.t) =
                 [ x ]
               | Multiple -> Expander.No_deps.expand expander ~mode:Many target)
               >>| List.map ~f:(fun value ->
-                      (check_filename ~dir ~error_loc value, kind)))
+                      (check_filename ~kind ~dir ~error_loc value, kind)))
         in
         Targets_spec.Static { multiplicity; targets }
     in

test/blackbox-tests/test-cases/directory-targets.t/run.t

@@ -31,7 +31,7 @@ Directory targets are not allowed for non-sandboxed rules.
   1 | (rule
   2 |   (targets (dir output))
   3 |   (action (bash "true")))
-  Error: Rules with directory targets must be sandboxed
+  Error: Rules with directory targets must be sandboxed.
   [1]
 
 Ensure directory targets are produced.
@@ -388,3 +388,37 @@ Directory target whose name conflicts with an internal directory used by Dune.
   an internal directory used by Dune. Please use a different name.
   -> required by _build/default/.dune/hello
   [1]
+
+Multi-component target directories are not allowed.
+
+  $ cat > dune <<EOF
+  > (rule
+  >   (deps (sandbox always))
+  >   (targets (dir output/subdir))
+  >   (action (bash "mkdir output; echo x > output/x; echo y > output/y")))
+  > EOF
+
+  $ dune build output/x
+  File "dune", line 3, characters 16-29:
+  3 |   (targets (dir output/subdir))
+                      ^^^^^^^^^^^^^
+  Error: Directory targets must have exactly one path component.
+  [1]
+
+File and directory target with the same name.
+
+  $ cat > dune <<EOF
+  > (rule
+  >   (deps (sandbox always))
+  >   (targets output (dir output))
+  >   (action (bash "mkdir output; echo x > output/x; echo y > output/y")))
+  > EOF
+
+  $ dune build output/x
+  File "dune", line 1, characters 0-135:
+  1 | (rule
+  2 |   (deps (sandbox always))
+  3 |   (targets output (dir output))
+  4 |   (action (bash "mkdir output; echo x > output/x; echo y > output/y")))
+  Error: "output" is declared as both a file and a directory target.
+  [1]