Support @@alias to build an alias non-recursively

Signed-off-by: Jeremie Dimino <jeremie@dimino.org>

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)

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
 ==========================
 

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>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"

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

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