diff --git a/bin/main.ml b/bin/main.ml index 8b6c3ca9..6679518c 100644 --- a/bin/main.ml +++ b/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) diff --git a/doc/usage.rst b/doc/usage.rst index c12ba0ac..322951ba 100644 --- a/doc/usage.rst +++ b/doc/usage.rst @@ -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 ========================== diff --git a/src/build_system.ml b/src/build_system.ml index 16e655fb..7ac64409 100644 --- a/src/build_system.ml +++ b/src/build_system.ml @@ -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@}: 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@}: 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@}: 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@}: 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" diff --git a/src/build_system.mli b/src/build_system.mli index 631122ee..f5cbf206 100644 --- a/src/build_system.mli +++ b/src/build_system.mli @@ -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 diff --git a/test/blackbox-tests/test-cases/aliases/run.t b/test/blackbox-tests/test-cases/aliases/run.t index b249a3bb..78573784 100644 --- a/test/blackbox-tests/test-cases/aliases/run.t +++ b/test/blackbox-tests/test-cases/aliases/run.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