test: repro rpc jobs bug (#8410)

This demonstrates that RPC jobs events are not stopped when dune is
interrupted and restarted.

Signed-off-by: Ali Caglayan <alizter@gmail.com>

test/expect-tests/dune_rpc_e2e/dune

@@ -70,3 +70,26 @@
   ppx_inline_test.config)
  (preprocess
   (pps ppx_expect)))
+
+(library
+ (name dune_rpc_jobs_test)
+ (modules dune_rpc_jobs)
+ (inline_tests
+  (deps
+   (package dune)))
+ (libraries
+  fiber
+  stdune
+  dune_rpc_client
+  dune_rpc_e2e
+  dune_rpc_private
+  dune_rpc_impl
+  ;; This is because of the (implicit_transitive_deps false)
+  ;; in dune-project
+  ppx_expect.config
+  ppx_expect.config_types
+  ppx_expect.common
+  base
+  ppx_inline_test.config)
+ (preprocess
+  (pps ppx_expect)))

test/expect-tests/dune_rpc_e2e/dune_rpc_e2e.ml

@@ -123,11 +123,11 @@ let run ?env ~prog ~argv () =
   , read_lines stderr_i )
 ;;
 
-let run_server ?env ~root_dir () =
+let run_server ?(watch_mode_args = [ "--passive-watch-mode" ]) ?env ~root_dir () =
   run
     ?env
     ~prog:(Lazy.force dune_prog)
-    ~argv:[ "build"; "--passive-watch-mode"; "--root"; root_dir ]
+    ~argv:([ "build"; "--root"; root_dir ] @ watch_mode_args)
     ()
 ;;
 
@@ -151,11 +151,13 @@ let dune_build client what =
        | Failure -> "failed")
 ;;
 
-let with_dune_watch ?env f =
+let with_dune_watch ?watch_mode_args ?env f =
   let root_dir = "." in
   let xdg_runtime_dir = Filename.get_temp_dir_name () in
   Unix.putenv "XDG_RUNTIME_DIR" xdg_runtime_dir;
-  let pid, run_server, server_stdout, server_stderr = run_server ?env ~root_dir () in
+  let pid, run_server, server_stdout, server_stderr =
+    run_server ?watch_mode_args ?env ~root_dir ()
+  in
   let+ res, (stdout, stderr) =
     Fiber.fork_and_join
       (fun () -> Fiber.fork_and_join_unit (fun () -> run_server) (fun () -> f pid))

test/expect-tests/dune_rpc_e2e/dune_rpc_e2e.mli

@@ -1,6 +1,11 @@
 open Stdune
 
-val with_dune_watch : ?env:string list -> (Pid.t -> 'a Fiber.t) -> 'a Fiber.t
+val with_dune_watch
+  :  ?watch_mode_args:string list
+  -> ?env:string list
+  -> (Pid.t -> 'a Fiber.t)
+  -> 'a Fiber.t
+
 val dune_build : Dune_rpc_client.Client.t -> string -> unit Fiber.t
 
 val run_client

test/expect-tests/dune_rpc_e2e/dune_rpc_jobs.ml

@@ -0,0 +1,84 @@
+open Stdune
+open Fiber.O
+open Dune_rpc_e2e
+module Client = Dune_rpc_client.Client
+module Dune_rpc = Dune_rpc_private
+
+include struct
+  open Dune_rpc
+  module Job = Job
+  module Conv = Conv
+end
+
+let files = List.iter ~f:(fun (f, contents) -> Io.String_path.write_file f contents)
+
+let poll_exn client decl =
+  let+ poll = Client.poll client decl in
+  match poll with
+  | Ok p -> p
+  | Error e -> raise (Dune_rpc.Version_error.E e)
+;;
+
+let print_job_events poll =
+  let+ res = Client.Stream.next poll in
+  let id_to_string id = Conv.to_sexp Job.Id.sexp id |> Sexp.to_string in
+  match res with
+  | None -> printfn "client: no more diagnostics"
+  | Some job_event_list ->
+    List.iter job_event_list ~f:(fun job_event ->
+      match (job_event : Job.Event.t) with
+      | Start job ->
+        printfn
+          "Start %s %s"
+          (id_to_string job.id)
+          (Format.asprintf "%a" Pp.to_fmt job.description)
+      | Stop id -> printfn "Stop %s" (id_to_string id))
+;;
+
+let%expect_test "rpc jobs after rebuild" =
+  let rec wait_for_running_file () =
+    match Unix.stat "_build/default/running" with
+    | _stat -> printfn "Background process is running, let's interrupt it..."
+    | exception Unix.Unix_error (Unix.ENOENT, _, _) ->
+      Unix.sleepf 0.01;
+      wait_for_running_file ()
+  in
+  ignore wait_for_running_file;
+  let exec _pid =
+    run_client (fun client ->
+      let* () =
+        Fiber.return
+        @@ files
+             [ "dune-project", "(lang dune 3.10)"
+             ; ( "dune"
+               , {|
+                (rule
+                 (target foo)
+                 (deps bar)
+                 (alias runtest)
+                 (action
+                  (progn
+                   (write-file running "hello")
+                   (system "sleep 100")
+                   (write-file foo "foo"))))
+                |}
+               )
+             ]
+      in
+      let* poll = poll_exn client Dune_rpc.Public.Sub.running_jobs in
+      files [ "bar", "" ];
+      wait_for_running_file ();
+      let* () = print_job_events poll in
+      files [ "bar", "more" ];
+      wait_for_running_file ();
+      let* () = print_job_events poll in
+      Client.Stream.cancel poll)
+  in
+  run (fun () -> with_dune_watch ~watch_mode_args:[ "-w"; "@runtest" ] exec);
+  [%expect
+    {|
+    Background process is running, let's interrupt it...
+    Start 1 _build/default/foo
+    Background process is running, let's interrupt it...
+    Start 2 _build/default/foo |}]
+;;

test/expect-tests/dune_rpc_e2e/dune_rpc_registry_test.ml

@@ -106,6 +106,6 @@ let%expect_test "turn on dune watch and wait until the connection is listed" =
   run case;
   [%expect
     {|
-    $PATH/dune build --passive-watch-mode --root . returned 130
+    $PATH/dune build --root . --passive-watch-mode returned 130
     [PASS] found . at unix:path=%24CWD/_build/.rpc/dune |}]
 ;;