From e4962e22aade8171128dd4b491af8edc1fd7563c Mon Sep 17 00:00:00 2001 From: Etienne Millon Date: Wed, 3 Aug 2022 17:32:20 +0200 Subject: [PATCH] dune exec: support pform syntax This supports things like `dune exec time %{bin:e}`. The syntax is consistent with what support in `dune build` and backwards compatible in cases where no arguments start with `%`. The resolution mechanism is slightly different for the program and the rest of the arguments: - the program is always considered a possible dependency, either in pform syntax (`%{bin:e}` or in string syntax (`./path/to/e`, `_build/default/path/to/e`). - arguments are only interpreted as dependencies if they are in pform syntax. Closes #2691 Signed-off-by: Etienne Millon Signed-off-by: Marek Kubica --- bin/exec.ml | 97 ++++++++++++++++++++--- bin/target.ml | 26 +++++- bin/target.mli | 7 ++ doc/changes/6035.md | 3 + test/blackbox-tests/test-cases/exec-bin.t | 76 ++++++++++++++++++ 5 files changed, 198 insertions(+), 11 deletions(-) create mode 100644 doc/changes/6035.md create mode 100644 test/blackbox-tests/test-cases/exec-bin.t diff --git a/bin/exec.ml b/bin/exec.ml index 284fbe78effa..b369a2280f32 100644 --- a/bin/exec.ml +++ b/bin/exec.ml @@ -134,6 +134,63 @@ let build_prog ~no_rebuild ~prog p = p ;; +module Cli_item = struct + type program_name = + | String of string + | Sw of Dune_lang.String_with_vars.t * string + + type t = + | Program of program_name + | Argument of string + + let parse_program_name s = + match Arg.conv_parser Arg.dep s with + | Ok (File sw) when Dune_lang.String_with_vars.has_pforms sw -> Sw (sw, s) + | _ -> String s + ;; + + let parse s = + match parse_program_name s with + | Sw _ as n -> Program n + | String s -> Argument s + ;; + + let pp_program_name pps = function + | String s -> Format.fprintf pps "%s" s + | Sw (_, s) -> Format.fprintf pps "%s" s + ;; + + let pp pps = function + | Program prog -> pp_program_name pps prog + | Argument s -> Format.fprintf pps "%s" s + ;; + + let expand_program_name root sctx prog = + let open Memo.O in + let context = Dune_rules.Super_context.context sctx in + match prog with + | Sw (sw, _) -> + let+ path, _ = + Action_builder.run (Target.expand_path_from_root' root sctx context sw) Eager + in + Path.to_string + (Path.build + (Path.Build.relative + (Dune_engine.Context_name.build_dir (Context.name context)) + path)) + | String s -> Memo.return s + ;; + + let expand root sctx item = + match item with + | Program p -> expand_program_name root sctx p + | Argument s -> Memo.return s + ;; + + let program_name_conv = Arg.conv ((fun s -> Ok (parse_program_name s)), pp_program_name) + let conv = Arg.conv ((fun s -> Ok (parse s)), pp) +end + let not_found ~dir ~prog = let open Memo.O in let+ hints = @@ -153,8 +210,9 @@ let not_found ~dir ~prog = User_error.raise ~hints [ Pp.textf "Program %S not found!" prog ] ;; -let get_path_and_build_if_necessary sctx ~no_rebuild ~dir ~prog = +let get_path_and_build_if_necessary root sctx ~no_rebuild ~dir ~prog = let open Memo.O in + let* prog = Cli_item.expand_program_name root sctx prog in match Filename.analyze_program_name prog with | In_path -> Super_context.resolve_program sctx ~dir ~loc:None prog @@ -197,9 +255,10 @@ module Exec_context = struct type t = { common : Common.t ; config : Dune_config.t - ; args : string list + ; args : Cli_item.t list ; env : Env.t Fiber.t ; get_path_and_build_if_necessary : (unit -> Path.t Memo.t) Fiber.t + ; expand_cli_item : (Cli_item.t -> string Memo.t) Fiber.t } let init ~common ~context ~no_rebuild ~prog ~args = @@ -222,29 +281,47 @@ module Exec_context = struct let open Fiber.O in let* sctx = sctx in let+ dir = dir in - fun () -> get_path_and_build_if_necessary sctx ~no_rebuild ~dir ~prog + fun () -> + get_path_and_build_if_necessary (Common.root common) sctx ~no_rebuild ~dir ~prog in - { common; config; env; args; get_path_and_build_if_necessary } + let expand_cli_item = + let open Fiber.O in + let+ sctx = sctx in + fun arg -> Cli_item.expand (Common.root common) sctx arg + in + { common; config; env; args; get_path_and_build_if_necessary; expand_cli_item } ;; - let run_once { common; config; env; args; get_path_and_build_if_necessary; _ } = + let run_once + { common; config; env; args; get_path_and_build_if_necessary; expand_cli_item } + = Scheduler.go ~common ~config @@ fun () -> let open Fiber.O in let* get_path_and_build_if_necessary = get_path_and_build_if_necessary in let* env = env in - let+ path = Build_system.run_exn get_path_and_build_if_necessary in + let* expand_cli_item = expand_cli_item in + let* path, args = + Build_system.run_exn (fun () -> + let path = get_path_and_build_if_necessary () in + let args = Memo.parallel_map ~f:expand_cli_item args in + Memo.both path args) + in let prog = Path.to_string path in let argv = prog :: args in restore_cwd_and_execve common prog argv env ;; - let run_eager_watch { common; config; env; args; get_path_and_build_if_necessary; _ } = + let run_eager_watch + { common; config; env; args; get_path_and_build_if_necessary; expand_cli_item } + = Scheduler.go_with_rpc_server_and_console_status_reporting ~common ~config @@ fun () -> let open Fiber.O in let* get_path_and_build_if_necessary = get_path_and_build_if_necessary in let* env = env in + let* expand_cli_item = expand_cli_item in + let* args = args |> Memo.parallel_map ~f:expand_cli_item |> Memo.run in let command_to_exec = { Command_to_exec.get_path_and_build_if_necessary = (fun () -> @@ -263,10 +340,12 @@ end let term = let+ common = Common.term and+ context = Common.context_arg ~doc:{|Run the command in this build context.|} - and+ prog = Arg.(required & pos 0 (some string) None (Arg.info [] ~docv:"PROG")) + and+ prog = + Arg.( + required & pos 0 (some Cli_item.program_name_conv) None (Arg.info [] ~docv:"PROG")) and+ no_rebuild = Arg.(value & flag & info [ "no-build" ] ~doc:"don't rebuild target before executing") - and+ args = Arg.(value & pos_right 0 string [] (Arg.info [] ~docv:"ARGS")) in + and+ args = Arg.(value & pos_right 0 Cli_item.conv [] (Arg.info [] ~docv:"ARGS")) in (* TODO we should make sure to finalize the current backend before exiting dune. For watch mode, we should finalize the backend and then restart it in between runs. *) diff --git a/bin/target.ml b/bin/target.ml index ef095e370227..69e7c4f5f23c 100644 --- a/bin/target.ml +++ b/bin/target.ml @@ -165,7 +165,24 @@ let resolve_path path ~(setup : Dune_rules.Main.build_system) | None -> can't_build path) ;; -let expand_path (root : Workspace_root.t) ~(setup : Dune_rules.Main.build_system) ctx sv = +let expand_path_from_root' (root : Workspace_root.t) sctx ctx sv = + let dir = + Path.Build.relative + ctx.Context.build_dir + (String.concat ~sep:Filename.dir_sep root.to_cwd) + in + let* expander = Action_builder.of_memo (Dune_rules.Super_context.expander sctx ~dir) in + let expander = Dune_rules.Dir_contents.add_sources_to_expander sctx expander in + let+ s = Dune_rules.Expander.expand_str expander sv in + root.reach_from_root_prefix ^ s +;; + +let expand_path_from_root + (root : Workspace_root.t) + ~(setup : Dune_rules.Main.build_system) + ctx + sv + = let sctx = Dune_engine.Context_name.Map.find_exn setup.scontexts (Context.name ctx) in let dir = Path.Build.relative @@ -175,7 +192,12 @@ let expand_path (root : Workspace_root.t) ~(setup : Dune_rules.Main.build_system let* expander = Action_builder.of_memo (Dune_rules.Super_context.expander sctx ~dir) in let expander = Dune_rules.Dir_contents.add_sources_to_expander sctx expander in let+ s = Dune_rules.Expander.expand_str expander sv in - Path.relative Path.root (root.reach_from_root_prefix ^ s) + root.reach_from_root_prefix ^ s +;; + +let expand_path root ~setup ctx sv = + let+ s = expand_path_from_root root ~setup ctx sv in + Path.relative Path.root s ;; let resolve_alias root ~recursive sv ~(setup : Dune_rules.Main.build_system) = diff --git a/bin/target.mli b/bin/target.mli index c4a57eb36e98..9c5e86d59ec8 100644 --- a/bin/target.mli +++ b/bin/target.mli @@ -17,3 +17,10 @@ val interpret_targets -> Dune_rules.Main.build_system -> Arg.Dep.t list -> unit Dune_engine.Action_builder.t + +val expand_path_from_root' + : Workspace_root.t + -> Dune_rules.Super_context.t + -> Dune_rules.Context.t + -> Dune_lang.String_with_vars.t + -> string Dune_engine.Action_builder.t diff --git a/doc/changes/6035.md b/doc/changes/6035.md new file mode 100644 index 000000000000..8f412364d334 --- /dev/null +++ b/doc/changes/6035.md @@ -0,0 +1,3 @@ +- `dune exec`: support syntax like `%{bin:program}`. This can appear anywhere + in the command line, so things like `dune exec time %{bin:program}` now work. + (#6035, fixes #2691, @emillon) diff --git a/test/blackbox-tests/test-cases/exec-bin.t b/test/blackbox-tests/test-cases/exec-bin.t new file mode 100644 index 000000000000..fa0e1eb7d3de --- /dev/null +++ b/test/blackbox-tests/test-cases/exec-bin.t @@ -0,0 +1,76 @@ + $ cat > dune-project << EOF + > (lang dune 1.1) + > + > (package + > (name e)) + > EOF + $ cat > dune << EOF + > (executable + > (public_name e)) + > EOF + +The executable just displays "Hello" and its arguments. + + $ cat > e.ml << EOF + > let () = + > print_endline "Hello"; + > Array.iteri (fun i s -> + > Printf.printf "argv[%d] = %s\n" i s + > ) Sys.argv + > EOF + +By default, e is executed with the program name and arguments in argv. + + $ dune exec ./e.exe a b c + Hello + argv[0] = _build/default/e.exe + argv[1] = a + argv[2] = b + argv[3] = c + +The special form %{bin:public_name} is supported. + + $ dune exec %{bin:e} a b c + Hello + argv[0] = _build/install/default/bin/e + argv[1] = a + argv[2] = b + argv[3] = c + +This wrapper parses its own arguments and executes the rest. + + $ cat > wrap.sh << 'EOF' + > #!/bin/bash + > while getopts "xy" o; do + > echo "Got option: $o" + > done + > shift $((OPTIND-1)) + > echo Before + > "$@" + > echo After + > EOF + $ chmod +x wrap.sh + +It is possible to put the %{bin:...} pform in arguments rather than first. + + $ dune exec -- ./wrap.sh -x -y %{bin:e} a b c + Got option: x + Got option: y + Before + Hello + argv[0] = _build/install/default/bin/e + argv[1] = a + argv[2] = b + argv[3] = c + After + +The first item is still looked up in PATH. + + $ dune exec ls %{bin:e} + _build/install/default/bin/e + +Pforms can appear several times. + + $ dune exec ls %{bin:e} %{bin:e} + _build/install/default/bin/e + _build/install/default/bin/e