Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
10 changes: 10 additions & 0 deletions bin/arg.ml
Original file line number Diff line number Diff line change
Expand Up @@ -116,6 +116,16 @@ module Dep = struct

let conv = conv' (parser, printer)
let to_string_maybe_quoted t = String.maybe_quoted (Format.asprintf "%a" printer t)

let alias_arg =
let parse x = Ok (Dep_conf.Alias (String_with_vars.make_text Loc.none x)) in
conv' (parse, printer)
;;

let alias_rec_arg =
let parse x = Ok (Dep_conf.Alias_rec (String_with_vars.make_text Loc.none x)) in
conv' (parse, printer)
;;
end

let dep = Dep.conv
Expand Down
2 changes: 2 additions & 0 deletions bin/arg.mli
Original file line number Diff line number Diff line change
Expand Up @@ -26,6 +26,8 @@ module Dep : sig
val alias : dir:Stdune.Path.Local.t -> Dune_engine.Alias.Name.t -> t
val alias_rec : dir:Stdune.Path.Local.t -> Dune_engine.Alias.Name.t -> t
val to_string_maybe_quoted : t -> string
val alias_arg : t conv
val alias_rec_arg : t conv
end

val bytes : int64 conv
Expand Down
5 changes: 4 additions & 1 deletion bin/build.ml
Original file line number Diff line number Diff line change
Expand Up @@ -184,7 +184,10 @@ let build =
let name_ = Arg.info [] ~docv:"TARGET" in
let term =
let+ builder = Common.Builder.term
and+ targets = Arg.(value & pos_all dep [] name_) in
and+ targets = Arg.(value & pos_all dep [] name_)
and+ aliases_rec = Arg.(value & opt_all Dep.alias_rec_arg [] & info [ "alias-rec" ])
and+ aliases = Arg.(value & opt_all Dep.alias_arg [] & info [ "alias" ]) in
let targets = List.concat [ targets; aliases; aliases_rec ] in
let targets =
match targets with
| [] -> [ Common.Builder.default_target builder ]
Expand Down
2 changes: 2 additions & 0 deletions doc/changes/12043.md
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
- Add `--alias` and `--alias-rec` flags as an alternative to the `@` and `@@`
syntax in the command line (#12043, fixes #5775, @rgrinberg)
33 changes: 33 additions & 0 deletions test/blackbox-tests/test-cases/alias-arg.t
Original file line number Diff line number Diff line change
@@ -0,0 +1,33 @@
Demonstrate the --alias argument to build aliases in the command
line without the @ syntax

$ cat >dune-project <<EOF
> (lang dune 3.19)
> EOF

$ cat >dune <<EOF
> (rule
> (alias foo)
> (action (echo "root: foo\n")))
> (rule
> (alias bar)
> (action (echo "root: bar\n")))
> EOF

$ mkdir x

$ cat >x/dune <<EOF
> (rule
> (alias bar)
> (action (echo "x: bar\n")))
> EOF

$ dune build --alias foo --alias x/bar
root: foo
x: bar

$ dune clean

$ dune build --alias-rec bar
root: bar
x: bar
Loading