From c55634cb6fff97e8242ea7e229809810d3d56bfa Mon Sep 17 00:00:00 2001 From: Stephen Sherratt Date: Fri, 13 Jun 2025 16:41:52 +1000 Subject: [PATCH 1/2] Looking up paths to executables with dune describe location The "dune exec" command has three different ways of resolving the names of executables to paths to executables: - public executables defined in the current project - executables in the "bin" directories of dependencies - executables in directories listed in $PATH This can lead to unexpected shadowing, especially in the case of executables from dependecies, as users may not be aware that one of the packages in their project's dependency cone defines an executable with the same name of an executable that's also insalled system-wide. Short of fixing the problem for now, this change introduces a tool for helping investigate specifically which executable will be run by "dune exec". This adds a command "dune describe location" which prints the path to the executable. Signed-off-by: Stephen Sherratt --- bin/describe/describe.ml | 1 + bin/describe/describe_location.ml | 43 ++++++++++++ bin/describe/describe_location.mli | 3 + bin/exec.ml | 63 ++++++++++-------- bin/exec.mli | 21 ++++++ doc/changes/11905.md | 2 + .../test-cases/describe_location.t | 65 +++++++++++++++++++ 7 files changed, 172 insertions(+), 26 deletions(-) create mode 100644 bin/describe/describe_location.ml create mode 100644 bin/describe/describe_location.mli create mode 100644 doc/changes/11905.md create mode 100644 test/blackbox-tests/test-cases/describe_location.t diff --git a/bin/describe/describe.ml b/bin/describe/describe.ml index 7eb5b601e67..6bfa4914ece 100644 --- a/bin/describe/describe.ml +++ b/bin/describe/describe.ml @@ -21,6 +21,7 @@ let subcommands = ; Describe_pkg.command ; Describe_contexts.command ; Describe_depexts.command + ; Describe_location.command ] ;; diff --git a/bin/describe/describe_location.ml b/bin/describe/describe_location.ml new file mode 100644 index 00000000000..0fe891f54b9 --- /dev/null +++ b/bin/describe/describe_location.ml @@ -0,0 +1,43 @@ +open! Import + +let doc = + "Print the path to the executable using the same resolution logic as [dune exec]." +;; + +let man = + [ `S "DESCRIPTION" + ; `P + {|$(b,dune describe location NAME) prints the path to the executable NAME using the same logic as: + |} + ; `Pre "$ dune exec NAME" + ; `P + "Dune will first try to resolve the executable within the public executables in \ + the current project, then inside the \"bin\" directory of each package among the \ + project's dependencies (when using dune package management), and finally within \ + the directories listed in the $PATH environment variable." + ] +;; + +let info = Cmd.info "location" ~doc ~man + +let term : unit Term.t = + let+ builder = Common.Builder.term + and+ context = Common.context_arg ~doc:{|Run the command in this build context.|} + and+ prog = + Arg.(required & pos 0 (some Exec.Cmd_arg.conv) None (Arg.info [] ~docv:"PROG")) + in + let common, config = Common.init builder in + Scheduler.go_with_rpc_server ~common ~config + @@ fun () -> + let open Fiber.O in + let* setup = Import.Main.setup () in + build_exn + @@ fun () -> + let open Memo.O in + let* sctx = setup >>| Import.Main.find_scontext_exn ~name:context in + let* prog = Exec.Cmd_arg.expand ~root:(Common.root common) ~sctx prog in + let+ path = Exec.get_path common context ~prog >>| Path.to_string in + Dune_console.printf "%s" path +;; + +let command = Cmd.v info term diff --git a/bin/describe/describe_location.mli b/bin/describe/describe_location.mli new file mode 100644 index 00000000000..5505206a171 --- /dev/null +++ b/bin/describe/describe_location.mli @@ -0,0 +1,3 @@ +open! Import + +val command : unit Cmd.t diff --git a/bin/exec.ml b/bin/exec.ml index 2604130c043..fdfa5f8ec89 100644 --- a/bin/exec.ml +++ b/bin/exec.ml @@ -115,19 +115,28 @@ let build_prog ~no_rebuild ~prog p = p ;; -let get_path_and_build_if_necessary sctx ~no_rebuild ~dir ~prog = +let dir_of_context common context = let open Memo.O in + let+ sctx = Super_context.find_exn context in + let context = Dune_rules.Super_context.context sctx in + Path.Build.relative (Context.build_dir context) (Common.prefix_target common "") +;; + +let get_path common context ~prog = + let open Memo.O in + let* sctx = Super_context.find_exn context + and* dir = dir_of_context common context in match Filename.analyze_program_name prog with | In_path -> Super_context.resolve_program_memo sctx ~dir ~loc:None prog >>= (function | Error (_ : Action.Prog.Not_found.t) -> not_found_with_suggestions ~dir ~prog - | Ok p -> build_prog ~no_rebuild ~prog p) + | Ok p -> Memo.return p) | Relative_to_current_dir -> let path = Path.relative_to_source_in_build_or_external ~dir prog in Build_system.file_exists path >>= (function - | true -> build_prog ~no_rebuild ~prog path + | true -> Memo.return path | false -> not_found_with_suggestions ~dir ~prog) | Absolute -> (match @@ -144,19 +153,24 @@ let get_path_and_build_if_necessary sctx ~no_rebuild ~dir ~prog = | None -> not_found_with_suggestions ~dir ~prog) ;; -let step ~setup ~prog ~args ~common ~no_rebuild ~context ~on_exit () = +let get_path_and_build_if_necessary common context ~no_rebuild ~prog = let open Memo.O in - let* sctx = setup >>| Import.Main.find_scontext_exn ~name:context in - let* env = Super_context.context_env sctx in - let expand = Cmd_arg.expand ~root:(Common.root common) ~sctx in + let* path = get_path common context ~prog in + match Filename.analyze_program_name prog with + | In_path | Relative_to_current_dir -> build_prog ~no_rebuild ~prog path + | Absolute -> Memo.return path +;; + +let step ~prog ~args ~common ~no_rebuild ~context ~on_exit () = + let open Memo.O in + let* sctx = Super_context.find_exn context in let* path = - let dir = - let context = Dune_rules.Super_context.context sctx in - Path.Build.relative (Context.build_dir context) (Common.prefix_target common "") - in - let* prog = expand prog in - get_path_and_build_if_necessary sctx ~no_rebuild ~dir ~prog - and* args = Memo.parallel_map args ~f:expand in + let* prog = Cmd_arg.expand ~root:(Common.root common) ~sctx prog in + get_path_and_build_if_necessary common context ~no_rebuild ~prog + and* args = + Memo.parallel_map args ~f:(Cmd_arg.expand ~root:(Common.root common) ~sctx) + in + let* env = Super_context.context_env sctx in Memo.of_non_reproducible_fiber @@ Dune_engine.Process.run_inherit_std_in_out ~dir:(Path.of_string Fpath.initial_cwd) @@ -252,12 +266,11 @@ let exec_building_directly ~common ~config ~context ~prog ~args ~no_rebuild = Scheduler.go_with_rpc_server_and_console_status_reporting ~common ~config @@ fun () -> let open Fiber.O in - let* setup = Import.Main.setup () in let on_exit = Console.printf "Program exited with code [%d]" in Scheduler.Run.poll @@ let* () = Fiber.return @@ Scheduler.maybe_clear_screen ~details_hum:[] config in - build @@ step ~setup ~prog ~args ~common ~no_rebuild ~context ~on_exit + build @@ step ~prog ~args ~common ~no_rebuild ~context ~on_exit | No -> Scheduler.go_with_rpc_server ~common ~config @@ fun () -> @@ -266,16 +279,14 @@ let exec_building_directly ~common ~config ~context ~prog ~args ~no_rebuild = build_exn (fun () -> let open Memo.O in let* sctx = setup >>| Import.Main.find_scontext_exn ~name:context in - let* env = Super_context.context_env sctx in - let expand = Cmd_arg.expand ~root:(Common.root common) ~sctx in - let* prog = - let dir = - let context = Dune_rules.Super_context.context sctx in - Path.Build.relative (Context.build_dir context) (Common.prefix_target common "") - in - let* prog = expand prog in - get_path_and_build_if_necessary sctx ~no_rebuild ~dir ~prog >>| Path.to_string - and* args = Memo.parallel_map ~f:expand args in + let* env = Super_context.context_env sctx + and* prog = + let* prog = Cmd_arg.expand ~root:(Common.root common) ~sctx prog in + get_path_and_build_if_necessary common context ~no_rebuild ~prog + >>| Path.to_string + and* args = + Memo.parallel_map ~f:(Cmd_arg.expand ~root:(Common.root common) ~sctx) args + in restore_cwd_and_execve (Common.root common) prog args env) ;; diff --git a/bin/exec.mli b/bin/exec.mli index 8c78dc310b9..09d27ce97f2 100644 --- a/bin/exec.mli +++ b/bin/exec.mli @@ -1,3 +1,24 @@ open Import +module Cmd_arg : sig + type t + + val conv : t Arg.conv + val expand : t -> root:Workspace_root.t -> sctx:Super_context.t -> string Memo.t +end + +(** Returns the path to the executable [prog] as it will be resolved by dune: + - if [prog] is the name of an executable defined by the project then the path + to that executable will be returned, and evaluating the returned memo will + build the executable if necessary. + - otherwise if [prog] is the name of an executable in the "bin" directory of + a package in this project's dependency cone then the path to that executable + file will be returned. Note that for this reason all dependencies of the + project will be built when the returned memo is evaluated (unless the first + case is hit). + - otherwise if [prog] is the name of an executable in one of the directories + listed in the PATH environment variable, the path to that executable will be + returned. *) +val get_path : Common.t -> Context_name.t -> prog:string -> Path.t Memo.t + val command : unit Cmd.t diff --git a/doc/changes/11905.md b/doc/changes/11905.md new file mode 100644 index 00000000000..47161a61dad --- /dev/null +++ b/doc/changes/11905.md @@ -0,0 +1,2 @@ +- Add `dune describe location` for printing the path to the executable that + would be run (#11905, @gridbugs) diff --git a/test/blackbox-tests/test-cases/describe_location.t b/test/blackbox-tests/test-cases/describe_location.t new file mode 100644 index 00000000000..ab6fbad28f5 --- /dev/null +++ b/test/blackbox-tests/test-cases/describe_location.t @@ -0,0 +1,65 @@ +Exercise the various ways of resolving executable names with `dune exec`. + + $ cat > dune-project << EOF + > (lang dune 3.20) + > + > (package + > (name foo)) + > EOF + + $ cat > dune << EOF + > (executable + > (public_name foo)) + > EOF + + $ cat > foo.ml << EOF + > let () = print_endline "hello foo" + > EOF + +An executable that would be installed by the current package: + $ dune describe location foo + _build/install/default/bin/foo + +An executable from the current project: + $ dune describe location ./foo.exe + _build/default/foo.exe + +Test that executables from dependencies are located correctly: + $ mkdir dune.lock + $ cat > dune.lock/lock.dune << EOF + > (lang package 0.1) + > EOF + $ cat > dune.lock/bar.pkg << EOF + > (version 0.1) + > (install + > (progn + > (write-file %{bin}/bar "#!/bin/sh\necho hello bar") + > (run chmod a+x %{bin}/bar))) + > EOF + + $ cat > dune-project << EOF + > (lang dune 3.20) + > + > (package + > (name foo) + > (depends bar)) + > EOF + + $ dune describe location bar + _build/_private/default/.pkg/bar/target/bin/bar + +Test that executables from PATH are located correctly: + $ mkdir bin + $ cat > bin/baz << EOF + > #!/bin/sh + > echo hello baz + > EOF + + $ chmod a+x bin/baz + $ export PATH=$PWD/bin:$PATH + + $ dune describe location baz + $TESTCASE_ROOT/bin/baz + + $ dune exec echo '%{bin:foo}' + _build/install/default/bin/foo From 7cd05541b0379f391fde1c8d1d10fb302de9789e Mon Sep 17 00:00:00 2001 From: Marek Kubica Date: Wed, 9 Jul 2025 11:30:50 +0200 Subject: [PATCH 2/2] Don't recalculate `sctx` when we already have it Signed-off-by: Marek Kubica --- bin/describe/describe_location.ml | 2 +- bin/exec.ml | 18 +++++++----------- bin/exec.mli | 2 +- 3 files changed, 9 insertions(+), 13 deletions(-) diff --git a/bin/describe/describe_location.ml b/bin/describe/describe_location.ml index 0fe891f54b9..3bc69c39e79 100644 --- a/bin/describe/describe_location.ml +++ b/bin/describe/describe_location.ml @@ -36,7 +36,7 @@ let term : unit Term.t = let open Memo.O in let* sctx = setup >>| Import.Main.find_scontext_exn ~name:context in let* prog = Exec.Cmd_arg.expand ~root:(Common.root common) ~sctx prog in - let+ path = Exec.get_path common context ~prog >>| Path.to_string in + let+ path = Exec.get_path common sctx ~prog >>| Path.to_string in Dune_console.printf "%s" path ;; diff --git a/bin/exec.ml b/bin/exec.ml index fdfa5f8ec89..d08c57c74f9 100644 --- a/bin/exec.ml +++ b/bin/exec.ml @@ -115,17 +115,14 @@ let build_prog ~no_rebuild ~prog p = p ;; -let dir_of_context common context = - let open Memo.O in - let+ sctx = Super_context.find_exn context in +let dir_of_context common sctx = let context = Dune_rules.Super_context.context sctx in Path.Build.relative (Context.build_dir context) (Common.prefix_target common "") ;; -let get_path common context ~prog = +let get_path common sctx ~prog = let open Memo.O in - let* sctx = Super_context.find_exn context - and* dir = dir_of_context common context in + let dir = dir_of_context common sctx in match Filename.analyze_program_name prog with | In_path -> Super_context.resolve_program_memo sctx ~dir ~loc:None prog @@ -153,9 +150,9 @@ let get_path common context ~prog = | None -> not_found_with_suggestions ~dir ~prog) ;; -let get_path_and_build_if_necessary common context ~no_rebuild ~prog = +let get_path_and_build_if_necessary common sctx ~no_rebuild ~prog = let open Memo.O in - let* path = get_path common context ~prog in + let* path = get_path common sctx ~prog in match Filename.analyze_program_name prog with | In_path | Relative_to_current_dir -> build_prog ~no_rebuild ~prog path | Absolute -> Memo.return path @@ -166,7 +163,7 @@ let step ~prog ~args ~common ~no_rebuild ~context ~on_exit () = let* sctx = Super_context.find_exn context in let* path = let* prog = Cmd_arg.expand ~root:(Common.root common) ~sctx prog in - get_path_and_build_if_necessary common context ~no_rebuild ~prog + get_path_and_build_if_necessary common sctx ~no_rebuild ~prog and* args = Memo.parallel_map args ~f:(Cmd_arg.expand ~root:(Common.root common) ~sctx) in @@ -282,8 +279,7 @@ let exec_building_directly ~common ~config ~context ~prog ~args ~no_rebuild = let* env = Super_context.context_env sctx and* prog = let* prog = Cmd_arg.expand ~root:(Common.root common) ~sctx prog in - get_path_and_build_if_necessary common context ~no_rebuild ~prog - >>| Path.to_string + get_path_and_build_if_necessary common sctx ~no_rebuild ~prog >>| Path.to_string and* args = Memo.parallel_map ~f:(Cmd_arg.expand ~root:(Common.root common) ~sctx) args in diff --git a/bin/exec.mli b/bin/exec.mli index 09d27ce97f2..00ecf4c5c80 100644 --- a/bin/exec.mli +++ b/bin/exec.mli @@ -19,6 +19,6 @@ end - otherwise if [prog] is the name of an executable in one of the directories listed in the PATH environment variable, the path to that executable will be returned. *) -val get_path : Common.t -> Context_name.t -> prog:string -> Path.t Memo.t +val get_path : Common.t -> Super_context.t -> prog:string -> Path.t Memo.t val command : unit Cmd.t