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 =
|
type target =
|
||||||
| File of Path.t
|
| File of Path.t
|
||||||
|
| Alias of Path.t
|
||||||
| Alias_rec 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 request_of_targets (setup : Main.setup) targets =
|
||||||
let open Build.O in
|
let open Build.O in
|
||||||
let contexts = List.map setup.contexts ~f:(fun c -> c.Context.name) 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 >>>
|
acc >>>
|
||||||
match target with
|
match target with
|
||||||
| File path -> Build.path path
|
| 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 ->
|
| Alias_rec path ->
|
||||||
let dir = Path.parent_exn path in
|
let contexts, dir, name = parse_alias path ~contexts 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
|
|
||||||
Build_system.Alias.dep_rec_multi_contexts ~dir ~name
|
Build_system.Alias.dep_rec_multi_contexts ~dir ~name
|
||||||
~file_tree:setup.file_tree ~contexts)
|
~file_tree:setup.file_tree ~contexts)
|
||||||
|
|
||||||
|
@ -680,7 +686,13 @@ let resolve_targets ~log common (setup : Main.setup) user_targets =
|
||||||
let targets =
|
let targets =
|
||||||
List.map user_targets ~f:(fun s ->
|
List.map user_targets ~f:(fun s ->
|
||||||
if String.is_prefix s ~prefix:"@" then begin
|
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
|
let path = Path.relative Path.root (prefix_target common s) in
|
||||||
check_path path;
|
check_path path;
|
||||||
if Path.is_root path then
|
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
|
else if not (Path.is_managed path) then
|
||||||
die "@@ on the command line must be followed by a relative path"
|
die "@@ on the command line must be followed by a relative path"
|
||||||
else
|
else
|
||||||
Ok [Alias_rec path]
|
Ok [if is_rec then Alias_rec path else Alias path]
|
||||||
end else begin
|
end else begin
|
||||||
let path = Path.relative Path.root (prefix_target common s) in
|
let path = Path.relative Path.root (prefix_target common s) in
|
||||||
check_path path;
|
check_path path;
|
||||||
|
@ -725,6 +737,9 @@ let resolve_targets ~log common (setup : Main.setup) user_targets =
|
||||||
List.iter targets ~f:(function
|
List.iter targets ~f:(function
|
||||||
| File path ->
|
| File path ->
|
||||||
Log.info log @@ "- " ^ (Path.to_string path)
|
Log.info log @@ "- " ^ (Path.to_string path)
|
||||||
|
| Alias path ->
|
||||||
|
Log.info log @@ "- alias " ^
|
||||||
|
(Path.to_string_maybe_quoted path)
|
||||||
| Alias_rec path ->
|
| Alias_rec path ->
|
||||||
Log.info log @@ "- recursive alias " ^
|
Log.info log @@ "- recursive alias " ^
|
||||||
(Path.to_string_maybe_quoted path));
|
(Path.to_string_maybe_quoted path));
|
||||||
|
@ -1316,7 +1331,7 @@ let utop =
|
||||||
match resolve_targets_exn ~log common setup [utop_target] with
|
match resolve_targets_exn ~log common setup [utop_target] with
|
||||||
| [] -> die "no libraries defined in %s" dir
|
| [] -> die "no libraries defined in %s" dir
|
||||||
| [File target] -> target
|
| [File target] -> target
|
||||||
| [Alias_rec _] | _::_::_ -> assert false
|
| _ -> assert false
|
||||||
in
|
in
|
||||||
do_build setup [File target] >>| fun () ->
|
do_build setup [File target] >>| fun () ->
|
||||||
(setup.build_system, context, Path.to_string target)
|
(setup.build_system, context, Path.to_string target)
|
||||||
|
|
|
@ -121,6 +121,13 @@ So for instance:
|
||||||
the ``foo`` build context
|
the ``foo`` build context
|
||||||
- ``jbuilder build @runtest`` will run the tests for all build contexts
|
- ``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
|
Finding external libraries
|
||||||
==========================
|
==========================
|
||||||
|
|
||||||
|
|
|
@ -250,10 +250,26 @@ module Alias0 = struct
|
||||||
let fully_qualified_name t = Path.relative t.dir t.name
|
let fully_qualified_name t = Path.relative t.dir t.name
|
||||||
|
|
||||||
let stamp_file t =
|
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 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
|
let is_standard = function
|
||||||
| "runtest" | "install" | "doc" | "doc-private" | "lint" -> true
|
| "runtest" | "install" | "doc" | "doc-private" | "lint" -> true
|
||||||
| _ -> false
|
| _ -> false
|
||||||
|
@ -272,10 +288,14 @@ module Alias0 = struct
|
||||||
~else_:(Build.arr (fun x -> x)))
|
~else_:(Build.arr (fun x -> x)))
|
||||||
|
|
||||||
let dep_rec t ~loc ~file_tree =
|
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
|
match File_tree.find_dir file_tree src_dir with
|
||||||
| None -> Build.fail { fail = fun () ->
|
| None ->
|
||||||
Loc.fail loc "Don't know about directory %s!" (Path.to_string_maybe_quoted src_dir) }
|
Build.fail { fail = fun () ->
|
||||||
|
Loc.fail loc "Don't know about directory %s!"
|
||||||
|
(Path.to_string_maybe_quoted src_dir) }
|
||||||
| Some dir ->
|
| Some dir ->
|
||||||
dep_rec_internal ~name:t.name ~dir ~ctx_dir
|
dep_rec_internal ~name:t.name ~dir ~ctx_dir
|
||||||
>>^ fun is_empty ->
|
>>^ fun is_empty ->
|
||||||
|
@ -285,22 +305,18 @@ module Alias0 = struct
|
||||||
t.name (Path.to_string_maybe_quoted src_dir)
|
t.name (Path.to_string_maybe_quoted src_dir)
|
||||||
|
|
||||||
let dep_rec_multi_contexts ~dir:src_dir ~name ~file_tree ~contexts =
|
let dep_rec_multi_contexts ~dir:src_dir ~name ~file_tree ~contexts =
|
||||||
match File_tree.find_dir file_tree src_dir with
|
let open Build.O in
|
||||||
| None ->
|
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\
|
die "From the command line:\n\
|
||||||
@{<error>Error@}: Don't know about directory %s!" (Path.to_string_maybe_quoted src_dir)
|
@{<error>Error@}: Alias %S is empty.\n\
|
||||||
| Some dir ->
|
It is not defined in %s or any of its descendants."
|
||||||
let open Build.O in
|
name (Path.to_string_maybe_quoted src_dir)
|
||||||
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)
|
|
||||||
|
|
||||||
let default = make "DEFAULT"
|
let default = make "DEFAULT"
|
||||||
let runtest = make "runtest"
|
let runtest = make "runtest"
|
||||||
|
|
|
@ -129,6 +129,14 @@ module Alias : sig
|
||||||
(** [dep t = Build.path (stamp_file t)] *)
|
(** [dep t = Build.path (stamp_file t)] *)
|
||||||
val dep : t -> ('a, 'a) Build.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 *)
|
(** Implements [(alias_rec ...)] in dependency specification *)
|
||||||
val dep_rec
|
val dep_rec
|
||||||
: t
|
: t
|
||||||
|
|
|
@ -13,7 +13,7 @@
|
||||||
running in src
|
running in src
|
||||||
$ dune build --display short @plop
|
$ dune build --display short @plop
|
||||||
From the command line:
|
From the command line:
|
||||||
Error: Alias plop is empty.
|
Error: Alias "plop" is empty.
|
||||||
It is not defined in . or any of its descendants.
|
It is not defined in . or any of its descendants.
|
||||||
[1]
|
[1]
|
||||||
$ dune build --display short @truc/x
|
$ dune build --display short @truc/x
|
||||||
|
|
Loading…
Reference in New Issue