From e0a5a7f48c551211a5920046020f1ba5886c0824 Mon Sep 17 00:00:00 2001 From: Stephen Sherratt Date: Tue, 8 Oct 2024 05:10:38 +1100 Subject: [PATCH] Fix exec -w for relative paths with --root argument (#10982) * Fix exec -w for relative paths with --root argument Passing --root to `dune build` and `dune exec` causes relative paths to files to be resolved relative to the workspace root rather than the working directory (in addition to its main function of explicitly setting the workspace root directory). This was not implemented correctly for exec watch mode, where relative paths would be resolved relative to the working directory instead. There was already a test for this which was failing, however the test is disabled in CI as it is known to be flaky. Signed-off-by: Stephen Sherratt Signed-off-by: Rudi Grinberg --- bin/coq/coqtop.ml | 2 +- bin/exec.ml | 27 ++++++++++--------- bin/import.ml | 14 +++++----- bin/ocaml/utop.ml | 2 +- bin/tools/ocamllsp.ml | 2 +- doc/changes/10982.md | 2 ++ .../exec-watch-multi-levels.t/run.t | 4 ++- 7 files changed, 29 insertions(+), 24 deletions(-) create mode 100644 doc/changes/10982.md diff --git a/bin/coq/coqtop.ml b/bin/coq/coqtop.ml index 66056253140..41ab4df2efc 100644 --- a/bin/coq/coqtop.ml +++ b/bin/coq/coqtop.ml @@ -153,7 +153,7 @@ let term = in Fiber.return (coqtop, argv, env) in - restore_cwd_and_execve common coqtop argv env + restore_cwd_and_execve (Common.root common) coqtop argv env ;; let command = Cmd.v info term diff --git a/bin/exec.ml b/bin/exec.ml index b4a0ec6e9ef..d20d965470c 100644 --- a/bin/exec.ml +++ b/bin/exec.ml @@ -77,22 +77,25 @@ module Command_to_exec = struct (* Helper function to spawn a new process running a command in an environment, returning the new process' pid *) - let spawn_process path ~args ~env = + let spawn_process ~root path ~args ~env = let pid = - let path = Path.to_string path in + let prog = string_path_relative_to_specified_root root (Path.to_string path) in let env = Env.to_unix env |> Spawn.Env.of_list in - let argv = path :: args in + let argv = prog :: args in let cwd = Spawn.Working_dir.Path Fpath.initial_cwd in - Spawn.spawn ~prog:path ~env ~cwd ~argv () + Spawn.spawn ~prog ~env ~cwd ~argv () in Pid.of_int pid ;; (* Run the command, first (re)building the program which the command is invoking *) - let build_and_run_in_child_process { get_path_and_build_if_necessary; prog; args; env } = + let build_and_run_in_child_process + ~root + { get_path_and_build_if_necessary; prog; args; env } + = get_path_and_build_if_necessary prog - |> Fiber.map ~f:(Result.map ~f:(spawn_process ~args ~env)) + |> Fiber.map ~f:(Result.map ~f:(spawn_process ~root ~args ~env)) ;; end @@ -139,18 +142,18 @@ module Watch = struct (* Kills the currently running process, then runs the given command after (re)building the program which it will invoke *) - let run state ~command_to_exec = + let run ~root state ~command_to_exec = let open Fiber.O in let* () = Fiber.return () in let* () = kill_currently_running_process state in let* command_to_exec = command_to_exec () in - Command_to_exec.build_and_run_in_child_process command_to_exec + Command_to_exec.build_and_run_in_child_process ~root command_to_exec >>| Result.map ~f:(fun pid -> state.currently_running_pid := Some pid) ;; - let loop ~command_to_exec = + let loop ~root ~command_to_exec = let state = init_state () in - Scheduler.Run.poll (run state ~command_to_exec) + Scheduler.Run.poll (run ~root state ~command_to_exec) ;; end @@ -294,7 +297,7 @@ module Exec_context = struct in let prog = Path.to_string path in let argv = prog :: args in - restore_cwd_and_execve common prog argv env + restore_cwd_and_execve (Common.root common) prog argv env ;; let run_eager_watch t common config = @@ -322,7 +325,7 @@ module Exec_context = struct ; env } in - Watch.loop ~command_to_exec + Watch.loop ~root:(Common.root common) ~command_to_exec ;; end diff --git a/bin/import.ml b/bin/import.ml index 86679de7434..100a9e112da 100644 --- a/bin/import.ml +++ b/bin/import.ml @@ -237,14 +237,12 @@ module Scheduler = struct ;; end -let restore_cwd_and_execve (common : Common.t) prog argv env = - let prog = - if Filename.is_relative prog - then ( - let root = Common.root common in - Filename.concat root.dir prog) - else prog - in +let string_path_relative_to_specified_root (root : Workspace_root.t) path = + if Filename.is_relative path then Filename.concat root.dir path else path +;; + +let restore_cwd_and_execve root prog argv env = + let prog = string_path_relative_to_specified_root root prog in Proc.restore_cwd_and_execve prog argv ~env ;; diff --git a/bin/ocaml/utop.ml b/bin/ocaml/utop.ml index 35196beef48..17f09222aab 100644 --- a/bin/ocaml/utop.ml +++ b/bin/ocaml/utop.ml @@ -56,7 +56,7 @@ let term = ~f:(fun dir env -> Env_path.cons ~var:Ocaml.Env.caml_ld_library_path env ~dir) ~init:env in - restore_cwd_and_execve common utop_path (utop_path :: args) env + restore_cwd_and_execve (Common.root common) utop_path (utop_path :: args) env ;; let command = Cmd.v info term diff --git a/bin/tools/ocamllsp.ml b/bin/tools/ocamllsp.ml index 8f3ca407d43..eeb66f31128 100644 --- a/bin/tools/ocamllsp.ml +++ b/bin/tools/ocamllsp.ml @@ -51,7 +51,7 @@ let term = let open Fiber.O in let* () = Lock_dev_tool.lock_ocamllsp () |> Memo.run in let+ () = build_ocamllsp common in - run_ocamllsp common ~args) + run_ocamllsp (Common.root common) ~args) ;; let info = diff --git a/doc/changes/10982.md b/doc/changes/10982.md new file mode 100644 index 00000000000..559f5b73257 --- /dev/null +++ b/doc/changes/10982.md @@ -0,0 +1,2 @@ +- Fix exec -w for relative paths with --root argument (#10982, + @gridbugs) diff --git a/test/blackbox-tests/test-cases/exec-watch/exec-watch-multi-levels.t/run.t b/test/blackbox-tests/test-cases/exec-watch/exec-watch-multi-levels.t/run.t index b3617bc1d1f..b51a63d9913 100644 --- a/test/blackbox-tests/test-cases/exec-watch/exec-watch-multi-levels.t/run.t +++ b/test/blackbox-tests/test-cases/exec-watch/exec-watch-multi-levels.t/run.t @@ -22,8 +22,10 @@ Perform the same test above but first enter the "bin" directory. Success, waiting for filesystem changes... foo Leaving directory '..' + $ PID=$! $ cd .. - $ wait + $ ../wait-for-file.sh $DONE_FLAG + $ kill $PID Test that the behaviour is the same when not running with "--watch" $ cd bin && dune exec --root .. ./bin/main.exe