diff --git a/CHANGES.md b/CHANGES.md index 45e010eb4b6..51cf3b8f613 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,6 +1,10 @@ 3.5.0 (unreleased) ------------------ +- Disallow generating targets in sub direcories in inferred rules. The check to + forbid this was accidentally done only for manually specified targets (#6031, + @rgrinberg) + - Do not ignore rules marked `(promote (until-clean))` when `--ignore-promoted-rules` (or `-p`) is passed. (#6010, fixes #4401, @emillon) diff --git a/src/dune_engine/rule.ml b/src/dune_engine/rule.ml index e8eb2b25631..87eea8dde41 100644 --- a/src/dune_engine/rule.ml +++ b/src/dune_engine/rule.ml @@ -95,8 +95,10 @@ let make ?(mode = Mode.Standard) ~context ?(info = Info.Internal) ~targets | Valid { parent_dir; targets } -> (parent_dir, 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 ] + (* user written actions have their own validation step that also works + with the target inference mechanism *) + Code_error.raise "Rule has targets in different directories." + [ ("targets", Targets.to_dyn targets) ] | File_and_directory_target_with_the_same_name path -> report_error (sprintf "%S is declared as both a file and a directory target." diff --git a/src/dune_rules/action_unexpanded.ml b/src/dune_rules/action_unexpanded.ml index 7a43e1bee40..00c8aaa8297 100644 --- a/src/dune_rules/action_unexpanded.ml +++ b/src/dune_rules/action_unexpanded.ml @@ -16,6 +16,15 @@ let as_in_build_dir ~what ~loc p = (Path.to_string_maybe_quoted p) ] +let validate_target_dir ~targets_dir ~loc targets path = + if Path.Build.(parent_exn path <> targets_dir) then + User_error.raise ~loc + [ Pp.text + "This action has targets in a different directory than the current \ + one, this is not allowed by dune at the moment:" + ; Targets.pp targets + ] + module Action_expander : sig (* An applicative to help write action expansion. It is similar to [Action_builder.With_targets.t] but with some differences. The differences @@ -40,7 +49,10 @@ module Action_expander : sig val set_env : var:string -> value:string t -> (value:string -> 'a) t -> 'a t val run : - 'a t -> expander:Expander.t -> 'a Action_builder.With_targets.t Memo.t + 'a t + -> targets_dir:Path.Build.t option + -> expander:Expander.t + -> 'a Action_builder.With_targets.t Memo.t (* String with vars expansion *) module E : sig @@ -85,7 +97,7 @@ end = struct type deps = Path.Set.t Action_builder.t type collector = - { file_targets : Path.Build.Set.t (** We only infer file targets *) + { file_targets : Loc.t Path.Build.Map.t (** We only infer file targets *) ; deps : deps ; deps_if_exist : deps } @@ -121,10 +133,10 @@ end = struct in fun l env acc -> loop [] l env acc - let run t ~expander = + let run t ~targets_dir ~expander = let deps = Action_builder.return Path.Set.empty in let acc = - { file_targets = Path.Build.Set.empty; deps; deps_if_exist = deps } + { file_targets = Path.Build.Map.empty; deps; deps_if_exist = deps } in let env = { expander; infer = true; dir = Expander.dir expander } in Memo.map (t env acc) ~f:(fun (b, acc) -> @@ -135,7 +147,7 @@ end = struct {[ (progn (copy a b) (copy b c)) ]} *) let remove_targets = let file_targets = - Path.Build.Set.to_list file_targets + Path.Build.Map.keys file_targets |> Path.Set.of_list_map ~f:Path.build in fun deps -> Path.Set.diff deps file_targets @@ -149,7 +161,13 @@ end = struct >>> Action_builder.if_file_exists f ~then_:(Action_builder.path f) ~else_:(Action_builder.return ())) in - let targets = Targets.Files.create file_targets in + let targets = + let file_targets = Path.Build.Set.of_keys file_targets in + Targets.Files.create file_targets + in + Option.iter targets_dir ~f:(fun targets_dir -> + Path.Build.Map.iteri file_targets ~f:(fun path loc -> + validate_target_dir ~targets_dir ~loc targets path)); Action_builder.with_targets ~targets (let+ () = deps >>= Action_builder.path_set and+ () = deps_if_exist >>= action_builder_path_set_if_exist @@ -308,14 +326,16 @@ end = struct , acc ) else let+! p = Expander.No_deps.expand_path env sw in - let p = as_in_build_dir p ~what ~loc:(loc sw) in + let loc = loc sw in + let p = as_in_build_dir p ~what ~loc in ( Action_builder.return p - , { acc with file_targets = f acc.file_targets p } ) + , { acc with file_targets = f acc.file_targets p loc } ) let consume_file = - add_or_remove_target ~what:"File" ~f:Path.Build.Set.remove + add_or_remove_target ~what:"File" ~f:(fun map p _loc -> + Path.Build.Map.remove map p) - let target = add_or_remove_target ~what:"Target" ~f:Path.Build.Set.add + let target = add_or_remove_target ~what:"Target" ~f:Path.Build.Map.set let prog_and_args sw env acc = let b = @@ -464,7 +484,8 @@ let expand_no_targets t ~loc ~deps:deps_written_by_user ~expander ~what = Expander.set_expanding_what expander (User_action_without_targets { what }) in let* { Action_builder.With_targets.build; targets } = - Action_builder.of_memo (Action_expander.run (expand t) ~expander) + Action_builder.of_memo + (Action_expander.run (expand t) ~targets_dir:None ~expander) in if not (Targets.is_empty targets) then User_error.raise ~loc @@ -507,7 +528,7 @@ let expand t ~loc ~deps:deps_written_by_user ~targets_dir Expander.set_expanding_what expander (User_action targets_written_by_user) in let+! { Action_builder.With_targets.build; targets } = - Action_expander.run (expand t) ~expander + Action_expander.run (expand t) ~targets_dir:(Some targets_dir) ~expander in let targets = match (targets_written_by_user : _ Targets_spec.t) with @@ -515,13 +536,7 @@ let expand t ~loc ~deps:deps_written_by_user ~targets_dir | Static { targets = targets_written_by_user; multiplicity = _ } -> let files, dirs = List.partition_map targets_written_by_user ~f:(fun (path, kind) -> - if Path.Build.(parent_exn path <> targets_dir) then - User_error.raise ~loc - [ Pp.text - "This action has targets in a different directory than the \ - current one, this is not allowed by dune at the moment:" - ; Targets.pp targets - ]; + validate_target_dir ~targets_dir ~loc targets path; match kind with | File -> Left path | Directory -> Right path) diff --git a/src/dune_rules/simple_rules.ml b/src/dune_rules/simple_rules.ml index 37b210ba2ff..1bb9f9469b7 100644 --- a/src/dune_rules/simple_rules.ml +++ b/src/dune_rules/simple_rules.ml @@ -12,8 +12,8 @@ module Alias_rules = struct add sctx ~loc ~alias action end -let check_filename ~kind = - let not_in_dir ~error_loc s = +let check_filename = + let not_in_dir ~kind ~error_loc s = User_error.raise ~loc:error_loc [ (match kind with | Targets_spec.Kind.File -> @@ -22,19 +22,19 @@ let check_filename ~kind = Pp.textf "Directory targets must have exactly one path component.") ] in - fun ~error_loc ~dir -> function + fun ~kind ~error_loc ~dir -> function | Value.String ("." | "..") -> User_error.raise ~loc:error_loc [ Pp.text "'.' and '..' are not valid targets" ] | String s -> if Filename.dirname s <> Filename.current_dir_name then - not_in_dir ~error_loc s; + not_in_dir ~kind ~error_loc s; Path.Build.relative ~error_loc dir s | Path p -> ( match Option.equal Path.equal (Path.parent p) (Some (Path.build dir)) with | true -> Path.as_in_build_dir_exn p - | false -> not_in_dir ~error_loc (Path.to_string p)) - | Dir p -> not_in_dir ~error_loc (Path.to_string p) + | false -> not_in_dir ~kind ~error_loc (Path.to_string p)) + | Dir p -> not_in_dir ~kind ~error_loc (Path.to_string p) type rule_kind = | Alias_only of Alias.Name.t @@ -96,11 +96,10 @@ let user_rule sctx ?extra_bindings ~dir ~expander (rule : Rule.t) = | None -> expander | Some bindings -> Expander.add_bindings expander ~bindings in - let action = + let* (action : _ Action_builder.With_targets.t) = Action_unexpanded.expand (snd rule.action) ~loc:(fst rule.action) ~expander ~deps:rule.deps ~targets ~targets_dir:dir in - let* action = action in let action = if rule.patch_back_source_tree then Action_builder.With_targets.map action ~f:(fun action -> diff --git a/test/blackbox-tests/test-cases/directory-targets/create-target-chdir.t b/test/blackbox-tests/test-cases/directory-targets/create-target-chdir.t index 6f5b6817452..c14ef8b342b 100644 --- a/test/blackbox-tests/test-cases/directory-targets/create-target-chdir.t +++ b/test/blackbox-tests/test-cases/directory-targets/create-target-chdir.t @@ -16,16 +16,10 @@ Attempt to create a directory with chdir + with-stdout-to: > EOF $ dune build foobar/ - File "dune", line 1, characters 0-130: - 1 | (rule - 2 | (targets (dir output)) - 3 | (deps (sandbox always)) - 4 | (action - 5 | (progn - 6 | (chdir output + File "dune", line 7, characters 20-21: 7 | (with-stdout-to x (echo foobar)))))) - Error: Rule has targets in different directories. - Targets: + ^ + Error: This action has targets in a different directory than the current one, + this is not allowed by dune at the moment: - output/x - - output [1] diff --git a/test/blackbox-tests/test-cases/generate-sources.t b/test/blackbox-tests/test-cases/generate-sources.t index 4bb7bb36962..f8002dde531 100644 --- a/test/blackbox-tests/test-cases/generate-sources.t +++ b/test/blackbox-tests/test-cases/generate-sources.t @@ -2,19 +2,20 @@ Generate the source of an executable in a subdir: $ cat >dune-project < (lang dune 3.2) + > (using directory-targets 0.1) > EOF $ cat >dune < (rule - > (with-stdout-to foo/bar.ml (echo "let foo = 42;;"))) + > (targets (dir foo)) + > (action (bash "mkdir foo && cat 'print_endline \"42\";;' > foo/bar.ml"))) > (include_subdirs unqualified) > (executable (name bar)) > EOF $ dune exec --display short ./bar.exe - ocamlc .bar.eobjs/byte/dune__exe__Bar.{cmi,cmti} - File "dune", line 4, characters 0-23: - 4 | (executable (name bar)) - ^^^^^^^^^^^^^^^^^^^^^^^ - Error: No rule found for bar.ml + File "dune", line 5, characters 18-21: + 5 | (executable (name bar)) + ^^^ + Error: Module "Bar" doesn't exist. [1] diff --git a/test/blackbox-tests/test-cases/target-outside-dir.t b/test/blackbox-tests/test-cases/target-outside-dir.t index c5131671081..39d26966425 100644 --- a/test/blackbox-tests/test-cases/target-outside-dir.t +++ b/test/blackbox-tests/test-cases/target-outside-dir.t @@ -15,6 +15,13 @@ The restriction on generating targets should be the same on both. > EOF $ dune build foo/bar.ml + File "dune", line 2, characters 17-27: + 2 | (with-stdout-to foo/bar.ml (echo "let foo = 42;;"))) + ^^^^^^^^^^ + Error: This action has targets in a different directory than the current one, + this is not allowed by dune at the moment: + - foo/bar.ml + [1] $ cat >dune < (rule