diff --git a/CHANGES.md b/CHANGES.md index 495821bb1af..ed28944e277 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -38,6 +38,10 @@ - Fix compilation of Dune under esy on Windows (#6109, fixes #6098, @nojb) +- `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) + 3.4.1 (26-07-2022) ------------------ diff --git a/bin/exec.ml b/bin/exec.ml index 2ffb5f1491a..ce5f836898f 100644 --- a/bin/exec.ml +++ b/bin/exec.ml @@ -32,6 +32,35 @@ let man = let info = Term.info "exec" ~doc ~man +type program_name = + | String of string + | Sw of Dune_lang.String_with_vars.t + +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 + | _ -> String s + +type cli_item = + | Program of program_name + | Argument of string + +(** Each item in the CLI is either interpreted as a program, or passed as a + plain argument. + + The item in first position is always interpreted as a program, either in + pform syntax or in string syntax. The other items are only interpreted as + programs if they are in pform syntax. *) +let build_cli_items prog args = + let prog = Program (parse_program_name prog) in + let args = + List.map args ~f:(fun s -> + match parse_program_name s with + | Sw _ as n -> Program n + | String s -> Argument s) + in + prog :: args + let term = let+ common = Common.term and+ context = @@ -87,48 +116,75 @@ let term = in User_error.raise ~hints [ Pp.textf "Program %S not found!" prog ] in - let* prog = - let open Memo.O in + let cli_items = build_cli_items prog args in + let+ argv = Build_system.run_exn (fun () -> - match Filename.analyze_program_name prog with - | In_path -> ( - Super_context.resolve_program sctx ~dir ~loc:None prog - >>= function - | Error (_ : Action.Prog.Not_found.t) -> not_found () - | Ok prog -> build_prog prog) - | Relative_to_current_dir -> ( - let path = - Path.relative_to_source_in_build_or_external ~dir prog - in - (Build_system.file_exists path >>= function - | true -> Memo.return (Some path) - | false -> ( - if not (Filename.check_suffix prog ".exe") then - Memo.return None - else - let path = Path.extend_basename path ~suffix:".exe" in - Build_system.file_exists path >>= function - | true -> Memo.return (Some path) - | false -> Memo.return None)) - >>= function - | Some path -> build_prog path - | None -> not_found ()) - | Absolute -> ( - match - let prog = Path.of_string prog in - if Path.exists prog then Some prog - else if not Sys.win32 then None - else - let prog = Path.extend_basename prog ~suffix:Bin.exe in - Option.some_if (Path.exists prog) prog - with - | Some prog -> Memo.return prog - | None -> not_found ())) + Memo.List.map cli_items ~f:(function + | Argument s -> Memo.return s + | Program n -> + let open Memo.O in + let* prog = + match n with + | Sw sw -> + let+ path, _ = + Action_builder.run + (Target.expand_path_from_root (Common.root common) + ~setup 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 + in + let+ path = + match Filename.analyze_program_name prog with + | In_path -> ( + Super_context.resolve_program sctx ~dir ~loc:None prog + >>= function + | Error (_ : Action.Prog.Not_found.t) -> not_found () + | Ok prog -> build_prog prog) + | Relative_to_current_dir -> ( + let path = + Path.relative_to_source_in_build_or_external ~dir prog + in + (Build_system.file_exists path >>= function + | true -> Memo.return (Some path) + | false -> ( + if not (Filename.check_suffix prog ".exe") then + Memo.return None + else + let path = + Path.extend_basename path ~suffix:".exe" + in + Build_system.file_exists path >>= function + | true -> Memo.return (Some path) + | false -> Memo.return None)) + >>= function + | Some path -> build_prog path + | None -> not_found ()) + | Absolute -> ( + match + let prog = Path.of_string prog in + if Path.exists prog then Some prog + else if not Sys.win32 then None + else + let prog = + Path.extend_basename prog ~suffix:Bin.exe + in + Option.some_if (Path.exists prog) prog + with + | Some prog -> Memo.return prog + | None -> not_found ()) + in + Path.to_string path)) in - let prog = Path.to_string prog in - let argv = prog :: args in + let prog = List.hd argv in let env = Super_context.context_env sctx in - Fiber.return (prog, argv, env)) + (prog, argv, env)) in restore_cwd_and_execve common prog argv env diff --git a/bin/target.ml b/bin/target.ml index ad57dbe3847..c5240d2fd67 100644 --- a/bin/target.ml +++ b/bin/target.ml @@ -102,7 +102,7 @@ let resolve_path path ~(setup : Dune_rules.Main.build_system) = | Some res -> Memo.return (Ok res) | None -> can't_build path) -let expand_path (root : Workspace_root.t) +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) @@ -118,7 +118,11 @@ let expand_path (root : Workspace_root.t) 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) = match Dune_lang.String_with_vars.text_only sv with diff --git a/bin/target.mli b/bin/target.mli index bec2c8cc0d1..562a16765d3 100644 --- a/bin/target.mli +++ b/bin/target.mli @@ -6,3 +6,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 + -> setup:Dune_rules.Main.build_system + -> Dune_rules.Context.t + -> Dune_lang.String_with_vars.t + -> string Dune_engine.Action_builder.t 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 00000000000..fa0e1eb7d3d --- /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