test: reproduce dune exec -w crash with pkg management (#10960)

* test: reproduce `dune exec -w` crash with pkg management Signed-off-by: Antonio Nuno Monteiro <[email protected]> * fix: delay evaluating `env` until `get_path_and_build_if_necessary` Signed-off-by: Antonio Nuno Monteiro <[email protected]> --------- Signed-off-by: Antonio Nuno Monteiro <[email protected]>
ocaml · Oct 20, 2024 · dce464e · dce464e
1 parent 7838199
commit dce464e
Show file tree

Hide file tree

Showing 2 changed files with 79 additions and 14 deletions.
diff --git a/bin/exec.ml b/bin/exec.ml
@@ -67,12 +67,16 @@ module Command_to_exec = struct
   (* A command to execute, which knows how to (re)build the program and then
      run it with some arguments in an environment *)
 
+  type command_env =
+    { path : Path.t
+    ; env : Env.t
+    }
+
   type t =
-    { get_path_and_build_if_necessary :
-        string -> (Path.t, [ `Already_reported ]) result Fiber.t
+    { get_env_and_build_if_necessary :
+        string -> (command_env, [ `Already_reported ]) result Fiber.t
     ; prog : string
     ; args : string list
-    ; env : Env.t
     }
 
   (* Helper function to spawn a new process running a command in an
@@ -90,12 +94,10 @@ module Command_to_exec = struct
 
   (* Run the command, first (re)building the program which the command is
      invoking *)
-  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 ~root ~args ~env))
+  let build_and_run_in_child_process ~root { get_env_and_build_if_necessary; prog; args } =
+    get_env_and_build_if_necessary prog
+    |> Fiber.map
+         ~f:(Result.map ~f:(fun { path; env } -> spawn_process ~root ~args ~env path))
   ;;
 end
 
@@ -309,20 +311,21 @@ module Exec_context = struct
       Memo.run
       @@
       let open Memo.O in
-      let* env = env
-      and* sctx = sctx in
+      let* sctx = sctx in
       let expand = Cmd_arg.expand ~root:(Common.root common) ~sctx in
       let* prog = expand prog in
       let+ args = Memo.parallel_map args ~f:expand in
-      { Command_to_exec.get_path_and_build_if_necessary =
+      { Command_to_exec.get_env_and_build_if_necessary =
           (fun prog ->
             (* TODO we should release the dune lock. But we aren't doing it
                because we don't unload the database files we've marshalled.
             *)
-            build (fun () -> get_path_and_build_if_necessary ~prog))
+            build (fun () ->
+              let+ env = env
+              and+ path = get_path_and_build_if_necessary ~prog in
+              { Command_to_exec.path; env }))
       ; prog
       ; args
-      ; env
       }
     in
     Watch.loop ~root:(Common.root common) ~command_to_exec

diff --git a/test/blackbox-tests/test-cases/pkg/gh10959.t b/test/blackbox-tests/test-cases/pkg/gh10959.t
@@ -0,0 +1,62 @@
+Repro `dune exec --watch` crash with pkg management
+
+  $ . ./helpers.sh
+
+  $ mkdir external_sources
+  $ cat >external_sources/dune-project <<EOF
+  > (lang dune 3.11)
+  > (package (name mypkg))
+  > EOF
+  $ cat >external_sources/dune <<EOF
+  > (library
+  >  (public_name mypkg.lib)
+  >  (name test_lib))
+  > EOF
+  $ cat >external_sources/test_lib.ml <<EOF
+  > let x = "hello"
+  > EOF
+
+Now we set up a lock file with this package and then attempt to use it:
+
+  $ cat >dune-project <<EOF
+  > (lang dune 3.11)
+  > EOF
+
+  $ mkdir dune.lock
+  $ cat >dune.lock/lock.dune <<EOF
+  > (lang package 0.1)
+  > EOF
+
+  $ cat >dune.lock/mypkg.pkg <<EOF
+  > (version 0.0.1)
+  > (source (copy $PWD/external_sources))
+  > (build
+  >   (run dune build --release --promote-install-file=true . @install))
+  > EOF
+
+  $ cat >dune <<EOF
+  > (dirs (:standard \ external_sources))
+  > (executable
+  >  (name x)
+  >  (libraries mypkg.lib))
+  > EOF
+
+  $ cat >x.ml <<EOF
+  > let () = print_endline Test_lib.x
+  > EOF
+
+  $ dune exec -w ./x.exe > output.log 2>&1 &
+  $ PID=$!
+
+  $ TIME_WAITED=0
+  $ MAX_WAIT_TIME=20
+  $ SLEEP_INTERVAL=1
+  $ while [ $(cat output.log | wc -l) -lt 2 ] && [ "$TIME_WAITED" -lt "$MAX_WAIT_TIME" ]; do
+  >   sleep 0.1
+  >   TIME_WAITED=$((TIME_WAITED + SLEEP_INTERVAL))
+  > done
+
+  $ cat output.log | sort
+  Success, waiting for filesystem changes...
+  hello
+  $ kill $PID