Support @@alias to build an alias non-recursively
Signed-off-by: Jeremie Dimino <jeremie@dimino.org>
This commit is contained in:
parent
79f3506922
commit
30db63ef71
45
bin/main.ml
45
bin/main.ml
|
@ -114,8 +114,21 @@ end
|
|||
|
||||
type target =
|
||||
| File of Path.t
|
||||
| Alias of Path.t
|
||||
| Alias_rec of Path.t
|
||||
|
||||
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 request_of_targets (setup : Main.setup) targets =
|
||||
let open Build.O in
|
||||
let contexts = List.map setup.contexts ~f:(fun c -> c.Context.name) in
|
||||
|
@ -123,19 +136,12 @@ let request_of_targets (setup : Main.setup) targets =
|
|||
acc >>>
|
||||
match target with
|
||||
| File path -> Build.path path
|
||||
| Alias path ->
|
||||
let contexts, dir, name = parse_alias path ~contexts in
|
||||
Build_system.Alias.dep_multi_contexts ~dir ~name
|
||||
~file_tree:setup.file_tree ~contexts
|
||||
| Alias_rec path ->
|
||||
let dir = Path.parent_exn path in
|
||||
let name = Path.basename path in
|
||||
let contexts, dir =
|
||||
match Path.extract_build_context dir with
|
||||
| None -> (contexts, dir)
|
||||
| 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)
|
||||
in
|
||||
let contexts, dir, name = parse_alias path ~contexts in
|
||||
Build_system.Alias.dep_rec_multi_contexts ~dir ~name
|
||||
~file_tree:setup.file_tree ~contexts)
|
||||
|
||||
|
@ -680,7 +686,13 @@ let resolve_targets ~log common (setup : Main.setup) user_targets =
|
|||
let targets =
|
||||
List.map user_targets ~f:(fun s ->
|
||||
if String.is_prefix s ~prefix:"@" then begin
|
||||
let s = String.sub s ~pos:1 ~len:(String.length s - 1) in
|
||||
let pos, is_rec =
|
||||
if String.length s >= 2 && s.[1] = '@' then
|
||||
(2, false)
|
||||
else
|
||||
(1, true)
|
||||
in
|
||||
let s = String.sub s ~pos ~len:(String.length s - pos) in
|
||||
let path = Path.relative Path.root (prefix_target common s) in
|
||||
check_path path;
|
||||
if Path.is_root path then
|
||||
|
@ -688,7 +700,7 @@ let resolve_targets ~log common (setup : Main.setup) user_targets =
|
|||
else if not (Path.is_managed path) then
|
||||
die "@@ on the command line must be followed by a relative path"
|
||||
else
|
||||
Ok [Alias_rec path]
|
||||
Ok [if is_rec then Alias_rec path else Alias path]
|
||||
end else begin
|
||||
let path = Path.relative Path.root (prefix_target common s) in
|
||||
check_path path;
|
||||
|
@ -725,6 +737,9 @@ let resolve_targets ~log common (setup : Main.setup) user_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));
|
||||
|
@ -1316,7 +1331,7 @@ let utop =
|
|||
match resolve_targets_exn ~log common setup [utop_target] with
|
||||
| [] -> die "no libraries defined in %s" dir
|
||||
| [File target] -> target
|
||||
| [Alias_rec _] | _::_::_ -> assert false
|
||||
| _ -> assert false
|
||||
in
|
||||
do_build setup [File target] >>| fun () ->
|
||||
(setup.build_system, context, Path.to_string target)
|
||||
|
|
|
@ -121,6 +121,13 @@ So for instance:
|
|||
the ``foo`` build context
|
||||
- ``jbuilder build @runtest`` will run the tests for all build contexts
|
||||
|
||||
You can also build an alias non-recursively by using ``@@`` instead of
|
||||
``@``. For instance to run tests only from the current directory:
|
||||
|
||||
.. code::
|
||||
|
||||
dune build @@runtest
|
||||
|
||||
Finding external libraries
|
||||
==========================
|
||||
|
||||
|
|
|
@ -250,10 +250,26 @@ module Alias0 = struct
|
|||
let fully_qualified_name t = Path.relative t.dir t.name
|
||||
|
||||
let stamp_file t =
|
||||
Path.relative (Path.insert_after_build_dir_exn t.dir ".aliases") (t.name ^ suffix)
|
||||
Path.relative (Path.insert_after_build_dir_exn t.dir ".aliases")
|
||||
(t.name ^ suffix)
|
||||
|
||||
let dep t = Build.path (stamp_file t)
|
||||
|
||||
let find_dir_specified_on_command_line ~dir ~file_tree =
|
||||
match File_tree.find_dir file_tree dir with
|
||||
| None ->
|
||||
die "From the command line:\n\
|
||||
@{<error>Error@}: Don't know about directory %s!"
|
||||
(Path.to_string_maybe_quoted dir)
|
||||
| Some dir -> dir
|
||||
|
||||
let dep_multi_contexts ~dir ~name ~file_tree ~contexts =
|
||||
ignore
|
||||
(find_dir_specified_on_command_line ~dir ~file_tree : File_tree.Dir.t);
|
||||
Build.paths (List.map contexts ~f:(fun ctx ->
|
||||
let dir = Path.append (Path.(relative build_dir) ctx) dir in
|
||||
stamp_file (make ~dir name)))
|
||||
|
||||
let is_standard = function
|
||||
| "runtest" | "install" | "doc" | "doc-private" | "lint" -> true
|
||||
| _ -> false
|
||||
|
@ -272,10 +288,14 @@ module Alias0 = struct
|
|||
~else_:(Build.arr (fun x -> x)))
|
||||
|
||||
let dep_rec t ~loc ~file_tree =
|
||||
let ctx_dir, src_dir = Path.extract_build_context_dir t.dir |> Option.value_exn in
|
||||
let ctx_dir, src_dir =
|
||||
Path.extract_build_context_dir t.dir |> Option.value_exn
|
||||
in
|
||||
match File_tree.find_dir file_tree src_dir with
|
||||
| None -> Build.fail { fail = fun () ->
|
||||
Loc.fail loc "Don't know about directory %s!" (Path.to_string_maybe_quoted src_dir) }
|
||||
| None ->
|
||||
Build.fail { fail = fun () ->
|
||||
Loc.fail loc "Don't know about directory %s!"
|
||||
(Path.to_string_maybe_quoted src_dir) }
|
||||
| Some dir ->
|
||||
dep_rec_internal ~name:t.name ~dir ~ctx_dir
|
||||
>>^ fun is_empty ->
|
||||
|
@ -285,22 +305,18 @@ module Alias0 = struct
|
|||
t.name (Path.to_string_maybe_quoted src_dir)
|
||||
|
||||
let dep_rec_multi_contexts ~dir:src_dir ~name ~file_tree ~contexts =
|
||||
match File_tree.find_dir file_tree src_dir with
|
||||
| None ->
|
||||
let open Build.O in
|
||||
let dir = find_dir_specified_on_command_line ~dir:src_dir ~file_tree in
|
||||
Build.all (List.map contexts ~f:(fun ctx ->
|
||||
let ctx_dir = Path.(relative build_dir) ctx in
|
||||
dep_rec_internal ~name ~dir ~ctx_dir))
|
||||
>>^ fun is_empty_list ->
|
||||
let is_empty = List.for_all is_empty_list ~f:(fun x -> x) in
|
||||
if is_empty && not (is_standard name) then
|
||||
die "From the command line:\n\
|
||||
@{<error>Error@}: Don't know about directory %s!" (Path.to_string_maybe_quoted src_dir)
|
||||
| Some dir ->
|
||||
let open Build.O in
|
||||
Build.all (List.map contexts ~f:(fun ctx ->
|
||||
let ctx_dir = Path.(relative build_dir) ctx in
|
||||
dep_rec_internal ~name ~dir ~ctx_dir))
|
||||
>>^ fun is_empty_list ->
|
||||
let is_empty = List.for_all is_empty_list ~f:(fun x -> x) in
|
||||
if is_empty && not (is_standard name) then
|
||||
die "From the command line:\n\
|
||||
@{<error>Error@}: Alias %s is empty.\n\
|
||||
It is not defined in %s or any of its descendants."
|
||||
name (Path.to_string_maybe_quoted src_dir)
|
||||
@{<error>Error@}: Alias %S is empty.\n\
|
||||
It is not defined in %s or any of its descendants."
|
||||
name (Path.to_string_maybe_quoted src_dir)
|
||||
|
||||
let default = make "DEFAULT"
|
||||
let runtest = make "runtest"
|
||||
|
|
|
@ -129,6 +129,14 @@ module Alias : sig
|
|||
(** [dep t = Build.path (stamp_file t)] *)
|
||||
val dep : t -> ('a, 'a) Build.t
|
||||
|
||||
(** Implements [@@alias] on the command line *)
|
||||
val dep_multi_contexts
|
||||
: dir:Path.t
|
||||
-> name:string
|
||||
-> file_tree:File_tree.t
|
||||
-> contexts:string list
|
||||
-> (unit, unit) Build.t
|
||||
|
||||
(** Implements [(alias_rec ...)] in dependency specification *)
|
||||
val dep_rec
|
||||
: t
|
||||
|
|
|
@ -13,7 +13,7 @@
|
|||
running in src
|
||||
$ dune build --display short @plop
|
||||
From the command line:
|
||||
Error: Alias plop is empty.
|
||||
Error: Alias "plop" is empty.
|
||||
It is not defined in . or any of its descendants.
|
||||
[1]
|
||||
$ dune build --display short @truc/x
|
||||
|
|
Loading…
Reference in New Issue