diff --git a/CHANGES.md b/CHANGES.md index 5afe812b8db..bece4f1150c 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -67,6 +67,9 @@ next - Do not print diffs by default when running inside dune (#1260, @diml) +- Interpret `$ dune build dir` as building the default alias in `dir`. (#1259, + @rgrinberg) + 1.1.1 (08/08/2018) ------------------ diff --git a/bin/alias.ml b/bin/alias.ml new file mode 100644 index 00000000000..f28357132db --- /dev/null +++ b/bin/alias.ml @@ -0,0 +1,60 @@ +open Stdune + +let die = Dune.Import.die + +type t = + { name : string + ; recursive : bool + ; dir : Path.t + ; contexts : Dune.Context.t list + } + +let to_log_string { name ; recursive; dir ; contexts = _ } = + sprintf "- %s alias %s%s/%s" + (if recursive then "recursive " else "") + (if recursive then "@@" else "@") + (Path.to_string_maybe_quoted dir) + name + +let in_dir ~name ~recursive ~contexts dir = + Util.check_path contexts dir; + match Path.extract_build_context dir with + | None -> + { dir + ; recursive + ; name + ; contexts + } + | Some ("install", _) -> + die "Invalid alias: %s.\n\ + There are no aliases in %s." + (Path.to_string_maybe_quoted Path.(relative build_dir "install")) + (Path.to_string_maybe_quoted dir) + | Some (ctx, dir) -> + { dir + ; recursive + ; name + ; contexts = + [List.find_exn contexts ~f:(fun c -> Dune.Context.name c = ctx)] + } + +let of_string common s ~contexts = + if not (String.is_prefix s ~prefix:"@") then + None + else + let pos, recursive = + if String.length s >= 2 && s.[1] = '@' then + (2, false) + else + (1, true) + in + let s = String.drop s pos in + let path = Path.relative Path.root (Common.prefix_target common s) in + if Path.is_root path then + die "@@ on the command line must be followed by a valid alias name" + else if not (Path.is_managed path) then + die "@@ on the command line must be followed by a relative path" + else + let dir = Path.parent_exn path in + let name = Path.basename path in + Some (in_dir ~name ~recursive ~contexts dir) diff --git a/bin/alias.mli b/bin/alias.mli new file mode 100644 index 00000000000..12fd9b46dcb --- /dev/null +++ b/bin/alias.mli @@ -0,0 +1,19 @@ +open Stdune + +type t = private + { name : string + ; recursive : bool + ; dir : Path.t + ; contexts : Dune.Context.t list + } + +val in_dir + : name:string + -> recursive:bool + -> contexts:Dune.Context.t list + -> Path.t + -> t + +val of_string : Common.t -> string -> contexts:Dune.Context.t list -> t option + +val to_log_string : t -> string diff --git a/bin/main.ml b/bin/main.ml index f5eaf83228c..aeeda1863e8 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -584,11 +584,10 @@ let runtest = | dir -> sprintf "@%s/runtest" dir)); let log = Log.create common in let targets (setup : Main.setup) = - let check_path = Util.check_path setup.contexts in List.map dirs ~f:(fun dir -> let dir = Path.(relative root) (Common.prefix_target common dir) in - check_path dir; - Target.Alias_rec (Path.relative dir "runtest")) + Target.Alias (Alias.in_dir ~name:"runtest" ~recursive:true + ~contexts:setup.contexts dir)) in run_build_command ~log ~common ~targets in diff --git a/bin/target.ml b/bin/target.ml index ef563eeb2c2..cb0b683c17d 100644 --- a/bin/target.ml +++ b/bin/target.ml @@ -10,8 +10,7 @@ let hint = Dune.Import.hint type t = | File of Path.t - | Alias of Path.t - | Alias_rec of Path.t + | Alias of Alias.t type resolve_input = | Path of Path.t @@ -19,30 +18,23 @@ type resolve_input = let request (setup : Dune.Main.setup) targets = let open Build.O in - let contexts = List.map setup.contexts ~f:(fun c -> c.Context.name) in List.fold_left targets ~init:(Build.return ()) ~f:(fun acc target -> acc >>> match target with | File path -> Build.path path - | Alias path -> - let contexts, dir, name = Util.parse_alias path ~contexts in - Build_system.Alias.dep_multi_contexts ~dir ~name - ~file_tree:setup.file_tree ~contexts - | Alias_rec path -> - let contexts, dir, name = Util.parse_alias path ~contexts in - Build_system.Alias.dep_rec_multi_contexts ~dir ~name - ~file_tree:setup.file_tree ~contexts) + | Alias { Alias. name; recursive; dir; contexts } -> + let contexts = List.map ~f:Dune.Context.name contexts in + (if recursive then + Build_system.Alias.dep_rec_multi_contexts + else + Build_system.Alias.dep_multi_contexts) + ~dir ~name ~file_tree:setup.file_tree ~contexts) let log_targets ~log targets = List.iter targets ~f:(function | File path -> Log.info log @@ "- " ^ (Path.to_string path) - | Alias path -> - Log.info log @@ "- alias " ^ - (Path.to_string_maybe_quoted path) - | Alias_rec path -> - Log.info log @@ "- recursive alias " ^ - (Path.to_string_maybe_quoted path)); + | Alias a -> Log.info log (Alias.to_log_string a)); flush stdout let target_hint (setup : Dune.Main.setup) path = @@ -59,8 +51,8 @@ let target_hint (setup : Dune.Main.setup) path = | Some (_, path) -> path) in let candidates = - (* Only suggest hints for the basename, otherwise it's slow when there are lots of - files *) + (* Only suggest hints for the basename, otherwise it's slow when there are + lots of files *) List.filter_map candidates ~f:(fun path -> if Path.equal (Path.parent_exn path) sub_dir then Some (Path.to_string path) @@ -70,13 +62,15 @@ let target_hint (setup : Dune.Main.setup) path = let candidates = String.Set.of_list candidates |> String.Set.to_list in hint (Path.to_string path) candidates - let resolve_path path ~(setup : Dune.Main.setup) = Util.check_path setup.contexts path; let can't_build path = Error (path, target_hint setup path); in - if not (Path.is_managed path) then + if Dune.File_tree.dir_exists setup.file_tree path then + Ok [ Alias (Alias.in_dir ~name:"default" ~recursive:true + ~contexts:setup.contexts path) ] + else if not (Path.is_managed path) then Ok [File path] else if Path.is_in_build_dir path then begin if Build_system.is_target setup.build_system path then @@ -96,26 +90,11 @@ let resolve_path path ~(setup : Dune.Main.setup) = | l -> Ok l let resolve_target common ~(setup : Dune.Main.setup) s = - if String.is_prefix s ~prefix:"@" then begin - let pos, is_rec = - if String.length s >= 2 && s.[1] = '@' then - (2, false) - else - (1, true) - in - let s = String.drop s pos in - let path = Path.relative Path.root (Common.prefix_target common s) in - Util.check_path setup.contexts path; - if Path.is_root path then - die "@@ on the command line must be followed by a valid alias name" - else if not (Path.is_managed path) then - die "@@ on the command line must be followed by a relative path" - else - Ok [if is_rec then Alias_rec path else Alias path] - end else begin + match Alias.of_string common s ~contexts:setup.contexts with + | Some a -> Ok [Alias a] + | None -> let path = Path.relative Path.root (Common.prefix_target common s) in resolve_path path ~setup - end let resolve_targets_mixed ~log common (setup : Dune.Main.setup) user_targets = match user_targets with diff --git a/bin/target.mli b/bin/target.mli index e265d13418d..2c2fe39dce0 100644 --- a/bin/target.mli +++ b/bin/target.mli @@ -2,8 +2,7 @@ open Stdune type t = | File of Path.t - | Alias of Path.t - | Alias_rec of Path.t + | Alias of Alias.t val request : Dune.Main.setup diff --git a/bin/util.ml b/bin/util.ml index b2c2d096c78..ee834d6afa9 100644 --- a/bin/util.ml +++ b/bin/util.ml @@ -2,18 +2,6 @@ open! Stdune open Dune open Import -let parse_alias path ~contexts = - let dir = Path.parent_exn path in - let name = Path.basename path in - match Path.extract_build_context dir with - | None -> (contexts, dir, name) - | Some ("install", _) -> - die "Invalid alias: %s.\n\ - There are no aliases in %s." - (Path.to_string_maybe_quoted Path.(relative build_dir "install")) - (Path.to_string_maybe_quoted path) - | Some (ctx, dir) -> ([ctx], dir, name) - let check_path contexts = let contexts = String.Set.of_list (List.map contexts ~f:(fun c -> c.Context.name)) diff --git a/bin/util.mli b/bin/util.mli index e58ac688c22..2019c7e8c46 100644 --- a/bin/util.mli +++ b/bin/util.mli @@ -1,11 +1,6 @@ open Stdune open Dune -val parse_alias - : Path.t - -> contexts:string list - -> string list * Path.t * string - val check_path : Context.t list -> Path.t -> unit val find_root : unit -> string * string list diff --git a/doc/usage.rst b/doc/usage.rst index c7e173853c0..58b8203ea70 100644 --- a/doc/usage.rst +++ b/doc/usage.rst @@ -154,6 +154,19 @@ definition is assumed: Which means that by default ``dune build`` will build everything that is installable. +When using a directory as a target, it will be interpreted as building the +default target in the directory. The directory must exist in the source tree. + +.. code:: + + dune build dir + +Is equivalent to: + +.. code:: + + dune build @@dir/default + Finding external libraries ========================== diff --git a/src/context.ml b/src/context.ml index dae9f484f7c..730696ba2d8 100644 --- a/src/context.ml +++ b/src/context.ml @@ -585,3 +585,5 @@ let cc_g (ctx : t) = ["-g"] else [] + +let name t = t.name diff --git a/src/context.mli b/src/context.mli index f81571a58c2..efab295aa54 100644 --- a/src/context.mli +++ b/src/context.mli @@ -155,3 +155,5 @@ val best_mode : t -> Mode.t (** [\["-g"\]] if [!Clflags.g] and [\[\]] otherwise *) val cc_g : t -> string list + +val name : t -> string diff --git a/test/blackbox-tests/dune.inc b/test/blackbox-tests/dune.inc index 64c21d4df94..9affc076dab 100644 --- a/test/blackbox-tests/dune.inc +++ b/test/blackbox-tests/dune.inc @@ -804,6 +804,14 @@ test-cases/syntax-versioning (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) +(alias + (name target-dir-alias) + (deps (package dune) (source_tree test-cases/target-dir-alias)) + (action + (chdir + test-cases/target-dir-alias + (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))) + (alias (name tests-stanza) (deps (package dune) (source_tree test-cases/tests-stanza)) @@ -983,6 +991,7 @@ (alias shadow-bindings) (alias subst) (alias syntax-versioning) + (alias target-dir-alias) (alias tests-stanza) (alias tests-stanza-action) (alias too-many-parens) @@ -1081,6 +1090,7 @@ (alias shadow-bindings) (alias subst) (alias syntax-versioning) + (alias target-dir-alias) (alias tests-stanza) (alias tests-stanza-action) (alias too-many-parens) diff --git a/test/blackbox-tests/test-cases/target-dir-alias/dir-target-works/dune-project b/test/blackbox-tests/test-cases/target-dir-alias/dir-target-works/dune-project new file mode 100644 index 00000000000..47f0de83c49 --- /dev/null +++ b/test/blackbox-tests/test-cases/target-dir-alias/dir-target-works/dune-project @@ -0,0 +1 @@ +(lang dune 1.2) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/target-dir-alias/dir-target-works/foo/dune b/test/blackbox-tests/test-cases/target-dir-alias/dir-target-works/foo/dune new file mode 100644 index 00000000000..a74b2c1dd84 --- /dev/null +++ b/test/blackbox-tests/test-cases/target-dir-alias/dir-target-works/foo/dune @@ -0,0 +1,3 @@ +(alias + (name default) + (action (echo "default target works"))) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/target-dir-alias/run.t b/test/blackbox-tests/test-cases/target-dir-alias/run.t new file mode 100644 index 00000000000..9246c8bf148 --- /dev/null +++ b/test/blackbox-tests/test-cases/target-dir-alias/run.t @@ -0,0 +1,5 @@ +Building a directory results in the default target being built + + $ dune build foo --root dir-target-works + Entering directory 'dir-target-works' + default target works