diff --git a/bin/exec.ml b/bin/exec.ml index b4a0ec6e9ef0..2118a1a2b987 100644 --- a/bin/exec.ml +++ b/bin/exec.ml @@ -77,22 +77,26 @@ 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 (common : Common.t) path ~args ~env = let pid = - let path = Path.to_string path in + let prog = string_path_relative_to_specified_root common (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 + common + { 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:(fun exe_path -> spawn_process common ~args ~env exe_path)) ;; end @@ -139,18 +143,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 common 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 common command_to_exec >>| Result.map ~f:(fun pid -> state.currently_running_pid := Some pid) ;; - let loop ~command_to_exec = + let loop common ~command_to_exec = let state = init_state () in - Scheduler.Run.poll (run state ~command_to_exec) + Scheduler.Run.poll (run common state ~command_to_exec) ;; end @@ -322,7 +326,7 @@ module Exec_context = struct ; env } in - Watch.loop ~command_to_exec + Watch.loop common ~command_to_exec ;; end diff --git a/bin/import.ml b/bin/import.ml index 86679de74341..f795d2ea540a 100644 --- a/bin/import.ml +++ b/bin/import.ml @@ -237,14 +237,16 @@ 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 (common : Common.t) path = + if Filename.is_relative path + then ( + let root = Common.root common in + Filename.concat root.dir path) + else path +;; + +let restore_cwd_and_execve common prog argv env = + let prog = string_path_relative_to_specified_root common prog in Proc.restore_cwd_and_execve prog argv ~env ;; 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 b3617bc1d1fd..b51a63d9913e 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