unikernel/duniverse/dune_/test/expect-tests/common/dune

@@ -0,0 +1,4 @@
+(library
+ (name dune_tests_common)
+ (modules dune_tests_common)
+ (libraries stdune dune_console dune_util))

unikernel/duniverse/dune_/test/expect-tests/common/dune_tests_common.ml

@@ -0,0 +1,17 @@
+open Stdune
+module Console = Dune_console
+
+let print pp = Format.printf "%a@." Pp.to_fmt pp
+let print_dyn dyn = print (Dyn.pp dyn)
+
+let init =
+  let init =
+    lazy
+      (Printexc.record_backtrace false;
+       Path.set_root (Path.External.cwd ());
+       Path.Build.set_build_dir (Path.Outside_build_dir.of_string "_build");
+       Console.Backend.(set dumb);
+       Dune_util.Log.init ())
+  in
+  fun () -> Lazy.force init
+;;

unikernel/duniverse/dune_/test/expect-tests/csexp_rpc/csexp_rpc_tests.ml

@@ -0,0 +1,109 @@
+open! Stdune
+open Csexp_rpc
+open Fiber.O
+module Scheduler = Dune_engine.Scheduler
+
+let () = Dune_tests_common.init ()
+
+type event =
+  | Fill of Fiber.fill
+  | Abort
+
+let server (where : Unix.sockaddr) =
+  (match where with
+   | ADDR_UNIX p ->
+     let p = Path.of_string p in
+     Path.unlink_no_err p;
+     Path.mkdir_p (Path.parent_exn p)
+   | _ -> ());
+  match Server.create [ where ] ~backlog:10 with
+  | Ok t -> t
+  | Error `Already_in_use -> assert false
+;;
+
+let client where = Csexp_rpc.Client.create where
+
+module Logger = struct
+  (* A little helper to make the output from the client and server
+     deterministic. Log messages are batched and outputted at the end. *)
+  type t =
+    { mutable messages : string list
+    ; name : string
+    }
+
+  let create ~name = { messages = []; name }
+  let log t fmt = Printf.ksprintf (fun m -> t.messages <- m :: t.messages) fmt
+
+  let print { messages; name } =
+    List.rev messages |> List.iter ~f:(fun msg -> printfn "%s: %s" name msg)
+  ;;
+end
+
+let ok_exn = function
+  | Ok s -> s
+  | Error `Closed -> failwith "closed"
+  | Error (`Exn exn) -> raise exn
+;;
+
+let%expect_test "csexp server life cycle" =
+  let tmp_dir = Temp.create Dir ~prefix:"test" ~suffix:"dune_rpc" in
+  let addr : Unix.sockaddr =
+    if Sys.win32
+    then ADDR_INET (Unix.inet_addr_loopback, 0)
+    else ADDR_UNIX (Path.to_string (Path.relative tmp_dir "dunerpc.sock"))
+  in
+  let client_log = Logger.create ~name:"client" in
+  let server_log = Logger.create ~name:"server" in
+  let run () =
+    let server = server addr in
+    let* sessions = Server.serve server in
+    let client = Csexp_rpc.Server.listening_address server |> List.hd |> client in
+    Fiber.fork_and_join_unit
+      (fun () ->
+         let log fmt = Logger.log client_log fmt in
+         let* client = Client.connect_exn client in
+         let* () = Session.write client [ List [ Atom "from client" ] ] >>| ok_exn in
+         log "written";
+         let* response = Session.read client in
+         (match response with
+          | None -> log "no response"
+          | Some sexp -> log "received %s" (Csexp.to_string sexp));
+         let* () = Session.close client in
+         log "closed";
+         Server.stop server)
+      (fun () ->
+         let log fmt = Logger.log server_log fmt in
+         let+ () =
+           Fiber.Stream.In.parallel_iter sessions ~f:(fun session ->
+             log "received session";
+             let* res = Csexp_rpc.Session.read session in
+             match res with
+             | None ->
+               log "session terminated";
+               Fiber.return ()
+             | Some csexp ->
+               log "received %s" (Csexp.to_string csexp);
+               Session.write session [ List [ Atom "from server" ] ] >>| ok_exn)
+         in
+         log "sessions finished")
+  in
+  Dune_engine.Clflags.display := Quiet;
+  let config =
+    { Scheduler.Config.concurrency = 1
+    ; stats = None
+    ; print_ctrl_c_warning = false
+    ; watch_exclusions = []
+    }
+  in
+  Scheduler.Run.go config run ~on_event:(fun _ _ -> ());
+  Logger.print client_log;
+  Logger.print server_log;
+  [%expect
+    {|
+    client: written
+    client: received (11:from server)
+    client: closed
+    server: received session
+    server: received (11:from client)
+    server: sessions finished |}]
+;;

unikernel/duniverse/dune_/test/expect-tests/csexp_rpc/dune

@@ -0,0 +1,20 @@
+(library
+ (name csexp_rpc_tests)
+ (inline_tests)
+ (preprocess
+  (pps ppx_expect))
+ (libraries
+  stdune
+  csexp
+  csexp_rpc
+  dune_engine
+  unix
+  threads.posix
+  fiber
+  dune_tests_common
+  ;; This is because of the (implicit_transitive_deps false)
+  ;; in dune-project
+  ppx_expect.config
+  ppx_expect.config_types
+  base
+  ppx_inline_test.config))

unikernel/duniverse/dune_/test/expect-tests/csexp_rpc/io_buffer_tests.ml

@@ -0,0 +1,74 @@
+open Stdune
+module Io_buffer = Csexp_rpc.Private.Io_buffer
+
+let () = Printexc.record_backtrace false
+let print_dyn x = Io_buffer.to_dyn x |> Dyn.to_string |> print_endline
+
+let%expect_test "empty buffer is empty" =
+  print_dyn (Io_buffer.create ~size:4);
+  [%expect {| { total_written = 0; contents = ""; pos_w = 0; pos_r = 0 } |}]
+;;
+
+let%expect_test "resize" =
+  let buf = Io_buffer.create ~size:2 in
+  Io_buffer.write_csexps buf [ Csexp.Atom "xxx" ];
+  print_dyn buf;
+  [%expect
+    {|
+    { total_written = 0; contents = "3:xxx"; pos_w = 5; pos_r = 0 } |}];
+  Io_buffer.write_csexps buf [ Csexp.Atom "xxxyyy" ];
+  print_dyn buf;
+  [%expect
+    {|
+    { total_written = 0; contents = "3:xxx6:xxxyyy"; pos_w = 13; pos_r = 0 } |}]
+;;
+
+let%expect_test "reading" =
+  let buf = Io_buffer.create ~size:10 in
+  Io_buffer.write_csexps buf [ Csexp.Atom "abcde" ];
+  print_dyn buf;
+  [%expect
+    {|
+    { total_written = 0; contents = "5:abcde"; pos_w = 7; pos_r = 0 } |}];
+  Io_buffer.read buf 4;
+  print_dyn buf;
+  [%expect
+    {|
+    { total_written = 4; contents = "cde"; pos_w = 7; pos_r = 4 } |}];
+  Io_buffer.read buf 2;
+  print_dyn buf;
+  [%expect
+    {|
+    { total_written = 6; contents = "e"; pos_w = 7; pos_r = 6 } |}];
+  (* buffer is now empty, this should now error *)
+  Io_buffer.read buf 2;
+  print_dyn buf;
+  [%expect.unreachable]
+[@@expect.uncaught_exn
+  {|
+  ("(\"not enough bytes in buffer\", { len = 2; length = 1 })") |}]
+;;
+
+let%expect_test "reading" =
+  let buf = Io_buffer.create ~size:1 in
+  Io_buffer.write_csexps buf [ Atom "abc" ];
+  print_dyn buf;
+  [%expect
+    {|
+    { total_written = 0; contents = "3:abc"; pos_w = 5; pos_r = 0 } |}];
+  let flush = Io_buffer.flush_token buf in
+  printfn "token: %b" (Io_buffer.flushed buf flush);
+  [%expect
+    {|
+    token: false |}];
+  Io_buffer.read buf 4;
+  printfn "token: %b" (Io_buffer.flushed buf flush);
+  [%expect
+    {|
+    token: false |}];
+  Io_buffer.read buf 1;
+  printfn "token: %b" (Io_buffer.flushed buf flush);
+  [%expect
+    {|
+    token: true |}]
+;;

unikernel/duniverse/dune_/test/expect-tests/dag/dag_tests.ml

@@ -0,0 +1,245 @@
+open Stdune
+open Dune_tests_common
+
+let () = init ()
+
+type mynode = { name : string }
+
+let pp_mynode fmt n = Format.fprintf fmt "%s" n.name
+
+let%expect_test _ =
+  let open
+    Dag.Make
+      (struct
+        type t = mynode
+      end)
+      () in
+  let node data = create_node data in
+  let root = node { name = "root" } in
+  let node11 = node { name = "child 1 1" } in
+  let node12 = node { name = "child 1 2" } in
+  let node21 = node { name = "child 2 1" } in
+  let node31 = node { name = "child 3 1" } in
+  add_assuming_missing root node11;
+  add_assuming_missing root node12;
+  add_assuming_missing node12 node21;
+  add_assuming_missing node21 node31;
+  let dag_pp_mynode = pp_node pp_mynode in
+  Format.printf "%a@." dag_pp_mynode root;
+  let node41 = node { name = "child 4 1" } in
+  add_assuming_missing node31 node41;
+  Format.printf "%a@." dag_pp_mynode root;
+  let name node = (value node).name in
+  try
+    add_assuming_missing node41 root;
+    print_endline "no cycle"
+  with
+  | Cycle cycle ->
+    print_endline "cycle:";
+    let cycle = List.map cycle ~f:name in
+    List.map ~f:Pp.text cycle |> Pp.concat ~sep:Pp.space |> print;
+    [%expect
+      {|
+      (0: k=1) (root) [(2: k=1) (child 1 2) [(3: k=1) (child 2 1) [(4: k=2) (child 3 1) [
+                                                                   ]]];
+                        (1: k=1) (child 1 1) []]
+      (0: k=1) (root) [(2: k=1) (child 1 2) [(3: k=1) (child 2 1) [(4: k=2) (child 3 1) [
+                                                                   (5: k=2) (child 4 1) [
+                                                                   ]]]];
+                        (1: k=1) (child 1 1) []]
+      cycle:
+      child 4 1 child 3 1 child 2 1 child 1 2
+      root
+    |}]
+;;
+
+let rec adjacent_pairs l =
+  match l with
+  | [] | [ _ ] -> []
+  | x :: y :: rest -> (x, y) :: adjacent_pairs (y :: rest)
+;;
+
+let cycle_test variant =
+  let open
+    Dag.Make
+      (struct
+        type t = int
+      end)
+      () in
+  let node data = create_node data in
+  let edges = ref [] in
+  let add n1 n2 =
+    edges := (value n1, value n2) :: !edges;
+    add_assuming_missing n1 n2
+  in
+  let _n1 = node 1 in
+  let n2 = node 2 in
+  let n3 = node 3 in
+  (* the two variants are equivalent, but they end up taking a different code
+     path when producing the cycle for some reason (or at least they did in
+     2019-03) *)
+  (match variant with
+   | `a -> add n2 n3
+   | `b -> ());
+  let n4 = node 4 in
+  add n3 n4;
+  let n5 = node 5 in
+  add n5 n2;
+  let n6 = node 6 in
+  add n6 n3;
+  let n7 = node 7 in
+  let n8 = node 8 in
+  add n7 n8;
+  let n9 = node 9 in
+  add n8 n9;
+  let n10 = node 10 in
+  add n9 n10;
+  let n11 = node 11 in
+  add n10 n11;
+  let n12 = node 12 in
+  add n11 n12;
+  let n13 = node 13 in
+  add n12 n13;
+  let n14 = node 14 in
+  add n13 n14;
+  let n15 = node 15 in
+  add n14 n15;
+  let n16 = node 16 in
+  add n15 n16;
+  let n17 = node 17 in
+  add n16 n17;
+  let n18 = node 18 in
+  add n17 n18;
+  let n19 = node 19 in
+  add n12 n19;
+  let n20 = node 20 in
+  add n10 n20;
+  let n21 = node 21 in
+  add n20 n21;
+  let n22 = node 22 in
+  add n21 n22;
+  let n23 = node 23 in
+  add n22 n23;
+  let n24 = node 24 in
+  add n23 n24;
+  let n25 = node 25 in
+  add n24 n25;
+  let n26 = node 26 in
+  add n25 n26;
+  let n27 = node 27 in
+  add n26 n27;
+  let n28 = node 28 in
+  add n21 n28;
+  let n29 = node 29 in
+  add n10 n29;
+  let n30 = node 30 in
+  add n8 n30;
+  let _n31 = node 31 in
+  add n14 n20;
+  match add n23 n11 with
+  | _ -> assert false
+  | exception Cycle c ->
+    let c = List.map c ~f:value in
+    List.iter (adjacent_pairs c) ~f:(fun (b, a) ->
+      match List.exists !edges ~f:(fun edge -> edge = (a, b)) with
+      | true -> ()
+      | false -> Printf.ksprintf failwith "bad edge in cycle: (%d, %d)\n" a b);
+    List.map c ~f:(Pp.textf "%d") |> Pp.concat ~sep:Pp.space |> print
+;;
+
+let%expect_test _ =
+  cycle_test `a;
+  [%expect
+    {|
+    23 22 21 20 14 13 12
+    11
+  |}]
+;;
+
+let%expect_test _ =
+  cycle_test `b;
+  [%expect
+    {|
+    23 22 21 20 14 13 12
+    11
+  |}]
+;;
+
+let%expect_test "creating a cycle can succeed on the second attempt" =
+  let open
+    Dag.Make
+      (struct
+        type t = mynode
+      end)
+      () in
+  let node = create_node in
+  let c1 = node { name = "c1" } in
+  let c2 = node { name = "c2" } in
+  let c3 = node { name = "c3" } in
+  let c4 = node { name = "c4" } in
+  add_assuming_missing c1 c2;
+  add_assuming_missing c2 c3;
+  add_assuming_missing c3 c4;
+  let dag_pp_mynode = pp_node pp_mynode in
+  Format.printf "c1 = %a@.\n" dag_pp_mynode c1;
+  Format.printf "c2 = %a@.\n" dag_pp_mynode c2;
+  Format.printf "c3 = %a@.\n" dag_pp_mynode c3;
+  Format.printf "c4 = %a@.\n" dag_pp_mynode c4;
+  [%expect
+    {|
+    c1 = (0: k=1) (c1) [(1: k=1) (c2) [(2: k=1) (c3) [(3: k=2) (c4) []]]]
+
+    c2 = (1: k=1) (c2) [(2: k=1) (c3) [(3: k=2) (c4) []]]
+
+    c3 = (2: k=1) (c3) [(3: k=2) (c4) []]
+
+    c4 = (3: k=2) (c4) []
+  |}];
+  (match add_assuming_missing c4 c2 with
+   | () -> Format.printf "added :o\n"
+   | exception Cycle _ -> Format.printf "cycle\n");
+  Format.printf "c1 = %a@.\n" dag_pp_mynode c1;
+  Format.printf "c2 = %a@.\n" dag_pp_mynode c2;
+  Format.printf "c3 = %a@.\n" dag_pp_mynode c3;
+  Format.printf "c4 = %a@.\n" dag_pp_mynode c4;
+  (* Note that the state of the nodes changed even though adding the edge has
+     failed. Specifically, the levels of nodes c2 and c3 increased to 2. *)
+  [%expect
+    {|
+    cycle
+    c1 = (0: k=1) (c1) [(1: k=2) (c2) [(2: k=2) (c3) [(3: k=2) (c4) []]]]
+
+    c2 = (1: k=2) (c2) [(2: k=2) (c3) [(3: k=2) (c4) []]]
+
+    c3 = (2: k=2) (c3) [(3: k=2) (c4) []]
+
+    c4 = (3: k=2) (c4) []
+  |}];
+  (match add_assuming_missing c4 c2 with
+   | () -> Format.printf "added :o\n"
+   | exception Cycle _ -> Format.printf "cycle\n");
+  Format.printf "c1 = %a@.\n" dag_pp_mynode c1;
+  (* The output is truncated at depth 20. *)
+  [%expect
+    {|
+    added :o
+    c1 = (0: k=1) (c1) [(1: k=2) (c2) [(2: k=2) (c3) [(3: k=2) (c4) [
+                                                               (1: k=2) (c2) [
+                                                               (2: k=2) (c3) [
+                                                               (3: k=2) (c4) [
+                                                               (1: k=2) (c2) [
+                                                               (2: k=2) (c3) [
+                                                               (3: k=2) (c4) [
+                                                               (1: k=2) (c2) [
+                                                               (2: k=2) (c3) [
+                                                               (3: k=2) (c4) [
+                                                               (1: k=2) (c2) [
+                                                               (2: k=2) (c3) [
+                                                               (3: k=2) (c4) [
+                                                               (1: k=2) (c2) [
+                                                               (2: k=2) (c3) [
+                                                               (3: k=2) (c4) [
+                                                               (1: k=2) (c2) [
+                                                               ...]]]]]]]]]]]]]]]]]]]]
+  |}]
+;;

unikernel/duniverse/dune_/test/expect-tests/dag/dune

@@ -0,0 +1,15 @@
+(library
+ (name dune_dag_unit_tests)
+ (inline_tests)
+ (libraries
+  dune_tests_common
+  stdune
+  dag
+  ;; This is because of the (implicit_transitive_deps false)
+  ;; in dune-project
+  ppx_expect.config
+  ppx_expect.config_types
+  base
+  ppx_inline_test.config)
+ (preprocess
+  (pps ppx_expect)))

unikernel/duniverse/dune_/test/expect-tests/digest/digest_tests.ml

@@ -0,0 +1,39 @@
+open Stdune
+module Digest = Dune_digest
+
+let%expect_test "directory digest version" =
+  (* If this test fails with a new digest value, make sure to update
+     [directory_digest_version] in digest.ml.
+
+     The expected value is kept outside of the expect block on purpose so that it
+     must be modified manually. *)
+  let expected = "b8103f74615da82331f53c68145085fc" in
+  let dir = Temp.create Dir ~prefix:"digest-tests" ~suffix:"" in
+  let stats = { Digest.Stats_for_digest.st_kind = S_DIR; executable = true } in
+  (match Digest.path_with_stats ~allow_dirs:true dir stats with
+   | Ok digest ->
+     let digest = Digest.to_string digest in
+     if String.equal digest expected
+     then print_endline "[PASS]"
+     else
+       printfn
+         "[FAIL] new digest value. please update the version and this test.\n%s"
+         digest
+   | Error (Unexpected_kind | Unix_error _) ->
+     print_endline "[FAIL] unable to calculate digest");
+  [%expect {| [PASS] |}]
+;;
+
+let%expect_test "directories with symlinks" =
+  let dir = Temp.create Dir ~prefix:"digest-tests" ~suffix:"" in
+  let stats = { Digest.Stats_for_digest.st_kind = S_DIR; executable = true } in
+  let sub = Path.relative dir "sub" in
+  Path.mkdir_p sub;
+  Unix.symlink "bar" (Path.to_string (Path.relative dir "foo"));
+  Unix.symlink "bar" (Path.to_string (Path.relative sub "foo"));
+  (match Digest.path_with_stats ~allow_dirs:true dir stats with
+   | Ok _ -> print_endline "[PASS]"
+   | Error Unexpected_kind -> print_endline "[FAIL] unexpected kind"
+   | Error (Unix_error _) -> print_endline "[FAIL] unable to calculate digest");
+  [%expect {| [PASS] |}]
+;;

unikernel/duniverse/dune_/test/expect-tests/digest/dune

@@ -0,0 +1,15 @@
+(library
+ (name digest_unit_tests)
+ (inline_tests)
+ (libraries
+  stdune
+  dune_digest
+  unix
+  ;; This is because of the (implicit_transitive_deps false)
+  ;; in dune-project
+  ppx_expect.config
+  ppx_expect.config_types
+  base
+  ppx_inline_test.config)
+ (preprocess
+  (pps ppx_expect)))

unikernel/duniverse/dune_/test/expect-tests/dune

@@ -0,0 +1,71 @@
+(library
+ (name dune_unit_tests)
+ (modules :standard \ findlib_tests persistent_tests)
+ (libraries
+  ocaml_config
+  spawn
+  dune_tests_common
+  stdune
+  dune_util
+  dune_engine
+  dune_rules
+  fiber
+  dune_lang
+  memo
+  test_scheduler
+  ;; This is because of the (implicit_transitive_deps false)
+  ;; in dune-project
+  ppx_expect.config
+  ppx_expect.config_types
+  base
+  ppx_inline_test.config)
+ (inline_tests)
+ (preprocess
+  (pps ppx_expect)))
+
+(library
+ (name findlib_tests)
+ (inline_tests
+  (deps
+   (source_tree ../unit-tests/findlib-db)
+   (source_tree ../unit-tests/toolchain.d)))
+ (modules findlib_tests)
+ (libraries
+  ocaml_config
+  ocaml
+  dune_tests_common
+  stdune
+  dune_engine
+  dune_rules
+  dune_lang
+  dune_findlib
+  memo
+  test_scheduler
+  ;; This is because of the (implicit_transitive_deps false)
+  ;; in dune-project
+  ppx_expect.config
+  ppx_expect.config_types
+  base
+  ppx_inline_test.config)
+ (preprocess
+  (pps ppx_expect)))
+
+(library
+ (name persistent_tests)
+ (modules persistent_tests)
+ (inline_tests)
+ (preprocess
+  (pps ppx_expect))
+ (libraries
+  dune_util
+  dyn
+  stdune
+  dune_engine
+  dune_rules
+  dune_digest
+  ;; This is because of the (implicit_transitive_deps false)
+  ;; in dune-project
+  ppx_expect.config
+  ppx_expect.config_types
+  base
+  ppx_inline_test.config))

unikernel/duniverse/dune_/test/expect-tests/dune_action_plugin/dune

@@ -0,0 +1,15 @@
+(data_only_dirs foo_dir)
+
+(library
+ (name dune_action_unit_tests)
+ (inline_tests
+  (deps some_dir/some_file))
+ (libraries
+  dune_action_plugin
+  ppx_expect.config
+  ppx_expect.config_types
+  base
+  ppx_inline_test.config
+  dune-glob)
+ (preprocess
+  (pps ppx_expect)))

unikernel/duniverse/dune_/test/expect-tests/dune_action_plugin/dune_action_test.ml

@@ -0,0 +1,83 @@
+open Dune_action_plugin.V1
+module Glob = Dune_glob.V1
+module Private = Dune_action_plugin.Private
+
+let%expect_test _ =
+  try ignore @@ Path.of_string "/some/absolute/path" with
+  | Invalid_argument message ->
+    print_endline message;
+    [%expect
+      {| Path "/some/absolute/path" is absolute. All paths used with dune-action-plugin must be relative. |}]
+;;
+
+let%expect_test _ =
+  let action =
+    read_file ~path:(Path.of_string "some_dir/some_file") |> map ~f:print_endline
+  in
+  Private.do_run action;
+  [%expect
+    {|
+    Hello from foo!
+  |}]
+;;
+
+let%expect_test _ =
+  let action =
+    read_directory_with_glob ~glob:Glob.universal ~path:(Path.of_string "some_dir")
+    |> map ~f:(fun data -> String.concat "," data |> print_endline)
+  in
+  Private.do_run action;
+  [%expect
+    {|
+    some_file
+  |}]
+;;
+
+let%expect_test _ =
+  let action = write_file ~path:(Path.of_string "another_file") ~data:"Hello world!" in
+  Private.do_run action;
+  [%expect {| |}]
+;;
+
+let run_action_expect_throws action =
+  try
+    Private.do_run action;
+    print_endline "SHOULD BE UNREACHABLE"
+  with
+  | Private.Execution_error.E message -> print_endline message
+;;
+
+let%expect_test _ =
+  let action =
+    read_file ~path:(Path.of_string "file_that_does_not_exist") |> map ~f:ignore
+  in
+  run_action_expect_throws action;
+  [%expect {| read_file: open(file_that_does_not_exist): No such file or directory |}]
+;;
+
+let%expect_test _ =
+  let action =
+    read_directory_with_glob
+      ~glob:Glob.universal
+      ~path:(Path.of_string "directory_that_does_not_exist")
+    |> map ~f:ignore
+  in
+  run_action_expect_throws action;
+  [%expect
+    {|
+    read_directory: opendir(directory_that_does_not_exist): No such file or directory
+  |}]
+;;
+
+let%expect_test _ =
+  let action =
+    write_file
+      ~path:(Path.of_string "directory_that_does_not_exist/some_file")
+      ~data:"foo"
+  in
+  run_action_expect_throws action;
+  [%expect
+    {|
+    write_file: directory_that_does_not_exist/some_file: No such file or directory
+  |}]
+;;

unikernel/duniverse/dune_/test/expect-tests/dune_action_plugin/some_dir/some_file

@@ -0,0 +1 @@
+Hello from foo!

unikernel/duniverse/dune_/test/expect-tests/dune_async_io/async_io_tests.ml

@@ -0,0 +1,95 @@
+open Stdune
+open Fiber.O
+module Scheduler = Dune_engine.Scheduler
+open Dune_async_io
+
+let config =
+  { Scheduler.Config.concurrency = 1
+  ; stats = None
+  ; print_ctrl_c_warning = false
+  ; watch_exclusions = []
+  }
+;;
+
+let%expect_test "read readiness" =
+  (Scheduler.Run.go config ~on_event:(fun _ _ -> ())
+   @@ fun () ->
+   let r, w = Unix.pipe ~cloexec:true () in
+   if not Sys.win32 then Unix.set_nonblock r;
+   let* task = Async_io.ready r `Read ~f:ignore in
+   assert (Unix.write w (Bytes.of_string "0") 0 1 = 1);
+   Async_io.Task.await task
+   >>= function
+   | Error _ -> assert false
+   | Ok () ->
+     let bytes = Bytes.of_string "1" in
+     assert (Unix.read r bytes 0 1 = 1);
+     assert (Bytes.to_string bytes = "0");
+     Unix.close w;
+     let+ () = Async_io.close r in
+     print_endline "successful read");
+  [%expect {| successful read |}]
+;;
+
+let%expect_test "write readiness" =
+  (Scheduler.Run.go config ~on_event:(fun _ _ -> ())
+   @@ fun () ->
+   let r, w = Unix.pipe ~cloexec:true () in
+   if not Sys.win32 then Unix.set_nonblock w;
+   let* task = Async_io.ready w `Write ~f:ignore in
+   Async_io.Task.await task
+   >>= function
+   | Error _ -> assert false
+   | Ok () ->
+     assert (Unix.write w (Bytes.of_string "0") 0 1 = 1);
+     Unix.close r;
+     let+ () = Async_io.close w in
+     print_endline "successful write");
+  [%expect {| successful write |}]
+;;
+
+let%expect_test "first ready" =
+  (Scheduler.Run.go config ~on_event:(fun _ _ -> ())
+   @@ fun () ->
+   let r1, w1 = Unix.pipe ~cloexec:true () in
+   let r2, w2 = Unix.pipe ~cloexec:true () in
+   if not Sys.win32
+   then (
+     Unix.set_nonblock w1;
+     Unix.set_nonblock w2);
+   let* task =
+     Async_io.ready_one
+       [ (), w1; (), w2 ]
+       `Write
+       ~f:(fun () fd -> assert (Unix.write fd (Bytes.of_string "0") 0 1 = 1))
+   in
+   Async_io.Task.await task
+   >>= function
+   | Error _ -> assert false
+   | Ok () ->
+     Unix.close r1;
+     Unix.close r2;
+     let* () = Async_io.close w1 in
+     let+ () = Async_io.close w2 in
+     print_endline "successful write");
+  [%expect {| successful write |}]
+;;
+
+let%expect_test "cancel task" =
+  (Scheduler.Run.go config ~on_event:(fun _ _ -> ())
+   @@ fun () ->
+   let r, w = Unix.pipe ~cloexec:true () in
+   if not Sys.win32 then Unix.set_nonblock r;
+   let* task = Async_io.ready r `Read ~f:ignore in
+   Fiber.fork_and_join_unit
+     (fun () ->
+        Async_io.Task.await task
+        >>= function
+        | Ok () | Error (`Exn _) -> assert false
+        | Error `Cancelled ->
+          Unix.close w;
+          let+ () = Async_io.close r in
+          print_endline "successfully cancelled")
+     (fun () -> Async_io.Task.cancel task));
+  [%expect {| successfully cancelled |}]
+;;

unikernel/duniverse/dune_/test/expect-tests/dune_async_io/dune

@@ -0,0 +1,19 @@
+(library
+ (name dune_async_io_tests)
+ (inline_tests)
+ (preprocess
+  (pps ppx_expect))
+ (libraries
+  stdune
+  dune_engine
+  unix
+  threads.posix
+  fiber
+  dune_async_io
+  dune_tests_common
+  ;; This is because of the (implicit_transitive_deps false)
+  ;; in dune-project
+  ppx_expect.config
+  ppx_expect.config_types
+  base
+  ppx_inline_test.config))

unikernel/duniverse/dune_/test/expect-tests/dune_config_file/dune

@@ -0,0 +1,16 @@
+(library
+ (name dune_config_file_test)
+ (inline_tests)
+ (libraries
+  dune_tests_common
+  dune_lang
+  dune_config_file
+  stdune
+  ;; This is because of the (implicit_transitive_deps false)
+  ;; in dune-project
+  ppx_expect.config
+  ppx_expect.config_types
+  base
+  ppx_inline_test.config)
+ (preprocess
+  (pps ppx_expect)))

unikernel/duniverse/dune_/test/expect-tests/dune_config_file/dune_config_test.ml

@@ -0,0 +1,90 @@
+open Dune_lang
+open Dune_config_file
+
+let () = Printexc.record_backtrace false
+
+let parse s =
+  let ast = Parser.parse_string ~fname:"expect_test" ~mode:Parser.Mode.Single s in
+  let decode =
+    Dune_lang.Syntax.set Dune_lang.Stanza.syntax (Active (3, 0)) Dune_config.decode
+  in
+  Dune_lang.Decoder.parse decode Stdune.Univ_map.empty ast
+  |> Dune_config.(superpose default)
+  |> Dune_config.to_dyn
+  |> Dune_tests_common.print_dyn
+;;
+
+let%expect_test "cache-check-probability 0.1" =
+  parse "(cache-check-probability 0.1)";
+  [%expect
+    {|
+    { display = Simple { verbosity = Quiet; status_line = false }
+    ; concurrency = Fixed 1
+    ; terminal_persistence = Clear_on_rebuild
+    ; sandboxing_preference = []
+    ; cache_enabled = Enabled_except_user_rules
+    ; cache_reproducibility_check = Check_with_probability 0.1
+    ; cache_storage_mode = Some Hardlink
+    ; action_stdout_on_success = Print
+    ; action_stderr_on_success = Print
+    ; project_defaults =
+        { authors = Some [ "Author Name <author@example.com>" ]
+        ; maintainers = Some [ "Maintainer Name <maintainer@example.com>" ]
+        ; maintenance_intent = None
+        ; license = Some [ "LICENSE" ]
+        }
+    ; pkg_enabled = false
+    ; experimental = []
+    }
+    |}]
+;;
+
+let%expect_test "cache-storage-mode copy" =
+  parse "(cache-storage-mode copy)";
+  [%expect
+    {|
+    { display = Simple { verbosity = Quiet; status_line = false }
+    ; concurrency = Fixed 1
+    ; terminal_persistence = Clear_on_rebuild
+    ; sandboxing_preference = []
+    ; cache_enabled = Enabled_except_user_rules
+    ; cache_reproducibility_check = Skip
+    ; cache_storage_mode = Some Copy
+    ; action_stdout_on_success = Print
+    ; action_stderr_on_success = Print
+    ; project_defaults =
+        { authors = Some [ "Author Name <author@example.com>" ]
+        ; maintainers = Some [ "Maintainer Name <maintainer@example.com>" ]
+        ; maintenance_intent = None
+        ; license = Some [ "LICENSE" ]
+        }
+    ; pkg_enabled = false
+    ; experimental = []
+    }
+    |}]
+;;
+
+let%expect_test "cache-storage-mode hardlink" =
+  parse "(cache-storage-mode hardlink)";
+  [%expect
+    {|
+    { display = Simple { verbosity = Quiet; status_line = false }
+    ; concurrency = Fixed 1
+    ; terminal_persistence = Clear_on_rebuild
+    ; sandboxing_preference = []
+    ; cache_enabled = Enabled_except_user_rules
+    ; cache_reproducibility_check = Skip
+    ; cache_storage_mode = Some Hardlink
+    ; action_stdout_on_success = Print
+    ; action_stderr_on_success = Print
+    ; project_defaults =
+        { authors = Some [ "Author Name <author@example.com>" ]
+        ; maintainers = Some [ "Maintainer Name <maintainer@example.com>" ]
+        ; maintenance_intent = None
+        ; license = Some [ "LICENSE" ]
+        }
+    ; pkg_enabled = false
+    ; experimental = []
+    }
+    |}]
+;;

unikernel/duniverse/dune_/test/expect-tests/dune_console/dune

@@ -0,0 +1,15 @@
+(library
+ (name dune_console_tests)
+ (inline_tests)
+ (preprocess
+  (pps ppx_expect))
+ (libraries
+  stdune
+  dune_console
+  dune_tests_common
+  ;; This is because of the (implicit_transitive_deps false)
+  ;; in dune-project
+  ppx_expect.config
+  ppx_expect.config_types
+  base
+  ppx_inline_test.config))

unikernel/duniverse/dune_/test/expect-tests/dune_console/dune_console_tests.ml

@@ -0,0 +1,195 @@
+open Stdune
+
+let escape str =
+  str |> String.split_lines |> List.map ~f:String.escaped |> List.iter ~f:print_endline
+;;
+
+(* Creation of Dune_console is stateful so we introduce a new module for each test. *)
+module New () = Dune_console
+
+module type New_console = module type of Dune_console
+
+(* In order to keep tests across different backends consistent, we create some
+   generic test scripts here that take the created [Console]. We then test these
+   for each backend.
+
+   Remember to always clear any status lines at the end, or else carriage
+   returns will be leaked into the stderr of the inline test runners.
+*)
+
+let test_basic_usage (module Console : New_console) =
+  Console.printf "Hello World!";
+  Console.print
+    [ Pp.textf
+        "Hello this is a very long sentence that will probably wrap the console by the \
+         time that this is over."
+    ]
+;;
+
+let test_status_line_clearing (module Console : New_console) =
+  let open Console in
+  Status_line.set (Status_line.Constant (Pp.text "Here is a status line"));
+  Status_line.clear ()
+;;
+
+let test_status_line_clearing_with_wrapping (module Console : New_console) =
+  let open Console in
+  Status_line.set
+    (Status_line.Constant
+       (Pp.hovbox
+        @@ Pp.text
+             "This status line is a problem because of the fact that it is especially \
+              long and therefore will not be cleared properly."));
+  Status_line.clear ()
+;;
+
+let test_status_line_clearing_multiline (module Console : New_console) =
+  let open Console in
+  Status_line.set
+    (Status_line.Constant
+       (Pp.hovbox
+        @@ Pp.concat
+             ~sep:Pp.newline
+             [ Pp.verbatim "Some"
+             ; Pp.verbatim "multiline"
+             ; Pp.verbatim "status"
+             ; Pp.verbatim "line"
+             ]));
+  Status_line.clear ()
+;;
+
+let test_status_line_overwrite (module Console : New_console) =
+  let open Console in
+  Status_line.set (Status_line.Constant (Pp.text "Here is a status line"));
+  Status_line.set (Status_line.Constant (Pp.text "Here is another status line"));
+  Status_line.clear ()
+;;
+
+(* Dumb backend *)
+
+let%expect_test "basic usage" =
+  let module Console = New () in
+  Console.Backend.set Console.Backend.dumb;
+  test_basic_usage (module Console);
+  escape [%expect.output];
+  [%expect
+    {|
+Hello World!
+Hello this is a very long sentence that will probably wrap the console by the
+time that this is over.
+  |}]
+;;
+
+let%expect_test "Status line clearing." =
+  let module Console = New () in
+  Console.Backend.set Console.Backend.dumb;
+  test_status_line_clearing (module Console);
+  escape [%expect.output];
+  [%expect
+    {|
+Here is a status line
+  |}]
+;;
+
+let%expect_test "Status line clearing with wrapping." =
+  let module Console = New () in
+  Console.Backend.set Console.Backend.dumb;
+  test_status_line_clearing_with_wrapping (module Console);
+  escape [%expect.output];
+  [%expect
+    {|
+This status line is a problem because of the fact that it is especially long
+and therefore will not be cleared properly.
+  |}]
+;;
+
+let%expect_test "Multi-line status line clearing." =
+  let module Console = New () in
+  Console.Backend.set Console.Backend.dumb;
+  test_status_line_clearing_multiline (module Console);
+  escape [%expect.output];
+  [%expect
+    {|
+Some
+multiline
+status
+line
+  |}]
+;;
+
+let%expect_test "Status line overwriting." =
+  let module Console = New () in
+  Console.Backend.set Console.Backend.dumb;
+  test_status_line_overwrite (module Console);
+  escape [%expect.output];
+  [%expect
+    {|
+Here is a status line
+Here is another status line
+  |}]
+;;
+
+(* Progress backend *)
+
+let%expect_test "basic usage" =
+  let module Console = New () in
+  Console.Backend.set Console.Backend.progress;
+  test_basic_usage (module Console);
+  escape [%expect.output];
+  [%expect
+    {|
+Hello World!
+Hello this is a very long sentence that will probably wrap the console by the
+time that this is over.
+  |}]
+;;
+
+let%expect_test "Status line clearing." =
+  let module Console = New () in
+  Console.Backend.set Console.Backend.progress;
+  test_status_line_clearing (module Console);
+  escape [%expect.output];
+  [%expect
+    {|
+Here is a status line\r                     \r
+ |}]
+;;
+
+(* CR-someday alizter: this should insert the appropriate number of "\r"s in order to
+   fully clear the previous lines when wrapped. *)
+let%expect_test "Status line clearing with wrapping." =
+  let module Console = New () in
+  Console.Backend.set Console.Backend.progress;
+  test_status_line_clearing_with_wrapping (module Console);
+  escape [%expect.output];
+  [%expect
+    {|
+This status line is a problem because of the fact that it is especially long
+and therefore will not be cleared properly.\r                                                                                                                        \r
+ |}]
+;;
+
+let%expect_test "Multi-line status line clearing." =
+  let module Console = New () in
+  Console.Backend.set Console.Backend.progress;
+  test_status_line_clearing_multiline (module Console);
+  escape [%expect.output];
+  [%expect
+    {|
+Some
+multiline
+status
+line\r                          \r
+  |}]
+;;
+
+let%expect_test "Status line overwriting." =
+  let module Console = New () in
+  Console.Backend.set Console.Backend.progress;
+  test_status_line_overwrite (module Console);
+  escape [%expect.output];
+  [%expect
+    {|
+Here is a status line\r                     \rHere is another status line\r                           \r
+  |}]
+;;

unikernel/duniverse/dune_/test/expect-tests/dune_engine/action_to_sh_tests.ml

@@ -0,0 +1,247 @@
+open Stdune
+open Dune_engine
+open Action.For_shell
+module Action = Dune_engine.Action
+
+let print x = x |> Action_to_sh.pp |> Dune_tests_common.print
+
+let%expect_test "run" =
+  Run ("my_program", Array.Immutable.of_array [| "my"; "-I"; "args" |]) |> print;
+  [%expect
+    {|
+    my_program my -I args |}]
+;;
+
+(* TODO dynamic-run *)
+
+let%expect_test "chdir" =
+  Chdir ("foo", Bash "echo Hello world") |> print;
+  [%expect
+    {|
+    mkdir -p foo;cd foo;
+    bash -e -u -o pipefail -c 'echo Hello world' |}]
+;;
+
+let%expect_test "setenv" =
+  Setenv ("FOO", "bar", Bash "echo Hello world") |> print;
+  [%expect
+    {|
+    FOO=bar;
+    bash -e -u -o pipefail -c 'echo Hello world' |}]
+;;
+
+let%expect_test "with-stdout-to" =
+  Redirect_out
+    (Action.Outputs.Stdout, "foo", Action.File_perm.Normal, Bash "echo Hello world")
+  |> print;
+  [%expect
+    {|
+    bash -e -u -o pipefail -c 'echo Hello world' > foo |}]
+;;
+
+let%expect_test "with-stderr-to" =
+  Redirect_out
+    (Action.Outputs.Stderr, "foo", Action.File_perm.Normal, Bash "echo Hello world")
+  |> print;
+  [%expect
+    {|
+    bash -e -u -o pipefail -c 'echo Hello world' 2> foo |}]
+;;
+
+let%expect_test "with-outputs-to" =
+  Redirect_out
+    ( Action.Outputs.Outputs
+    , "foo"
+    , Action.File_perm.Normal
+    , Progn [ Bash "first something"; Bash "then"; Bash "echo Hello world" ] )
+  |> print;
+  [%expect
+    {|
+    {
+      bash -e -u -o pipefail -c 'first something';
+      bash -e -u -o pipefail -c then;
+      bash -e -u -o pipefail -c 'echo Hello world';
+    } &> foo |}]
+;;
+
+let%expect_test "with-outputs-to executable" =
+  Redirect_out
+    (Action.Outputs.Outputs, "foo", Action.File_perm.Executable, Bash "echo Hello world")
+  |> print;
+  [%expect
+    {|
+    bash -e -u -o pipefail -c 'echo Hello world' &> foo;
+    chmod +x foo |}]
+;;
+
+let%expect_test "ignore stdout" =
+  Ignore (Action.Outputs.Stdout, Bash "echo Hello world") |> print;
+  [%expect
+    {|
+    bash -e -u -o pipefail -c 'echo Hello world' > /dev/null |}]
+;;
+
+let%expect_test "ignore stderr" =
+  Ignore (Action.Outputs.Stderr, Bash "echo Hello world") |> print;
+  [%expect
+    {|
+    bash -e -u -o pipefail -c 'echo Hello world' 2> /dev/null |}]
+;;
+
+let%expect_test "ignore outputs" =
+  Ignore (Action.Outputs.Outputs, Bash "echo Hello world") |> print;
+  [%expect
+    {|
+    bash -e -u -o pipefail -c 'echo Hello world' &> /dev/null |}]
+;;
+
+let%expect_test "with-stdin-from" =
+  Redirect_in
+    ( Action.Inputs.Stdin
+    , "foo"
+    , Bash
+        {|
+    while read line; do
+      echo $line
+    done
+  |}
+    )
+  |> print;
+  [%expect
+    {|
+    bash -e -u -o pipefail -c
+      '
+        while read line; do
+          echo $line
+        done
+      ' < foo |}]
+;;
+
+(* TODO currently no special printing for with-accepted-exit-codes *)
+let%expect_test "with-accepted-exit-codes" =
+  With_accepted_exit_codes
+    ( Predicate_lang.of_list [ 0; 1; 123 ]
+    , Bash
+        {|
+    echo Hello world
+    exit 123
+  |}
+    )
+  |> print;
+  [%expect
+    {|
+    bash -e -u -o pipefail -c '
+        echo Hello world
+        exit 123
+      ' |}]
+;;
+
+let%expect_test "progn" =
+  Progn [ Bash "echo Hello"; Bash "echo world" ] |> print;
+  [%expect
+    {|
+    bash -e -u -o pipefail -c 'echo Hello';
+    bash -e -u -o pipefail -c 'echo world' |}]
+;;
+
+let%expect_test "concurrent" =
+  Concurrent [ Bash "echo Hello"; Bash "echo world" ] |> print;
+  [%expect
+    {|
+    ( bash -e -u -o pipefail -c 'echo Hello' &
+      bash -e -u -o pipefail -c 'echo world' & wait ) |}]
+;;
+
+let%expect_test "echo" =
+  Echo [ "Hello"; "world" ] |> print;
+  [%expect
+    {|
+    echo -n Helloworld |}]
+;;
+
+let%expect_test "write-file" =
+  Write_file ("foo", Action.File_perm.Normal, "Hello world") |> print;
+  [%expect
+    {|
+    echo -n 'Hello world' > foo |}]
+;;
+
+let%expect_test "write-file executable" =
+  Write_file ("foo", Action.File_perm.Executable, "Hello world") |> print;
+  [%expect
+    {|
+      echo -n 'Hello world' > foo;
+      chmod +x foo |}]
+;;
+
+let%expect_test "cat" =
+  Cat [ "foo" ] |> print;
+  [%expect
+    {|
+    cat foo |}]
+;;
+
+let%expect_test "cat multiple" =
+  Cat [ "foo"; "bar" ] |> print;
+  [%expect
+    {|
+    cat foo bar |}]
+;;
+
+let%expect_test "copy" =
+  Copy ("foo", "bar") |> print;
+  [%expect
+    {|
+    cp foo bar |}]
+;;
+
+let%expect_test "bash" =
+  Bash "echo Hello world" |> print;
+  [%expect
+    {|
+    bash -e -u -o pipefail -c 'echo Hello world' |}]
+;;
+
+(* cmping a binary file in optional mode is not supported *)
+
+let%expect_test "pipe-stdout-to" =
+  Pipe
+    ( Action.Outputs.Stdout
+    , [ Bash "echo Hello world"
+      ; Redirect_out
+          (Action.Outputs.Stdout, "foo", Action.File_perm.Normal, Bash "echo Hello world")
+      ] )
+  |> print;
+  [%expect
+    {|
+    bash -e -u -o pipefail -c 'echo Hello world'  |
+      bash -e -u -o pipefail -c 'echo Hello world' > foo |}]
+;;
+
+let%expect_test "pipe-stderr-to" =
+  Pipe
+    ( Action.Outputs.Stderr
+    , [ Bash "echo Hello world"
+      ; Redirect_out
+          (Action.Outputs.Stderr, "foo", Action.File_perm.Normal, Bash "echo Hello world")
+      ] )
+  |> print;
+  [%expect
+    {|
+    bash -e -u -o pipefail -c 'echo Hello world'  2> >(
+      bash -e -u -o pipefail -c 'echo Hello world' 2> foo  1>&2 ) |}]
+;;
+
+let%expect_test "pipe-outputs-to" =
+  Pipe
+    ( Action.Outputs.Outputs
+    , [ Bash "echo Hello world"
+      ; Redirect_out
+          (Action.Outputs.Outputs, "foo", Action.File_perm.Normal, Bash "echo Hello world")
+      ] )
+  |> print;
+  [%expect
+    {|
+      bash -e -u -o pipefail -c 'echo Hello world'  2>&1 |
+        bash -e -u -o pipefail -c 'echo Hello world' &> foo |}]
+;;

unikernel/duniverse/dune_/test/expect-tests/dune_engine/dune

@@ -0,0 +1,17 @@
+(library
+ (name dune_engine_test)
+ (inline_tests)
+ (libraries
+  dune_tests_common
+  dune_lang
+  predicate_lang
+  stdune
+  dune_engine
+  ;; This is because of the (implicit_transitive_deps false)
+  ;; in dune-project
+  ppx_expect.config
+  ppx_expect.config_types
+  base
+  ppx_inline_test.config)
+ (preprocess
+  (pps ppx_expect)))

unikernel/duniverse/dune_/test/expect-tests/dune_file_tests.ml

@@ -0,0 +1,86 @@
+open Dune_rules
+open! Stdune
+open Dune_tests_common
+
+let () = init ()
+
+(* Dune_file.Executables.Link_mode.decode *)
+let test s =
+  Dune_lang.Decoder.parse
+    Executables.Link_mode.decode
+    Univ_map.empty
+    (Dune_lang.Parser.parse_string ~fname:"" ~mode:Dune_lang.Parser.Mode.Single s)
+  |> Executables.Link_mode.to_dyn
+  |> print_dyn
+;;
+
+let%expect_test _ =
+  (* Link modes can be read as a (<mode> <kind>) list *)
+  test "(best exe)";
+  [%expect
+    {|
+Other { mode = best; kind = exe }
+|}]
+;;
+
+let%expect_test _ =
+  (* Some shortcuts also exist *)
+  test "exe";
+  [%expect
+    {|
+Other { mode = best; kind = exe }
+|}]
+;;
+
+let%expect_test _ =
+  test "object";
+  [%expect
+    {|
+Other { mode = best; kind = object }
+|}]
+;;
+
+let%expect_test _ =
+  test "shared_object";
+  [%expect
+    {|
+Other { mode = best; kind = shared_object }
+|}]
+;;
+
+let%expect_test _ =
+  test "byte";
+  [%expect
+    {|
+Other { mode = byte; kind = exe }
+|}]
+;;
+
+let%expect_test _ =
+  test "native";
+  [%expect
+    {|
+Other { mode = native; kind = exe }
+|}]
+;;
+
+(* Dune_file.Executables.Link_mode.encode *)
+let test l = Executables.Link_mode.encode l
+
+let%expect_test _ =
+  (* In the general case, modes are serialized as a list *)
+  test (Other { kind = Shared_object; mode = Byte }) |> Dune_lang.to_dyn |> print_dyn;
+  [%expect
+    {|
+[ "byte"; "shared_object" ]
+|}]
+;;
+
+(* But the specialized ones are serialized in the minimal version *)
+let%expect_test _ =
+  test Executables.Link_mode.exe |> Dune_lang.to_dyn |> print_dyn;
+  [%expect
+    {|
+"exe"
+|}]
+;;

unikernel/duniverse/dune_/test/expect-tests/dune_file_watcher/dune

@@ -0,0 +1,68 @@
+(library
+ (name dune_file_watcher_tests_lib)
+ (modules dune_file_watcher_tests_lib)
+ (libraries dune_file_watcher base stdune threads.posix stdio spawn unix))
+
+(library
+ (name dune_file_watcher_tests_macos)
+ (modules dune_file_watcher_tests_macos)
+ (inline_tests
+  (enabled_if
+   (and
+    (<> %{env:CI=false} true) ;; in github action, CI=true
+    (= %{system} macosx)))
+  (deps
+   (sandbox always)))
+ (libraries
+  unix
+  dune_file_watcher
+  dune_file_watcher_tests_lib
+  ppx_expect.config
+  ppx_expect.config_types
+  base
+  stdune
+  ppx_inline_test.config
+  threads.posix
+  stdio
+  spawn)
+ (preprocess
+  (pps ppx_expect)))
+
+(library
+ (name dune_file_watcher_tests_linux)
+ (modules dune_file_watcher_tests_linux)
+ (inline_tests
+  (enabled_if
+   (= %{system} linux))
+  (deps
+   (sandbox always)))
+ (libraries
+  dune_file_watcher
+  dune_file_watcher_tests_lib
+  ppx_expect.config
+  ppx_expect.config_types
+  base
+  stdune
+  ppx_inline_test.config
+  threads.posix
+  stdio
+  spawn
+  unix)
+ (preprocess
+  (pps ppx_expect)))
+
+(library
+ (name dune_file_watcher_tests_patterns)
+ (modules dune_file_watcher_tests_patterns)
+ (inline_tests
+  (deps
+   (sandbox always)))
+ (libraries
+  base
+  dune_config_file
+  dune_file_watcher
+  ppx_expect.config
+  ppx_expect.config_types
+  ppx_inline_test.config)
+ (preprocess
+  (pps ppx_expect)))

unikernel/duniverse/dune_/test/expect-tests/dune_file_watcher/dune_file_watcher_tests_lib.ml

@@ -0,0 +1,85 @@
+let printf = Printf.printf
+
+open Base
+open Stdune
+
+let critical_section mutex ~f =
+  (* Since 5.0, using "Mutex" with Base open rings an alert and suggests
+     we use "Stdlib.Mutex" instead.
+     Prior to OCaml 5.0, "Stdlib.Mutex" didn't exist, it was just "Mutex".
+     Since 5.1 there is Stdlib.Mutex.protect which replaces this function.
+  *)
+  let module Mutex = Mutex [@alert "-deprecated"] in
+  Mutex.lock mutex;
+  Exn.protect ~f ~finally:(fun () -> Mutex.unlock mutex)
+;;
+
+let init () =
+  let tmp_dir = Stdlib.Filename.concat (Unix.getcwd ()) "working-dir" in
+  let () =
+    try Unix.mkdir tmp_dir 0o777 with
+    | _ -> ()
+  in
+  Unix.chdir tmp_dir;
+  Path.set_root (Path.External.of_string tmp_dir);
+  Path.Build.set_build_dir (Path.Outside_build_dir.of_string "_build")
+;;
+
+let now () = Unix.gettimeofday ()
+
+let retry_loop (type a) ~period ~timeout ~(f : unit -> a option) : a option =
+  let t0 = now () in
+  let rec loop () =
+    match f () with
+    | Some res -> Some res
+    | None ->
+      let t1 = now () in
+      if Base.Float.( < ) (t1 -. t0) timeout
+      then (
+        Thread.delay period;
+        loop ())
+      else None
+  in
+  loop ()
+;;
+
+let get_events ~try_to_get_events ~expected =
+  let collected = ref [] in
+  let done_collecting =
+    match expected with
+    | 0 -> Some `Enough
+    | n ->
+      assert (n > 0);
+      retry_loop ~period:0.01 ~timeout:3.0 ~f:(fun () ->
+        let open Option.O in
+        let* events = try_to_get_events () in
+        collected := !collected @ events;
+        if List.length !collected >= expected then Some `Enough else None)
+  in
+  match done_collecting with
+  | None -> !collected, `Not_enough
+  | Some `Enough ->
+    Thread.delay 0.02;
+    (match try_to_get_events () with
+     | Some events -> collected := !collected @ events
+     | None -> ());
+    !collected, if List.length !collected > expected then `Too_many else `Ok
+;;
+
+let print_events ~try_to_get_events ~expected =
+  let events, status = get_events ~try_to_get_events ~expected in
+  List.iter events ~f:(fun event ->
+    Dune_file_watcher.Fs_memo_event.to_dyn event |> Dyn.to_string |> Stdio.print_endline);
+  match status with
+  | `Ok -> ()
+  | `Not_enough ->
+    printf
+      "Timed out waiting for more events: expected %d, saw %d\n"
+      expected
+      (List.length events)
+  | `Too_many ->
+    printf
+      "Got more events than expected: expected %d, saw %d\n"
+      expected
+      (List.length events)
+;;

unikernel/duniverse/dune_/test/expect-tests/dune_file_watcher/dune_file_watcher_tests_lib.mli

@@ -0,0 +1,7 @@
+val critical_section : Mutex.t -> f:(unit -> 'a) -> 'a
+val init : unit -> unit
+
+val print_events
+  :  try_to_get_events:(unit -> Dune_file_watcher.Fs_memo_event.t list option)
+  -> expected:int
+  -> unit

unikernel/duniverse/dune_/test/expect-tests/dune_file_watcher/dune_file_watcher_tests_linux.ml

@@ -0,0 +1,74 @@
+open Stdune
+open Dune_file_watcher_tests_lib
+
+let%expect_test _ = init ()
+
+let%expect_test _ =
+  let mutex = Mutex.create () in
+  let events_buffer = ref [] in
+  let watcher =
+    Dune_file_watcher.create_default
+      ~scheduler:
+        { spawn_thread = (fun f -> ignore (Thread.create f () : Thread.t))
+        ; thread_safe_send_emit_events_job =
+            (fun job ->
+              critical_section mutex ~f:(fun () ->
+                let events = job () in
+                events_buffer := !events_buffer @ events))
+        }
+      ~watch_exclusions:[]
+      ()
+  in
+  let try_to_get_events () =
+    critical_section mutex ~f:(fun () ->
+      match !events_buffer with
+      | [] -> None
+      | list ->
+        events_buffer := [];
+        Some
+          (List.map list ~f:(function
+             | Dune_file_watcher.Event.Sync _ -> assert false
+             | Queue_overflow -> assert false
+             | Fs_memo_event e -> e
+             | Watcher_terminated -> assert false)))
+  in
+  let print_events n = print_events ~try_to_get_events ~expected:n in
+  (match Dune_file_watcher.add_watch watcher (Path.of_string ".") with
+   | Error _ -> assert false
+   | Ok () -> ());
+  Dune_file_watcher.wait_for_initial_watches_established_blocking watcher;
+  Stdio.Out_channel.write_all "x" ~data:"x";
+  print_events 2;
+  [%expect
+    {|
+{ path = In_source_tree "x"; kind = "Created" }
+{ path = In_source_tree "x"; kind = "File_changed" }
+|}];
+  (* CR-someday aalekseyev: renaming is not detected *)
+  Unix.rename "x" "y";
+  print_events 2;
+  [%expect
+    {|
+    { path = In_source_tree "x"; kind = "Deleted" }
+    { path = In_source_tree "y"; kind = "Created" }
+|}];
+  let (_ : _) = Fpath.mkdir_p "d/w" in
+  (match Dune_file_watcher.add_watch watcher (Path.of_string "d/w") with
+   | Error _ -> assert false
+   | Ok () -> ());
+  Stdio.Out_channel.write_all "d/w/x" ~data:"x";
+  print_events 3;
+  [%expect
+    {|
+    { path = In_source_tree "d"; kind = "Created" }
+    { path = In_source_tree "d/w/x"; kind = "Created" }
+    { path = In_source_tree "d/w/x"; kind = "File_changed" }
+|}];
+  Stdio.Out_channel.write_all "d/w/y" ~data:"y";
+  print_events 2;
+  [%expect
+    {|
+  { path = In_source_tree "d/w/y"; kind = "Created" }
+  { path = In_source_tree "d/w/y"; kind = "File_changed" }
+|}]
+;;

unikernel/duniverse/dune_/test/expect-tests/dune_file_watcher/dune_file_watcher_tests_macos.ml

@@ -0,0 +1,62 @@
+open Stdune
+open Dune_file_watcher_tests_lib
+
+let%expect_test _ = init ()
+
+let%expect_test _ =
+  let mutex = Mutex.create () in
+  let events_buffer = ref [] in
+  let watcher =
+    Dune_file_watcher.create_default
+      ~fsevents_debounce:0.
+      ~scheduler:
+        { spawn_thread = (fun f -> ignore (Thread.create f () : Thread.t))
+        ; thread_safe_send_emit_events_job =
+            (fun job ->
+              critical_section mutex ~f:(fun () ->
+                let events = job () in
+                events_buffer := !events_buffer @ events))
+        }
+      ~watch_exclusions:[]
+      ()
+  in
+  let try_to_get_events () =
+    critical_section mutex ~f:(fun () ->
+      match !events_buffer with
+      | [] -> None
+      | list ->
+        events_buffer := [];
+        Some
+          (List.filter_map list ~f:(function
+             | Dune_file_watcher.Event.Sync _ -> None
+             | Queue_overflow -> assert false
+             | Fs_memo_event e -> Some e
+             | Watcher_terminated -> assert false)))
+  in
+  let print_events n = print_events ~try_to_get_events ~expected:n in
+  Dune_file_watcher.wait_for_initial_watches_established_blocking watcher;
+  Stdio.Out_channel.write_all "x" ~data:"x";
+  print_events 3;
+  [%expect
+    {|
+    { path = In_source_tree "."; kind = "Created" }
+    { path = In_build_dir "."; kind = "Created" }
+    { path = In_source_tree "x"; kind = "Unknown" } |}];
+  Unix.rename "x" "y";
+  print_events 2;
+  [%expect
+    {|
+    { path = In_source_tree "x"; kind = "Unknown" }
+    { path = In_source_tree "y"; kind = "Unknown" } |}];
+  let (_ : _) = Fpath.mkdir_p "d/w" in
+  Stdio.Out_channel.write_all "d/w/x" ~data:"x";
+  print_events 3;
+  [%expect
+    {|
+    { path = In_source_tree "d"; kind = "Created" }
+    { path = In_source_tree "d/w"; kind = "Created" }
+    { path = In_source_tree "d/w/x"; kind = "Unknown" } |}];
+  Stdio.Out_channel.write_all "d/w/y" ~data:"y";
+  print_events 1;
+  [%expect {| { path = In_source_tree "d/w/y"; kind = "Unknown" } |}]
+;;

unikernel/duniverse/dune_/test/expect-tests/dune_file_watcher/dune_file_watcher_tests_patterns.ml

@@ -0,0 +1,48 @@
+let printf = Printf.printf
+
+let test string =
+  printf
+    "should_exclude(%s) = %b\n"
+    string
+    (Dune_file_watcher.For_tests.should_exclude
+       string
+       ~watch_exclusions:Dune_config_file.Dune_config.standard_watch_exclusions)
+;;
+
+let%expect_test _ =
+  test "file.ml";
+  test "dir/file.ml";
+  test "4913";
+  test "dir/4913";
+  test "4913.ml";
+  test "84913";
+  test "_opam";
+  test "dir/_opam";
+  test "this_is_not_opam";
+  test "#file#";
+  test "dir/#file#";
+  test "dir/#subdir#/file";
+  test ".#file";
+  test ".#foobar.ml";
+  test "dir/.#file";
+  test "dir/.#subdir/file";
+  [%expect
+    {|
+    should_exclude(file.ml) = false
+    should_exclude(dir/file.ml) = false
+    should_exclude(4913) = true
+    should_exclude(dir/4913) = true
+    should_exclude(4913.ml) = false
+    should_exclude(84913) = false
+    should_exclude(_opam) = true
+    should_exclude(dir/_opam) = true
+    should_exclude(this_is_not_opam) = false
+    should_exclude(#file#) = true
+    should_exclude(dir/#file#) = true
+    should_exclude(dir/#subdir#/file) = false
+    should_exclude(.#file) = true
+    should_exclude(.#foobar.ml) = true
+    should_exclude(dir/.#file) = true
+    should_exclude(dir/.#subdir/file) = true
+  |}]
+;;

unikernel/duniverse/dune_/test/expect-tests/dune_lang/dune

@@ -0,0 +1,15 @@
+(library
+ (name dune_lang_unit_tests)
+ (inline_tests)
+ (libraries
+  dune_tests_common
+  stdune
+  dune_lang
+  ;; This is because of the (implicit_transitive_deps false)
+  ;; in dune-project
+  ppx_expect.config
+  ppx_expect.config_types
+  base
+  ppx_inline_test.config)
+ (preprocess
+  (pps ppx_expect)))

unikernel/duniverse/dune_/test/expect-tests/dune_lang/sexp_tests.ml

@@ -0,0 +1,423 @@
+open! Stdune
+open Dune_lang.Decoder
+open Dune_tests_common
+
+let () = init ()
+let print_loc ppf (_ : Loc.t) = Format.pp_print_string ppf "<loc>"
+
+let sexp =
+  lazy
+    (Dune_lang.Parser.parse_string
+       ~fname:""
+       ~mode:Single
+       {|
+((foo 1)
+ (foo 2))
+|})
+;;
+
+let print_ast ast =
+  let no_loc = Dune_lang.Ast.remove_locs ast in
+  print (Dune_lang.pp no_loc)
+;;
+
+let%expect_test _ =
+  Lazy.force sexp |> print_ast;
+  [%expect
+    {|
+((foo 1) (foo 2))
+|}]
+;;
+
+let of_sexp =
+  let open Dune_lang.Decoder in
+  enter (fields (field "foo" int))
+;;
+
+let%expect_test _ =
+  (try ignore (parse of_sexp Univ_map.empty (Lazy.force sexp) : int) with
+   | User_error.E msg -> User_message.print { msg with loc = None });
+  [%expect
+    {|
+Error: Field "foo" is present too many times
+|}]
+;;
+
+let of_sexp : int list t = enter (fields (multi_field "foo" int))
+
+let%expect_test _ =
+  parse of_sexp Univ_map.empty (Lazy.force sexp) |> Dyn.(list int) |> print_dyn;
+  [%expect
+    {|
+[ 1; 2 ]
+|}]
+;;
+
+let string_of_user_error (msg : User_message.t) =
+  Format.asprintf "%a" Pp.to_fmt (User_message.pp { msg with loc = None })
+  |> String.drop_prefix ~prefix:"Error: "
+  |> Option.value_exn
+  |> String.trim
+;;
+
+let parse s =
+  let res =
+    try
+      Ok
+        (Dune_lang.Parser.parse_string ~fname:"" ~mode:Many s
+         |> List.map ~f:Dune_lang.Ast.remove_locs)
+    with
+    | User_error.E msg -> Error (string_of_user_error msg)
+    | e -> Error (Printexc.to_string e)
+  in
+  print_dyn (Result.to_dyn (Dyn.list Dune_lang.to_dyn) Dyn.string res)
+;;
+
+let%expect_test _ =
+  parse {| # ## x##y x||y a#b|c#d copy# |};
+  [%expect
+    {|
+Ok [ "#"; "##"; "x##y"; "x||y"; "a#b|c#d"; "copy#" ]
+|}]
+;;
+
+let%expect_test _ =
+  parse {|x #| comment |# y|};
+  [%expect
+    {|
+Ok [ "x"; "#|"; "comment"; "|#"; "y" ]
+|}]
+;;
+
+let%expect_test _ =
+  parse {|x#|y|};
+  [%expect
+    {|
+Ok [ "x#|y" ]
+|}]
+;;
+
+let%expect_test _ =
+  parse {|x|#y|};
+  [%expect
+    {|
+Ok [ "x|#y" ]
+|}]
+;;
+
+let%expect_test _ =
+  parse {|"\a"|};
+  [%expect
+    {|
+Error "unknown escape sequence"
+|}]
+;;
+
+let%expect_test _ =
+  parse {|"\%{x}"|};
+  [%expect
+    {|
+Ok [ "%{x}" ]
+|}]
+;;
+
+let%expect_test _ =
+  parse {|"$foo"|};
+  [%expect
+    {|
+Ok [ "$foo" ]
+|}]
+;;
+
+let%expect_test _ =
+  parse {|"%foo"|};
+  [%expect
+    {|
+Ok [ "%foo" ]
+|}]
+;;
+
+let%expect_test _ =
+  parse {|"bar%foo"|};
+  [%expect
+    {|
+Ok [ "bar%foo" ]
+|}]
+;;
+
+let%expect_test _ =
+  parse {|"bar$foo"|};
+  [%expect
+    {|
+Ok [ "bar$foo" ]
+|}]
+;;
+
+let%expect_test _ =
+  parse {|"%bar$foo%"|};
+  [%expect
+    {|
+Ok [ "%bar$foo%" ]
+|}]
+;;
+
+let%expect_test _ =
+  parse {|"$bar%foo%"|};
+  [%expect
+    {|
+Ok [ "$bar%foo%" ]
+|}]
+;;
+
+let%expect_test _ =
+  parse {|\${foo}|};
+  [%expect
+    {|
+Ok [ "\\${foo}" ]
+|}]
+;;
+
+let%expect_test _ =
+  parse {|\%{foo}|};
+  [%expect
+    {|
+Ok [ template "\\%{foo}" ]
+|}]
+;;
+
+let%expect_test _ =
+  parse {|\$bar%foo%|};
+  [%expect
+    {|
+Ok [ "\\$bar%foo%" ]
+|}]
+;;
+
+let%expect_test _ =
+  parse {|\$bar\%foo%|};
+  [%expect
+    {|
+Ok [ "\\$bar\\%foo%" ]
+|}]
+;;
+
+let%expect_test _ =
+  parse {|\$bar\%foo%{bar}|};
+  [%expect
+    {|
+Ok [ template "\\$bar\\%foo%{bar}" ]
+|}]
+;;
+
+let%expect_test _ =
+  parse {|"bar%{foo}"|};
+  [%expect
+    {|
+Ok [ template "\"bar%{foo}\"" ]
+|}]
+;;
+
+let%expect_test _ =
+  parse {|"bar\%{foo}"|};
+  [%expect
+    {|
+Ok [ "bar%{foo}" ]
+|}]
+;;
+
+let%expect_test _ =
+  parse {|bar%{foo}|};
+  [%expect
+    {|
+Ok [ template "bar%{foo}" ]
+|}]
+;;
+
+let%expect_test _ =
+  parse {|"bar%{foo}"|};
+  [%expect
+    {|
+Ok [ template "\"bar%{foo}\"" ]
+|}]
+;;
+
+let%expect_test _ =
+  parse {|"bar\%foo"|};
+  [%expect
+    {|
+Ok [ "bar%foo" ]
+|}]
+;;
+
+let%expect_test _ =
+  parse {|"\0000"|};
+  [%expect
+    {|
+Ok [ "\0000" ]
+|}]
+;;
+
+let%expect_test _ =
+  parse {|"\x000"|};
+  [%expect
+    {|
+Ok [ "\0000" ]
+|}]
+;;
+
+(* Printing tests *)
+
+let loc = Loc.none
+let a = Dune_lang.atom
+let s x = Dune_lang.Quoted_string x
+let t x = Dune_lang.Template { quoted = false; parts = x; loc }
+let tq x = Dune_lang.Template { quoted = true; parts = x; loc }
+let l x = Dune_lang.List x
+let var ?payload name = { Dune_lang.Template.Pform.loc; name; payload }
+
+type syntax =
+  | Dune
+  | Jbuild
+
+type sexp = S of syntax * Dune_lang.t
+
+let dyn_of_sexp (S (syntax, dlang)) =
+  let open Dyn in
+  variant
+    "S"
+    [ Dyn.pair
+        (function
+          | Dune -> Variant ("Dune", [])
+          | Jbuild -> Variant ("Jbuild", []))
+        Dune_lang.to_dyn
+        (syntax, dlang)
+    ]
+;;
+
+type round_trip_result =
+  | Round_trip_success
+  | Did_not_round_trip of Dune_lang.t
+  | Did_not_parse_back of string
+
+let dyn_of_round_trip_result =
+  let open Dyn in
+  function
+  | Round_trip_success -> variant "Round_trip_success" []
+  | Did_not_round_trip s -> variant "Did_not_round_trip" [ Dune_lang.to_dyn s ]
+  | Did_not_parse_back s -> variant "Did_not_parse_back" [ string s ]
+;;
+
+let test syntax sexp =
+  let res =
+    ( S (syntax, sexp)
+    , let s = Format.asprintf "%a" (fun ppf x -> Pp.to_fmt ppf (Dune_lang.pp x)) sexp in
+      match Dune_lang.Parser.parse_string s ~mode:Single ~fname:"" with
+      | sexp' ->
+        let sexp' = Dune_lang.Ast.remove_locs sexp' in
+        if sexp = sexp' then Round_trip_success else Did_not_round_trip sexp'
+      | exception User_error.E msg -> Did_not_parse_back (string_of_user_error msg) )
+  in
+  let open Dyn in
+  pair dyn_of_sexp dyn_of_round_trip_result res |> print_dyn
+;;
+
+let%expect_test _ =
+  test Dune (a "toto");
+  [%expect
+    {|
+(S (Dune, "toto"), Round_trip_success)
+|}]
+;;
+
+let%expect_test _ =
+  test Dune (t [ Text "x%{" ]);
+  [%expect.unreachable]
+[@@expect.uncaught_exn
+  {|
+  ( "({ pos_fname = \"<none>\"\
+   \n ; start = { pos_lnum = 1; pos_bol = 0; pos_cnum = 0 }\
+   \n ; stop = { pos_lnum = 1; pos_bol = 0; pos_cnum = 0 }\
+   \n },\
+   \n \"Invalid text in unquoted template\",\
+   \n { s = \"x%{\" })") |}]
+;;
+
+let%expect_test _ =
+  test Dune (t [ Text "x%"; Text "{" ]);
+  [%expect.unreachable]
+[@@expect.uncaught_exn
+  {|
+  ( "({ pos_fname = \"<none>\"\
+   \n ; start = { pos_lnum = 1; pos_bol = 0; pos_cnum = 0 }\
+   \n ; stop = { pos_lnum = 1; pos_bol = 0; pos_cnum = 0 }\
+   \n },\
+   \n \"Invalid text in unquoted template\",\
+   \n { s = \"x%{\" })") |}]
+;;
+
+let%expect_test _ =
+  (* This round trip failure is expected *)
+  test Dune (tq [ Text "x%{" ]);
+  [%expect
+    {|
+(S (Dune, template "\"x\\%{\""), Did_not_round_trip "x%{")
+|}]
+;;
+
+let%expect_test _ =
+  test Dune (tq [ Text "x%"; Text "{" ]);
+  [%expect
+    {|
+(S (Dune, template "\"x\\%{\""), Did_not_round_trip "x%{")
+|}]
+;;
+
+let%expect_test _ =
+  (* Check parsing of comments *)
+  Dune_lang.Parser.parse
+    ~mode:Cst
+    (Lexing.from_string
+       {|
+hello
+; comment
+world
+
+; multiline
+; comment
+
+(x ; comment inside list
+ y)
+|})
+  |> Dyn.list Dune_lang.Cst.to_dyn
+  |> print_dyn;
+  [%expect
+    {|
+[ Atom (A "hello")
+; Comment [ " comment" ]
+; Atom (A "world")
+; Comment [ " multiline"; " comment" ]
+; List [ Atom (A "x"); Comment [ " comment inside list" ]; Atom (A "y") ]
+]
+|}]
+;;
+
+let jbuild_file =
+  {|
+hello
+; comment
+world
+
+; multiline
+; comment
+
+(x ; comment inside list
+ y)
+
+#; (sexp
+comment)
+
+#|old style
+block
+comment|#
+|}
+;;

unikernel/duniverse/dune_/test/expect-tests/dune_patch/dune

@@ -0,0 +1,20 @@
+(library
+ (name dune_patch_tests)
+ (inline_tests)
+ (modules dune_patch_tests)
+ (libraries
+  dune_tests_common
+  stdune
+  fiber
+  dune_patch
+  dune_engine
+  dune_util
+  test_scheduler
+  ;; This is because of the (implicit_transitive_deps false)
+  ;; in dune-project
+  base
+  ppx_expect.config
+  ppx_expect.config_types
+  ppx_inline_test.config)
+ (preprocess
+  (pps ppx_expect)))

unikernel/duniverse/dune_/test/expect-tests/dune_patch/dune_patch_tests.ml

@@ -0,0 +1,283 @@
+open Stdune
+
+let () = Dune_tests_common.init ()
+
+(* Basic example adding and removing a line. *)
+let basic =
+  {|
+diff --git a/foo.ml b/foo.ml
+index b69a69a5a..ea988f6bd 100644
+--- a/foo.ml
++++ b/foo.ml
+@@ -1,1 +1,1 @@
+-This is wrong
++This is right
+|}
+;;
+
+(* Example adding and removing a line in a file in a subdirectory. *)
+let subdirectory =
+  {|
+diff --git a/dir/foo.ml b/dir/foo.ml
+index b69a69a5a..ea988f6bd 100644
+--- a/dir/foo.ml
++++ b/dir/foo.ml
+@@ -1,1 +1,1 @@
+-This is wrong
++This is right
+|}
+;;
+
+(* Previous two example combined into a single patch. *)
+let combined = String.concat ~sep:"\n" [ basic; subdirectory ]
+
+(* Example adding a new file. *)
+let new_file =
+  {|
+diff --git a/foo.ml b/foo.ml
+new file mode 100644
+index 000000000..ea988f6bd
+--- /dev/null
++++ b/foo.ml
+@@ -0,0 +1,2 @@
++This is right
++
+|}
+;;
+
+(* Example deleting an existing file. *)
+let delete_file =
+  {|
+diff --git a/foo.ml b/foo.ml
+deleted file mode 100644
+index ea988f6bd..000000000
+--- a/foo.ml
++++ /dev/null
+@@ -1,1 +0,0 @@
+-This is wrong
+|}
+;;
+
+(* Use GNU diff 'unified' format instead of 'git diff' *)
+let unified =
+  {|
+diff -u a/foo.ml b/foo.ml
+--- a/foo.ml	2024-08-29 17:37:53.114980665 +0200
++++ b/foo.ml	2024-08-29 17:38:00.243088256 +0200
+@@ -1 +1 @@
+-This is wrong
++This is right
+|}
+;;
+
+let no_prefix =
+  {|
+--- foo.ml	2024-08-29 17:37:53.114980665 +0200
++++ foo.ml	2024-08-29 17:38:00.243088256 +0200
+@@ -1 +1 @@
+-This is wrong
++This is right
+|}
+;;
+
+let random_prefix =
+  {|
+diff -u bar/foo.ml baz/foo.ml
+--- bar/foo.ml	2024-08-29 17:37:53.114980665 +0200
++++ baz/foo.ml	2024-08-29 17:38:00.243088256 +0200
+@@ -1 +1 @@
+-This is wrong
++This is right
+|}
+;;
+
+(* The file is called "foo bar" *)
+let spaces =
+  {|
+diff --git a/foo bar b/foo bar
+index ef00db3..88adca3 100644
+--- a/foo bar   
++++ b/foo bar   
+@@ -1 +1 @@
+-This is wrong.
++This is right.
+|}
+;;
+
+(* The file is called "foo bar" but in unified diff its quoted *)
+let unified_spaces =
+  {|
+--- "a/foo bar"	2024-09-04 10:56:24.139293679 +0200
++++ "b/foo bar"	2024-09-04 10:56:12.519195763 +0200
+@@ -1 +1 @@
+-This is wrong.
++This is right.
+|}
+;;
+
+(* Testing the patch action *)
+
+include struct
+  open Dune_engine
+  module Action = Action
+  module Display = Display
+  module Process = Process
+  module Scheduler = Scheduler
+end
+
+let create_files =
+  List.iter ~f:(fun (f, contents) ->
+    ignore
+      (Fpath.mkdir_p
+         (Path.Local.of_string f
+          |> Path.Local.parent
+          |> Option.value ~default:(Path.Local.of_string ".")
+          |> Path.Local.to_string));
+    Io.String_path.write_file f contents)
+;;
+
+let test files (patch, patch_contents) =
+  let dir = Temp.create Dir ~prefix:"dune" ~suffix:"patch_test" in
+  let display = Display.Quiet in
+  Sys.chdir (Path.to_string dir);
+  let patch_file = Path.append_local dir (Path.Local.of_string patch) in
+  let config =
+    { Scheduler.Config.concurrency = 1
+    ; stats = None
+    ; print_ctrl_c_warning = false
+    ; watch_exclusions = []
+    }
+  in
+  Scheduler.Run.go
+    config
+    ~timeout_seconds:5.0
+    ~file_watcher:No_watcher
+    ~on_event:(fun _ _ -> ())
+  @@ fun () ->
+  let open Fiber.O in
+  let* () = Fiber.return @@ create_files ((patch, patch_contents) :: files) in
+  Dune_patch.For_tests.exec display ~patch:patch_file ~dir ~stderr:Process.Io.stderr
+;;
+
+let check path =
+  match (Unix.stat path).st_kind with
+  | S_REG -> Io.String_path.cat path
+  | _ -> failwith "Not a regular file"
+  | exception Unix.Unix_error (Unix.ENOENT, _, _) -> printfn "File %s not found" path
+;;
+
+let%expect_test "patching a file" =
+  test [ "foo.ml", "This is wrong\n" ] ("foo.patch", basic);
+  check "foo.ml";
+  [%expect
+    {|
+    This is right |}]
+;;
+
+let%expect_test "patching a file in a subdirectory" =
+  test [ "dir/foo.ml", "This is wrong\n" ] ("foo.patch", subdirectory);
+  check "dir/foo.ml";
+  [%expect
+    {|
+    This is right |}]
+;;
+
+let%expect_test "patching two files with a single patch" =
+  test
+    [ "foo.ml", "This is wrong\n"; "dir/foo.ml", "This is wrong\n" ]
+    ("foo.patch", combined);
+  check "foo.ml";
+  [%expect
+    {|
+    This is right |}]
+;;
+
+let%expect_test "patching a new file" =
+  test [] ("foo.patch", new_file);
+  check "foo.ml";
+  [%expect
+    {|
+    This is right |}]
+;;
+
+let () = Dune_util.Report_error.report_backtraces true
+
+let%expect_test "patching a deleted file" =
+  let filename = "foo.ml" in
+  test [ filename, "This is wrong\n" ] ("foo.patch", delete_file);
+  (* Different implementations of the patch command behave differently when the
+     patch specifies deleting a file: *)
+  match Unix.stat filename with
+  | { st_kind = S_REG; st_size; _ } ->
+    (* Some implementations of patch (e.g. the patch that ships with macOS
+       15.1) do not delete files, and instead truncate them to 0 length. If
+       the file still exists after applying the patch, assert that it is now
+       empty. *)
+    assert (st_size == 0)
+  | _ -> failwith "Not a regular file"
+  | exception Unix.Unix_error (Unix.ENOENT, _, _) ->
+    (* Most implementations of patch will delete the file. *)
+    ()
+;;
+
+let undo_breaks =
+  String.map ~f:(function
+    | '\n' -> ' '
+    | c -> c)
+;;
+
+let rsplit2_exn s ~on =
+  match String.rsplit2 s ~on with
+  | Some s -> s
+  | None -> Code_error.raise "rsplit2_exn" [ "s", String s; "on", Char on ]
+;;
+
+let normalize_error_path s =
+  let s = undo_breaks s in
+  let location, reason = rsplit2_exn s ~on:':' in
+  let prefix, path = String.lsplit2_exn location ~on:' ' in
+  let path = Filename.basename path in
+  sprintf "%s %s:%s" prefix path reason
+;;
+
+let%expect_test "Using a patch from 'diff' with a timestamp" =
+  test [ "foo.ml", "This is wrong\n" ] ("foo.patch", unified);
+  check "foo.ml";
+  [%expect
+    {|
+    This is right |}]
+;;
+
+let%expect_test "patching a file without prefix" =
+  test [ "foo.ml", "This is wrong\n" ] ("foo.patch", no_prefix);
+  check "foo.ml";
+  [%expect {| This is right |}]
+;;
+
+let%expect_test "patching files with freestyle prefix" =
+  test [ "foo.ml", "This is wrong\n" ] ("foo.patch", random_prefix);
+  check "foo.ml";
+  [%expect {| This is right |}]
+;;
+
+let%expect_test "patching files with spaces" =
+  try
+    test [ "foo bar", "This is wrong\n" ] ("foo.patch", spaces);
+    check "foo bar";
+    [%expect.unreachable]
+  with
+  | Dune_util.Report_error.Already_reported ->
+    print_endline @@ normalize_error_path [%expect.output];
+    [%expect {| Error: foo: No such file or directory |}]
+;;
+
+let%expect_test "patching files with (unified) spaces" =
+  try
+    test [ "foo bar", "This is wrong\n" ] ("foo.patch", unified_spaces);
+    check "foo bar";
+    [%expect.unreachable]
+  with
+  | Dune_util.Report_error.Already_reported ->
+    print_endline @@ normalize_error_path [%expect.output];
+    [%expect {| Error: foo: No such file or directory |}]
+;;

unikernel/duniverse/dune_/test/expect-tests/dune_pkg/dune

@@ -0,0 +1,37 @@
+(library
+ (name dune_pkg_unit_tests)
+ (inline_tests
+  (deps tar-inputs/plaintext.md tarball.tar.gz %{bin:git} %{bin:curl}))
+ (libraries
+  dune_tests_common
+  stdune
+  dune_pkg
+  dune_engine
+  dune_util
+  dune_lang
+  dune_vcs
+  fiber
+  http
+  opam_core
+  threads.posix
+  unix
+  base
+  ;; This is because of the (implicit_transitive_deps false)
+  ;; in dune-project
+  ppx_expect.config
+  ppx_expect.config_types
+  ppx_inline_test.config)
+ (preprocess
+  (pps ppx_expect)))
+
+(rule
+ (target tarball.tar.gz)
+ (deps
+  (source_tree tar-inputs))
+ (action
+  (run tar -czf %{target} %{deps})))
+
+(alias
+ (name pkg)
+ (deps
+  (alias runtest)))

unikernel/duniverse/dune_/test/expect-tests/dune_pkg/dune_pkg_unit_tests.ml

@@ -0,0 +1,566 @@
+open Stdune
+module Checksum = Dune_pkg.Checksum
+module Lock_dir = Dune_pkg.Lock_dir
+module Dependency = Dune_pkg.Lock_dir.Dependency
+module Opam_repo = Dune_pkg.Opam_repo
+module Expanded_variable_bindings = Dune_pkg.Solver_stats.Expanded_variable_bindings
+module Package_variable_name = Dune_lang.Package_variable_name
+module Variable_value = Dune_pkg.Variable_value
+module Rev_store = Dune_pkg.Rev_store
+module Package_version = Dune_pkg.Package_version
+module Source = Dune_pkg.Source
+module Package_name = Dune_lang.Package_name
+module Scheduler = Dune_engine.Scheduler
+
+let () = Dune_tests_common.init ()
+
+module Update = struct
+  open Dyn
+
+  let update_source ~commit = function
+    | String url as v ->
+      let opam_url = OpamUrl.parse url in
+      (match Option.equal String.equal opam_url.hash (Some commit) with
+       | false -> v
+       | true ->
+         let opam_url = { opam_url with hash = Some "MATCHES_EXPECTED" } in
+         String (OpamUrl.to_string opam_url))
+    | otherwise -> otherwise
+  ;;
+
+  let update_used ~commit = function
+    | Option (Some (List xs)) ->
+      let xs =
+        List.map xs ~f:(function
+          | Variant (("opam_repo_serializable" as u), [ source ]) ->
+            let source = update_source ~commit source in
+            Variant (u, [ source ])
+          | otherwise -> otherwise)
+      in
+      Option (Some (List xs))
+    | otherwise -> otherwise
+  ;;
+
+  let update_repositories ~commit = function
+    | Record xs ->
+      let xs =
+        List.map xs ~f:(function
+          | ("used" as u), dyn -> u, update_used ~commit dyn
+          | otherwise -> otherwise)
+      in
+      Record xs
+    | otherwise -> otherwise
+  ;;
+
+  let update_lock_dir_dyn ~commit = function
+    | Record xs ->
+      let xs =
+        List.map xs ~f:(function
+          | ("repos" as u), dyn -> u, update_repositories ~commit dyn
+          | otherwise -> otherwise)
+      in
+      Record xs
+    | otherwise -> otherwise
+  ;;
+end
+
+let lock_dir_encode_decode_round_trip_test ?commit ~lock_dir_path ~lock_dir () =
+  let lock_dir_path = Path.Source.of_string lock_dir_path in
+  Lock_dir.Write_disk.(
+    prepare ~portable_lock_dir:false ~lock_dir_path ~files:Package_name.Map.empty lock_dir
+    |> commit);
+  let lock_dir_round_tripped =
+    try Lock_dir.read_disk_exn lock_dir_path with
+    | User_error.E _ as exn ->
+      let metadata_path =
+        Path.Source.relative lock_dir_path Lock_dir.metadata_filename |> Path.source
+      in
+      let metadata_file_contents = Io.read_file metadata_path in
+      print_endline
+        "Failed to parse lockdir. Dumping raw metadata file to assist debugging.";
+      print_endline metadata_file_contents;
+      Exn.raise exn
+  in
+  let lock_dir_round_tripped', lock_dir' =
+    Lock_dir.remove_locs lock_dir_round_tripped, Lock_dir.remove_locs lock_dir
+  in
+  if Lock_dir.equal lock_dir_round_tripped' lock_dir'
+  then print_endline "lockdir matches after roundtrip:"
+  else (
+    print_endline "lockdir doesn't match after roundtrip:";
+    print_endline (Lock_dir.to_dyn lock_dir |> Dyn.to_string));
+  let dyn_lock_dir = Lock_dir.to_dyn lock_dir_round_tripped in
+  let dyn_lock_dir =
+    match commit with
+    | None -> dyn_lock_dir
+    | Some commit -> Update.update_lock_dir_dyn ~commit dyn_lock_dir
+  in
+  print_endline (dyn_lock_dir |> Dyn.to_string)
+;;
+
+let run thunk =
+  let on_event _config _event = () in
+  let config : Scheduler.Config.t =
+    { concurrency = 1; stats = None; print_ctrl_c_warning = false; watch_exclusions = [] }
+  in
+  Scheduler.Run.go config ~on_event thunk
+;;
+
+let%expect_test "encode/decode round trip test for lockdir with no deps" =
+  lock_dir_encode_decode_round_trip_test
+    ~lock_dir_path:"empty_lock_dir"
+    ~lock_dir:
+      (Lock_dir.create_latest_version
+         Package_name.Map.empty
+         ~local_packages:[]
+         ~ocaml:None
+         ~repos:None
+         ~expanded_solver_variable_bindings:Expanded_variable_bindings.empty
+         ~solved_for_platform:None)
+    ();
+  [%expect
+    {|
+    lockdir matches after roundtrip:
+    { version = (0, 1)
+    ; dependency_hash = None
+    ; packages = map {}
+    ; ocaml = None
+    ; repos = { complete = true; used = None }
+    ; expanded_solver_variable_bindings =
+        { variable_values = []; unset_variables = [] }
+    ; solved_for_platforms = ("<none>:1", [])
+    }
+    |}]
+;;
+
+let empty_package name ~version =
+  { Lock_dir.Pkg.build_command = Lock_dir.Conditional_choice.empty
+  ; install_command = Lock_dir.Conditional_choice.empty
+  ; depends = Lock_dir.Conditional_choice.empty
+  ; depexts = []
+  ; info =
+      { Lock_dir.Pkg_info.name
+      ; version
+      ; dev = false
+      ; avoid = false
+      ; source = None
+      ; extra_sources = []
+      }
+  ; exported_env = []
+  ; enabled_on_platforms = []
+  }
+;;
+
+let%expect_test "encode/decode round trip test for lockdir with simple deps" =
+  lock_dir_encode_decode_round_trip_test
+    ~lock_dir_path:"simple_lock_dir"
+    ~lock_dir:
+      (let mk_pkg_basic ~name ~version =
+         let name = Package_name.of_string name in
+         name, empty_package name ~version
+       in
+       Lock_dir.create_latest_version
+         ~local_packages:[]
+         ~ocaml:(Some (Loc.none, Package_name.of_string "ocaml"))
+         ~repos:None
+         ~expanded_solver_variable_bindings:
+           { Expanded_variable_bindings.variable_values =
+               [ Package_variable_name.os, Variable_value.string "linux" ]
+           ; unset_variables = [ Package_variable_name.os_family ]
+           }
+         ~solved_for_platform:None
+         (Package_name.Map.of_list_exn
+            [ mk_pkg_basic ~name:"foo" ~version:(Package_version.of_string "0.1.0")
+            ; mk_pkg_basic ~name:"bar" ~version:(Package_version.of_string "0.2.0")
+            ]))
+    ();
+  [%expect
+    {|
+    lockdir matches after roundtrip:
+    { version = (0, 1)
+    ; dependency_hash = None
+    ; packages =
+        map
+          { "bar" :
+              map
+                { "0.2.0" :
+                    { build_command = []
+                    ; install_command = []
+                    ; depends = []
+                    ; depexts = []
+                    ; info =
+                        { name = "bar"
+                        ; version = "0.2.0"
+                        ; dev = false
+                        ; avoid = false
+                        ; source = None
+                        ; extra_sources = []
+                        }
+                    ; exported_env = []
+                    ; enabled_on_platforms = []
+                    }
+                }
+          ; "foo" :
+              map
+                { "0.1.0" :
+                    { build_command = []
+                    ; install_command = []
+                    ; depends = []
+                    ; depexts = []
+                    ; info =
+                        { name = "foo"
+                        ; version = "0.1.0"
+                        ; dev = false
+                        ; avoid = false
+                        ; source = None
+                        ; extra_sources = []
+                        }
+                    ; exported_env = []
+                    ; enabled_on_platforms = []
+                    }
+                }
+          }
+    ; ocaml = Some ("simple_lock_dir/lock.dune:3", "ocaml")
+    ; repos = { complete = true; used = None }
+    ; expanded_solver_variable_bindings =
+        { variable_values = [ ("os", "linux") ]
+        ; unset_variables = [ "os-family" ]
+        }
+    ; solved_for_platforms = ("<none>:1", [])
+    }
+    |}]
+;;
+
+let%expect_test "encode/decode round trip test for lockdir with complex deps" =
+  let module Action = Dune_lang.Action in
+  let module String_with_vars = Dune_lang.String_with_vars in
+  let make_conditional value =
+    Lock_dir.Conditional_choice.singleton Dune_pkg.Solver_env.empty value
+  in
+  let lock_dir =
+    let pkg_a =
+      let name = Package_name.of_string "a" in
+      let extra_source : Source.t =
+        Source.external_copy (Loc.none, Path.External.of_string "/tmp/a")
+      in
+      ( name
+      , let pkg = empty_package name ~version:(Package_version.of_string "0.1.0") in
+        { pkg with
+          build_command =
+            make_conditional
+              (Lock_dir.Build_command.Action
+                 Action.(Progn [ Echo [ String_with_vars.make_text Loc.none "hello" ] ]))
+        ; install_command =
+            make_conditional
+              (Action.System
+                 (* String_with_vars.t doesn't round trip so we have to set
+                    [quoted] if the string would be quoted *)
+                 (String_with_vars.make_text ~quoted:true Loc.none "echo 'world'"))
+        ; info =
+            { pkg.info with
+              dev = false
+            ; source = Some extra_source
+            ; extra_sources =
+                [ Path.Local.of_string "one", extra_source
+                ; ( Path.Local.of_string "two"
+                  , { url = Loc.none, OpamUrl.of_string "file://randomurl"
+                    ; checksum = None
+                    } )
+                ]
+            }
+        ; exported_env =
+            [ { Action.Env_update.op = Eq
+              ; var = "foo"
+              ; value = String_with_vars.make_text Loc.none "bar"
+              }
+            ]
+        } )
+    in
+    let pkg_b =
+      let name = Package_name.of_string "b" in
+      ( name
+      , let pkg = empty_package name ~version:(Package_version.of_string "dev") in
+        { pkg with
+          install_command = Lock_dir.Conditional_choice.empty
+        ; depends = make_conditional [ { Dependency.loc = Loc.none; name = fst pkg_a } ]
+        ; info =
+            { pkg.info with
+              dev = true
+            ; source =
+                Some
+                  { url = Loc.none, OpamUrl.of_string "https://github.com/foo/b"
+                  ; checksum =
+                      Some
+                        ( Loc.none
+                        , Checksum.of_string
+                            "sha256=adfc38f14c0188a2ad80d61451d011d27ab8839b717492d7ad42f7cb911c54c3"
+                        )
+                  }
+            }
+        } )
+    in
+    let pkg_c =
+      let name = Package_name.of_string "c" in
+      ( name
+      , let pkg = empty_package name ~version:(Package_version.of_string "0.2") in
+        { pkg with
+          depends =
+            make_conditional
+              [ { Dependency.loc = Loc.none; name = fst pkg_a }
+              ; { Dependency.loc = Loc.none; name = fst pkg_b }
+              ]
+        ; info =
+            { pkg.info with
+              dev = false
+            ; source =
+                Some
+                  { url = Loc.none, OpamUrl.of_string "https://github.com/foo/c"
+                  ; checksum = None
+                  }
+            }
+        } )
+    in
+    let opam_repo =
+      let source = Some "https://github.com/ocaml/dune" in
+      Opam_repo.Private.create ~source
+    in
+    Lock_dir.create_latest_version
+      ~local_packages:[]
+      ~ocaml:(Some (Loc.none, Package_name.of_string "ocaml"))
+      ~repos:(Some [ opam_repo ])
+      ~expanded_solver_variable_bindings:Expanded_variable_bindings.empty
+      ~solved_for_platform:None
+      (Package_name.Map.of_list_exn [ pkg_a; pkg_b; pkg_c ])
+  in
+  lock_dir_encode_decode_round_trip_test ~lock_dir_path:"complex_lock_dir" ~lock_dir ();
+  [%expect
+    {|
+    lockdir matches after roundtrip:
+    { version = (0, 1)
+    ; dependency_hash = None
+    ; packages =
+        map
+          { "a" :
+              map
+                { "0.1.0" :
+                    { build_command =
+                        [ { condition = [ map {} ]
+                          ; value = Action [ "progn"; [ "echo"; "hello" ] ]
+                          }
+                        ]
+                    ; install_command =
+                        [ { condition = [ map {} ]
+                          ; value = [ "system"; "echo 'world'" ]
+                          }
+                        ]
+                    ; depends = []
+                    ; depexts = []
+                    ; info =
+                        { name = "a"
+                        ; version = "0.1.0"
+                        ; dev = false
+                        ; avoid = false
+                        ; source =
+                            Some { url = "file:///tmp/a"; checksum = None }
+                        ; extra_sources =
+                            [ ("one", { url = "file:///tmp/a"; checksum = None })
+                            ; ("two",
+                               { url = "file://randomurl"; checksum = None })
+                            ]
+                        }
+                    ; exported_env = [ { op = "="; var = "foo"; value = "bar" } ]
+                    ; enabled_on_platforms = []
+                    }
+                }
+          ; "b" :
+              map
+                { "dev" :
+                    { build_command = []
+                    ; install_command = []
+                    ; depends =
+                        [ { condition = [ map {} ]
+                          ; value =
+                              [ { loc = "complex_lock_dir/b.pkg:3"; name = "a" }
+                              ]
+                          }
+                        ]
+                    ; depexts = []
+                    ; info =
+                        { name = "b"
+                        ; version = "dev"
+                        ; dev = true
+                        ; avoid = false
+                        ; source =
+                            Some
+                              { url = "https://github.com/foo/b"
+                              ; checksum =
+                                  Some
+                                    "sha256=adfc38f14c0188a2ad80d61451d011d27ab8839b717492d7ad42f7cb911c54c3"
+                              }
+                        ; extra_sources = []
+                        }
+                    ; exported_env = []
+                    ; enabled_on_platforms = []
+                    }
+                }
+          ; "c" :
+              map
+                { "0.2" :
+                    { build_command = []
+                    ; install_command = []
+                    ; depends =
+                        [ { condition = [ map {} ]
+                          ; value =
+                              [ { loc = "complex_lock_dir/c.pkg:3"; name = "a" }
+                              ; { loc = "complex_lock_dir/c.pkg:3"; name = "b" }
+                              ]
+                          }
+                        ]
+                    ; depexts = []
+                    ; info =
+                        { name = "c"
+                        ; version = "0.2"
+                        ; dev = false
+                        ; avoid = false
+                        ; source =
+                            Some
+                              { url = "https://github.com/foo/c"
+                              ; checksum = None
+                              }
+                        ; extra_sources = []
+                        }
+                    ; exported_env = []
+                    ; enabled_on_platforms = []
+                    }
+                }
+          }
+    ; ocaml = Some ("complex_lock_dir/lock.dune:3", "ocaml")
+    ; repos =
+        { complete = true
+        ; used = Some [ opam_repo_serializable "https://github.com/ocaml/dune" ]
+        }
+    ; expanded_solver_variable_bindings =
+        { variable_values = []; unset_variables = [] }
+    ; solved_for_platforms = ("<none>:1", [])
+    }
+    |}]
+;;
+
+let%expect_test "encode/decode round trip test with locked repo revision" =
+  let open Fiber.O in
+  let module Action = Dune_lang.Action in
+  let module String_with_vars = Dune_lang.String_with_vars in
+  run (fun () ->
+    let cwd = Path.External.cwd () |> Path.external_ in
+    let other_dir = Path.relative cwd "random-git-repo" in
+    let+ git_hash = Rev_store_tests.create_repo_at other_dir in
+    let lock_dir =
+      let pkg_a =
+        let name = Package_name.of_string "a" in
+        name, empty_package name ~version:(Package_version.of_string "0.1.0")
+      in
+      let pkg_b =
+        let name = Package_name.of_string "b" in
+        name, empty_package name ~version:(Package_version.of_string "dev")
+      in
+      let pkg_c =
+        let name = Package_name.of_string "c" in
+        name, empty_package name ~version:(Package_version.of_string "0.2")
+      in
+      let opam_repo =
+        let source = Some (sprintf "https://github.com/ocaml/dune#%s" git_hash) in
+        Opam_repo.Private.create ~source
+      in
+      Lock_dir.create_latest_version
+        ~local_packages:[]
+        ~ocaml:(Some (Loc.none, Package_name.of_string "ocaml"))
+        ~repos:(Some [ opam_repo ])
+        ~expanded_solver_variable_bindings:Expanded_variable_bindings.empty
+        ~solved_for_platform:None
+        (Package_name.Map.of_list_exn [ pkg_a; pkg_b; pkg_c ])
+    in
+    lock_dir_encode_decode_round_trip_test
+      ~commit:git_hash
+      ~lock_dir_path:"complex_lock_dir"
+      ~lock_dir
+      ());
+  [%expect
+    {|
+    lockdir matches after roundtrip:
+    { version = (0, 1)
+    ; dependency_hash = None
+    ; packages =
+        map
+          { "a" :
+              map
+                { "0.1.0" :
+                    { build_command = []
+                    ; install_command = []
+                    ; depends = []
+                    ; depexts = []
+                    ; info =
+                        { name = "a"
+                        ; version = "0.1.0"
+                        ; dev = false
+                        ; avoid = false
+                        ; source = None
+                        ; extra_sources = []
+                        }
+                    ; exported_env = []
+                    ; enabled_on_platforms = []
+                    }
+                }
+          ; "b" :
+              map
+                { "dev" :
+                    { build_command = []
+                    ; install_command = []
+                    ; depends = []
+                    ; depexts = []
+                    ; info =
+                        { name = "b"
+                        ; version = "dev"
+                        ; dev = false
+                        ; avoid = false
+                        ; source = None
+                        ; extra_sources = []
+                        }
+                    ; exported_env = []
+                    ; enabled_on_platforms = []
+                    }
+                }
+          ; "c" :
+              map
+                { "0.2" :
+                    { build_command = []
+                    ; install_command = []
+                    ; depends = []
+                    ; depexts = []
+                    ; info =
+                        { name = "c"
+                        ; version = "0.2"
+                        ; dev = false
+                        ; avoid = false
+                        ; source = None
+                        ; extra_sources = []
+                        }
+                    ; exported_env = []
+                    ; enabled_on_platforms = []
+                    }
+                }
+          }
+    ; ocaml = Some ("complex_lock_dir/lock.dune:3", "ocaml")
+    ; repos =
+        { complete = true
+        ; used =
+            Some
+              [ opam_repo_serializable
+                  "https://github.com/ocaml/dune#MATCHES_EXPECTED"
+              ]
+        }
+    ; expanded_solver_variable_bindings =
+        { variable_values = []; unset_variables = [] }
+    ; solved_for_platforms = ("<none>:1", [])
+    }
+    |}]
+;;

unikernel/duniverse/dune_/test/expect-tests/dune_pkg/fetch_tests.ml

@@ -0,0 +1,264 @@
+open Stdune
+module Scheduler = Dune_engine.Scheduler
+module Checksum = Dune_pkg.Checksum
+module Fetch = Dune_pkg.Fetch
+
+let plaintext_md = "tar-inputs/plaintext.md"
+let () = Dune_tests_common.init ()
+
+let url ~port ~filename =
+  let localhost = Unix.inet_addr_loopback |> Unix.string_of_inet_addr in
+  Format.sprintf "http://%s:%d/%s" localhost port filename |> OpamUrl.of_string
+;;
+
+let calculate_checksum ~filename = OpamHash.compute filename |> Checksum.of_opam_hash
+
+let wrong_checksum =
+  OpamHash.compute_from_string "random content" |> Checksum.of_opam_hash
+;;
+
+let archive = "tarball.tar.gz"
+
+let subdir destination =
+  let ext = Path.External.of_filename_relative_to_initial_cwd destination in
+  Path.external_ ext
+;;
+
+let serve_once ~filename =
+  let host = Unix.inet_addr_loopback in
+  let addr = Unix.ADDR_INET (host, 0) in
+  let server = Http.Server.make addr in
+  Http.Server.start server;
+  let port = Http.Server.port server in
+  let thread =
+    Thread.create
+      (fun server ->
+         Http.Server.accept server ~f:(fun session ->
+           let () = Http.Server.accept_request session in
+           Http.Server.respond_file session ~file:filename);
+         Http.Server.stop server)
+      server
+  in
+  port, thread
+;;
+
+let download ?(reproducible = true) ~unpack ~port ~filename ~target ?checksum () =
+  let open Fiber.O in
+  let url = url ~port ~filename in
+  let* res = Fetch.fetch ~unpack ~checksum ~target ~url:(Loc.none, url) in
+  match res with
+  | Error (Unavailable None) ->
+    let errs = [ Pp.text "Failure while downloading" ] in
+    User_error.raise ~loc:Loc.none errs
+  | Error (Unavailable (Some msg)) ->
+    User_error.raise ~loc:Loc.none [ User_message.pp msg ]
+  | Error (Checksum_mismatch actual_checksum) ->
+    let expected_checksum = Option.value_exn checksum in
+    User_error.raise
+      ~loc:Loc.none
+      [ Pp.text "Expected checksum was"
+      ; Pp.verbatim @@ Checksum.to_string expected_checksum
+      ; Pp.text "but got"
+      ; (if reproducible
+         then Pp.verbatim @@ Checksum.to_string actual_checksum
+         else Pp.text "<REDACTED>")
+      ]
+  | Ok () ->
+    print_endline "Done downloading";
+    Fiber.return ()
+;;
+
+let run thunk =
+  let on_event _config _event = () in
+  let config : Scheduler.Config.t =
+    { concurrency = 1; stats = None; print_ctrl_c_warning = false; watch_exclusions = [] }
+  in
+  Scheduler.Run.go config ~on_event (fun () ->
+    let open Fiber.O in
+    Rev_store_tests.git_init_and_config_user (Path.of_string ".") >>> thunk ())
+;;
+
+let%expect_test "downloading simple file" =
+  let filename = plaintext_md in
+  let port, server = serve_once ~filename in
+  let destination = "destination.md" in
+  run
+    (download
+       ~unpack:false
+       ~port
+       ~filename:""
+       ~target:(subdir destination)
+       ~checksum:(calculate_checksum ~filename));
+  Thread.join server;
+  let served_content = Io.String_path.read_file filename in
+  let downloaded_content = Io.String_path.read_file destination in
+  Printf.printf
+    "Served file:\n%s\nDownloaded file:\n%s\nEqual: %B"
+    served_content
+    downloaded_content
+    (String.equal served_content downloaded_content);
+  [%expect
+    {|
+    Done downloading
+    Served file:
+    Plaintext
+    =========
+
+    This is a plaintext file to make sure that downloading files from the internal
+    webserver works as desired.
+
+    Downloaded file:
+    Plaintext
+    =========
+
+    This is a plaintext file to make sure that downloading files from the internal
+    webserver works as desired.
+
+    Equal: true |}]
+;;
+
+let%expect_test "downloading but the checksums don't match" =
+  let port, server = serve_once ~filename:plaintext_md in
+  let destination = "destination.md" in
+  run
+    (download
+       ~unpack:false
+       ~port
+       ~filename:""
+       ~target:(subdir destination)
+       ~checksum:wrong_checksum);
+  Thread.join server;
+  print_endline "Finished successfully?";
+  [%expect.unreachable]
+[@@expect.uncaught_exn
+  {|
+  (Dune_util__Report_error.Already_reported)
+  Trailing output
+  ---------------
+  Error: Expected checksum was
+  md5=c533195dc4253503071a19d42f08e877
+  but got
+  md5=cbe78b067d4739684e86edfd2cb518bd |}]
+;;
+
+let%expect_test "downloading, without any checksum" =
+  let port, server = serve_once ~filename:plaintext_md in
+  let destination = "destination.md" in
+  run (download ~unpack:false ~port ~filename:"" ~target:(subdir destination));
+  Thread.join server;
+  print_endline "Finished successfully, no checksum verification";
+  [%expect
+    {|
+    Done downloading
+    Finished successfully, no checksum verification |}]
+;;
+
+let%expect_test "downloading, tarball" =
+  let port, server = serve_once ~filename:archive in
+  let destination = "tarball" in
+  run
+    (download
+     (* the tar utility that produces [filename] isn't portable and/or
+        deterministic enough to print the actual checksum *)
+       ~reproducible:false
+       ~unpack:true
+       ~checksum:wrong_checksum
+       ~port
+       ~filename:""
+       ~target:(subdir destination));
+  Thread.join server;
+  print_endline "Finished successfully, no checksum verification";
+  [%expect.unreachable]
+[@@expect.uncaught_exn
+  {|
+  (Dune_util__Report_error.Already_reported)
+  Trailing output
+  ---------------
+  Error: Expected checksum was
+  md5=c533195dc4253503071a19d42f08e877
+  but got
+  <REDACTED> |}]
+;;
+
+let%expect_test "downloading, tarball with no checksum match" =
+  (* This test ensures that the contents of the extracted tarball are in the
+     correct location. *)
+  let port, server = serve_once ~filename:archive in
+  let target = subdir "tarball" in
+  run (download ~reproducible:false ~unpack:true ~port ~filename:"" ~target);
+  Thread.join server;
+  print_endline "Finished successfully, no checksum verification";
+  (* print all the files in the target directory *)
+  let () =
+    print_endline "------\nfiles in target dir:";
+    Dune_engine.No_io.Path.Untracked.readdir_unsorted target
+    |> Result.value ~default:[]
+    |> List.sort ~compare:String.compare
+    |> List.iter ~f:print_endline
+  in
+  [%expect
+    {|
+    Done downloading
+    Finished successfully, no checksum verification
+    ------
+    files in target dir:
+    file2.md
+    plaintext.md |}]
+;;
+
+let download_git rev_store url ~target =
+  let open Fiber.O in
+  Rev_store_tests.git_init_and_config_user (Path.of_string ".")
+  >>> Fetch.fetch_git rev_store ~target ~url:(Loc.none, url)
+  >>| function
+  | Error _ ->
+    let errs = [ Pp.text "Failure while downloading" ] in
+    User_error.raise ~loc:Loc.none errs
+  | Ok () -> ()
+;;
+
+let%expect_test "downloading via git" =
+  let source = subdir "source-repository" in
+  let url = OpamUrl.parse (sprintf "git+file://%s" (Path.to_string source)) in
+  let rev_store_dir = subdir "rev-store" in
+  let target = subdir "checkout-into-here" in
+  (* The file at [entry] is created by [create_repo_at] *)
+  let entry = Path.relative target "entry" in
+  Path.mkdir_p target;
+  run (fun () ->
+    let open Fiber.O in
+    let* rev_store = Dune_pkg.Rev_store.load_or_create ~dir:rev_store_dir in
+    let* (_commit : string) = Rev_store_tests.create_repo_at source in
+    let+ () = download_git rev_store url ~target in
+    print_endline (Io.read_file entry));
+  [%expect {| just some content |}]
+;;
+
+let%expect_test "attempting to download an invalid git url" =
+  let source = subdir "source" in
+  let url = OpamUrl.parse "git+file://foo/bar" in
+  let rev_store_dir = subdir "rev-store-dir" in
+  let target = subdir "target" in
+  let entry = Path.relative target "e" in
+  run (fun () ->
+    let open Fiber.O in
+    let* rev_store = Dune_pkg.Rev_store.load_or_create ~dir:rev_store_dir in
+    let* (_commit : string) = Rev_store_tests.create_repo_at source in
+    let+ () = download_git rev_store url ~target in
+    print_endline (Io.read_file entry));
+  [%expect.unreachable]
+[@@expect.uncaught_exn
+  {|
+  (Dune_util__Report_error.Already_reported)
+  Trailing output
+  ---------------
+  fatal: '/bar' does not appear to be a git repository
+  fatal: Could not read from remote repository.
+
+  Please make sure you have the correct access rights
+  and the repository exists.
+  Error: Failed to run external command:
+  'git ls-remote "file://foo/bar"'
+  Hint: Check that this Git URL in the project configuration is correct:
+  "file://foo/bar" |}]
+;;

unikernel/duniverse/dune_/test/expect-tests/dune_pkg/git_config.ml

@@ -0,0 +1,42 @@
+module T4 = struct
+  type ('a, 'b, 'c, 'd) t = 'a * 'b * 'c * 'd
+
+  let to_dyn f g h i (a, b, c, d) = Dyn.Tuple [ f a; g b; h c; i d ]
+end
+
+module Git_config_parser = struct
+  let to_dyn = T4.to_dyn Dyn.string (Dyn.option Dyn.string) Dyn.string Dyn.string
+end
+
+let print_or_fail l =
+  match Dune_pkg.Rev_store.At_rev.Config.parse l with
+  | Some v -> print_endline @@ Dyn.to_string @@ Git_config_parser.to_dyn v
+  | None -> Printf.eprintf "Failed to parse %S\n" l
+;;
+
+let%expect_test "parsing simple section" =
+  let config = "foo.bar=baz" in
+  print_or_fail config;
+  [%expect
+    {|
+  ("foo", None, "bar", "baz")
+  |}]
+;;
+
+let%expect_test "parsing with arguments" =
+  let config = "foo.bar.baz=qux" in
+  print_or_fail config;
+  [%expect
+    {|
+  ("foo", Some "bar", "baz", "qux")
+  |}]
+;;
+
+let%expect_test "parsing with dots in name" =
+  let config = "branch.compat-5.0-dune-2.9.remote=origin" in
+  print_or_fail config;
+  [%expect
+    {|
+  ("branch", Some "compat-5.0-dune-2.9", "remote", "origin")
+  |}]
+;;

unikernel/duniverse/dune_/test/expect-tests/dune_pkg/rev_store_tests.ml

@@ -0,0 +1,82 @@
+open Stdune
+open Fiber.O
+module Scheduler = Dune_engine.Scheduler
+module Process = Dune_engine.Process
+module Display = Dune_engine.Display
+module Rev_store = Dune_pkg.Rev_store
+module Opam_repo = Dune_pkg.Opam_repo
+module Vcs = Dune_vcs.Vcs
+
+let () = Dune_tests_common.init ()
+
+let run thunk =
+  let on_event _config _event = () in
+  let config : Scheduler.Config.t =
+    { concurrency = 1; stats = None; print_ctrl_c_warning = false; watch_exclusions = [] }
+  in
+  Scheduler.Run.go config ~on_event thunk
+;;
+
+let display = Display.Quiet
+let output_limit = Sys.max_string_length
+let make_stdout () = Process.Io.make_stdout ~output_on_success:Swallow ~output_limit
+let make_stderr () = Process.Io.make_stderr ~output_on_success:Swallow ~output_limit
+
+let git ~dir =
+  let stdout_to = make_stdout () in
+  let stderr_to = make_stdout () in
+  let git = Lazy.force Vcs.git in
+  let failure_mode = Process.Failure_mode.Strict in
+  fun args -> Process.run ~dir ~display ~stdout_to ~stderr_to failure_mode git args
+;;
+
+let git_out ~dir =
+  let stderr_to = make_stdout () in
+  let git = Lazy.force Vcs.git in
+  let failure_mode = Process.Failure_mode.Strict in
+  fun args -> Process.run_capture_line ~dir ~display ~stderr_to failure_mode git args
+;;
+
+let git_init_and_config_user dir =
+  Path.mkdir_p dir;
+  let git = git ~dir in
+  git [ "init" ]
+  >>> git [ "config"; "user.name"; "\"Test Name\"" ]
+  >>> git [ "config"; "user.email"; "\"test@example.com\"" ]
+;;
+
+let create_repo_at dir =
+  let git = git ~dir in
+  let git_out = git_out ~dir in
+  let* () = git_init_and_config_user dir in
+  let entry_name = "entry" in
+  let entry = Path.relative dir entry_name in
+  Io.write_lines entry [ "just some content" ];
+  let* () = git [ "add"; entry_name ] in
+  let* () = git [ "commit"; "-m 'Initial commit'" ] in
+  git_out [ "rev-parse"; "HEAD" ]
+;;
+
+let%expect_test "adding remotes" =
+  let cwd = Path.External.cwd () |> Path.external_ in
+  let dir = Path.relative cwd "git-repo" in
+  run (fun () ->
+    let* rev_store = Rev_store.load_or_create ~dir in
+    let remote_path = Path.relative cwd "git-remote" in
+    let* _head = create_repo_at remote_path in
+    let opam_url = remote_path |> Path.to_string |> OpamUrl.parse in
+    Dune_pkg.OpamUrl.resolve opam_url ~loc:Loc.none rev_store
+    >>= function
+    | Error _ -> Fiber.return @@ print_endline "Unable to find revision"
+    | Ok r ->
+      print_endline "Successfully found remote";
+      Dune_pkg.OpamUrl.fetch_revision opam_url ~loc:Loc.none r rev_store
+      >>| (function
+       | Error _ -> print_endline "Unable to fetch revision"
+       | Ok _ -> print_endline "successfully fetched revision"));
+  [%expect
+    {|
+    Successfully found remote
+    successfully fetched revision
+     |}]
+;;

unikernel/duniverse/dune_/test/expect-tests/dune_pkg/tar-inputs/plaintext.md

@@ -0,0 +1,5 @@
+Plaintext
+=========
+
+This is a plaintext file to make sure that downloading files from the internal
+webserver works as desired.

unikernel/duniverse/dune_/test/expect-tests/dune_pkg_outdated/dune

@@ -0,0 +1,16 @@
+(library
+ (name dune_pkg_outdated_test)
+ (inline_tests)
+ (libraries
+  dune_tests_common
+  stdune
+  dune_pkg
+  dune_console
+  ;; This is because of the (implicit_transitive_deps false)
+  ;; in dune-project
+  base
+  ppx_expect.config
+  ppx_expect.config_types
+  ppx_inline_test.config)
+ (preprocess
+  (pps ppx_expect)))

unikernel/duniverse/dune_/test/expect-tests/dune_pkg_outdated/dune_pkg_outdated_test.ml

@@ -0,0 +1,312 @@
+open Stdune
+module Console = Dune_console
+
+(** [dummy_results a b c d] creates a dummy result with [a]/[b] immediate dependencies and
+    [c]/[d] transitive dependencies. The total number of dependencies will be [b] + [d]
+    of which [a] + [b] will be outdated. *)
+let dummy_results
+      number_of_immediate
+      total_number_of_immediate
+      number_of_transitive
+      total_number_of_transitive
+  =
+  List.init (total_number_of_immediate - number_of_immediate) ~f:(fun _ ->
+    Dune_pkg.Outdated.For_tests.package_is_best_candidate)
+  @ List.init number_of_immediate ~f:(fun i ->
+    Dune_pkg.Outdated.For_tests.better_candidate
+      ~is_immediate_dep_of_local_package:true
+      ~name:(sprintf "foo%d" i)
+      ~newer_version:(Dune_pkg.Package_version.of_string "2.0.0")
+      ~outdated_version:(Dune_pkg.Package_version.of_string "1.0.0"))
+  @ List.init (total_number_of_transitive - number_of_transitive) ~f:(fun _ ->
+    Dune_pkg.Outdated.For_tests.package_is_best_candidate)
+  @ List.init number_of_transitive ~f:(fun i ->
+    Dune_pkg.Outdated.For_tests.better_candidate
+      ~is_immediate_dep_of_local_package:false
+      ~name:(sprintf "bar%d" i)
+      ~newer_version:(Dune_pkg.Package_version.of_string "2.0.0")
+      ~outdated_version:(Dune_pkg.Package_version.of_string "1.0.0"))
+;;
+
+(* This will comb through a [User_message.Style.t Pp.t] message and find the style that
+   has been applied to the first line. It will then output the same line with the style
+   pretty printed in front of it. *)
+let show_styles_of_line line =
+  if line = Pp.nop
+  then line
+  else (
+    let found_style = ref None in
+    let (_ : unit Pp.t) = Pp.map_tags line ~f:(fun style -> found_style := Some style) in
+    match !found_style with
+    | None -> Pp.concat [ Pp.text "[no style] "; line ]
+    | Some styles ->
+      Pp.concat
+        [ styles |> User_message.Style.to_dyn |> Dyn.to_string |> Pp.textf "[%s]  "
+        ; line
+        ])
+;;
+
+(* [test_message ~transitive a b c d] prints a message saying that out of [b] immediate
+   dependencies [a] were outdated and out of [d] transitive dependencies [c] were
+   outdated. Depending on the value of [transitive] it may output a helper message. It
+   will also prefix the lines with the style that has been applied. *)
+let test_message
+      ~transitive
+      number_of_immediate
+      total_number_of_immediate
+      number_of_transitive
+      total_number_of_transitive
+  =
+  let results =
+    dummy_results
+      number_of_immediate
+      total_number_of_immediate
+      number_of_transitive
+      total_number_of_transitive
+  in
+  let lock_dir_path = Stdune.Path.Source.of_string "dune.lock" in
+  let message =
+    Dune_pkg.Outdated.For_tests.explain_results ~transitive ~lock_dir_path results
+  in
+  Console.print (List.map ~f:show_styles_of_line message)
+;;
+
+(* Testing the oudated packages message.
+
+   This message we give with "dune pkg outdated" needs to have the following properties
+   which we will check for here.
+
+   1. The message should be clear and concise.
+
+   2. It should contain information about the total number of packages in the lock file.
+
+   3. It should contain information about the number of outdated packages in the lock
+   file.
+
+   4. It should contain information about outdated transitive dependencies. By default we
+   choose to show only immediate dependencies, however in the case there are outdated
+   dependencies, we should go out of our way to inform the user that --transitive may
+   be passed to see these. Note that when --transitive is passed, this helper message
+   will no longer be displayed.
+
+   We will begin with the 4th property and then test different combinations of transitive
+   and immediate deps to assertain the satisfaction of properties 1-3.
+*)
+
+(* When --transitive is not passed, we include a helper message to inform the user that
+   there are transitive dependencies that are outdated. This message should only appear
+   when there are transitive dependencies present however. *)
+let%expect_test "transitive helper message" =
+  (* Transitive dependencies, helper message in the transitive = true case. *)
+  test_message ~transitive:true 0 0 10 20;
+  [%expect {| [Warning]  10/20 packages in dune.lock are outdated. |}];
+  test_message ~transitive:false 0 0 10 20;
+  [%expect
+    {|
+    [Warning]  10/20 packages in dune.lock are outdated.
+    [no style] Showing immediate dependencies, use --transitive to see the rest. |}];
+  (* No transitive dependencies, no helper message in both cases. *)
+  test_message ~transitive:true 10 20 0 0;
+  [%expect {| [Warning]  10/20 packages in dune.lock are outdated. |}];
+  test_message ~transitive:false 10 20 0 0;
+  [%expect {| [Warning]  10/20 packages in dune.lock are outdated. |}]
+;;
+
+(* [test a b c d] prints a message saying that out of [b] immediate dependencies [a] were
+   outdated and out of [d] transitive dependencies [c] were outdated. Notably it assumes
+   that [transitive] is true which means we will not output a helper message. It will also
+   prefix the lines with the style that has been applied. *)
+let test
+      number_of_immediate
+      total_number_of_immediate
+      number_of_transitive
+      total_number_of_transitive
+  =
+  test_message
+    ~transitive:true
+    number_of_immediate
+    total_number_of_immediate
+    number_of_transitive
+    total_number_of_transitive
+;;
+
+(* Testing different combinations of immediate and transitive dependencies. *)
+
+(* We should always report an empty lock file as up to date. *)
+let%expect_test "no packages" =
+  test 0 0 0 0;
+  [%expect {| [Success]  dune.lock is up to date. |}]
+;;
+
+let%expect_test "single immediate package" =
+  test 0 1 0 0;
+  [%expect {| [Success]  dune.lock is up to date. |}];
+  test 1 1 0 0;
+  [%expect {| [Warning]  1/1 packages in dune.lock are outdated. |}]
+;;
+
+let%expect_test "two immediate packages" =
+  test 0 2 0 0;
+  [%expect {| [Success]  dune.lock is up to date. |}];
+  test 1 2 0 0;
+  [%expect {| [Warning]  1/2 packages in dune.lock are outdated. |}];
+  test 2 2 0 0;
+  [%expect {| [Warning]  2/2 packages in dune.lock are outdated. |}]
+;;
+
+let%expect_test "three immediate packages" =
+  test 0 3 0 0;
+  [%expect {| [Success]  dune.lock is up to date. |}];
+  test 1 3 0 0;
+  [%expect {| [Warning]  1/3 packages in dune.lock are outdated. |}];
+  test 2 3 0 0;
+  [%expect {| [Warning]  2/3 packages in dune.lock are outdated. |}];
+  test 3 3 0 0;
+  [%expect {| [Warning]  3/3 packages in dune.lock are outdated. |}]
+;;
+
+(* This case will never happen as having at least a single transitive dependency means
+   that there is at least one immediate dependency. The message is not the place to check
+   this however, so for consistency we include what it would say. *)
+let%expect_test "single transitive package" =
+  test 0 0 0 1;
+  [%expect {| [Success]  dune.lock is up to date. |}];
+  test 0 0 1 1;
+  [%expect {| [Warning]  1/1 packages in dune.lock are outdated. |}]
+;;
+
+(* Same as above. *)
+let%expect_test "two transitives packages" =
+  test 0 0 0 2;
+  [%expect {| [Success]  dune.lock is up to date. |}];
+  test 0 0 1 2;
+  [%expect {| [Warning]  1/2 packages in dune.lock are outdated. |}];
+  test 0 0 2 2;
+  [%expect {| [Warning]  2/2 packages in dune.lock are outdated. |}]
+;;
+
+(* Same as above. *)
+let%expect_test "three transitive packages" =
+  test 0 0 0 3;
+  [%expect {| [Success]  dune.lock is up to date. |}];
+  test 0 0 1 3;
+  [%expect {| [Warning]  1/3 packages in dune.lock are outdated. |}];
+  test 0 0 2 3;
+  [%expect {| [Warning]  2/3 packages in dune.lock are outdated. |}];
+  test 0 0 3 3;
+  [%expect {| [Warning]  3/3 packages in dune.lock are outdated. |}]
+;;
+
+(* A lockfile with two packages, one an immediate dependency and one a transitive
+   dependency. Should have the appropriate message depending on which packages are
+   outdated. Since we only show the *)
+let%expect_test "one immediate and one transitive" =
+  test 0 1 0 1;
+  [%expect {| [Success]  dune.lock is up to date. |}];
+  test 1 1 0 1;
+  [%expect {| [Warning]  1/2 packages in dune.lock are outdated. |}];
+  test 0 1 1 1;
+  [%expect {| [Warning]  1/2 packages in dune.lock are outdated. |}];
+  test 1 1 1 1;
+  [%expect {| [Warning]  2/2 packages in dune.lock are outdated. |}]
+;;
+
+let%expect_test "one immediate and two transitive" =
+  test 0 1 0 2;
+  [%expect {| [Success]  dune.lock is up to date. |}];
+  test 1 1 0 2;
+  [%expect {| [Warning]  1/3 packages in dune.lock are outdated. |}];
+  test 0 1 1 2;
+  [%expect {| [Warning]  1/3 packages in dune.lock are outdated. |}];
+  test 1 1 1 2;
+  [%expect {| [Warning]  2/3 packages in dune.lock are outdated. |}];
+  test 0 1 2 2;
+  [%expect {| [Warning]  2/3 packages in dune.lock are outdated. |}];
+  test 1 1 2 2;
+  [%expect {| [Warning]  3/3 packages in dune.lock are outdated. |}]
+;;
+
+let%expect_test "two immediate and one transitive" =
+  test 0 2 0 1;
+  [%expect {| [Success]  dune.lock is up to date. |}];
+  test 1 2 0 1;
+  [%expect {| [Warning]  1/3 packages in dune.lock are outdated. |}];
+  test 2 2 0 1;
+  [%expect {| [Warning]  2/3 packages in dune.lock are outdated. |}];
+  test 0 2 1 1;
+  [%expect {| [Warning]  1/3 packages in dune.lock are outdated. |}];
+  test 1 2 1 1;
+  [%expect {| [Warning]  2/3 packages in dune.lock are outdated. |}];
+  test 2 2 1 1;
+  [%expect {| [Warning]  3/3 packages in dune.lock are outdated. |}]
+;;
+
+let%expect_test "two immediate and two transitive" =
+  test 0 2 0 2;
+  [%expect {| [Success]  dune.lock is up to date. |}];
+  test 1 2 0 2;
+  [%expect {| [Warning]  1/4 packages in dune.lock are outdated. |}];
+  test 2 2 0 2;
+  [%expect {| [Warning]  2/4 packages in dune.lock are outdated. |}];
+  test 0 2 1 2;
+  [%expect {| [Warning]  1/4 packages in dune.lock are outdated. |}];
+  test 1 2 1 2;
+  [%expect {| [Warning]  2/4 packages in dune.lock are outdated. |}];
+  test 2 2 1 2;
+  [%expect {| [Warning]  3/4 packages in dune.lock are outdated. |}];
+  test 0 2 2 2;
+  [%expect {| [Warning]  2/4 packages in dune.lock are outdated. |}];
+  test 1 2 2 2;
+  [%expect {| [Warning]  3/4 packages in dune.lock are outdated. |}];
+  test 2 2 2 2;
+  [%expect {| [Warning]  4/4 packages in dune.lock are outdated. |}]
+;;
+
+let%expect_test "some larger examples" =
+  test 0 0 10 100;
+  [%expect {| [Warning]  10/100 packages in dune.lock are outdated. |}];
+  test 12 34 56 78;
+  [%expect {| [Warning]  68/112 packages in dune.lock are outdated. |}]
+;;
+
+(* [test_entire_output a b c d] prints the message from before and also all the outdated
+   packages the command will output. Unlike before we do not print style information. *)
+let test_entire_output
+      ~transitive
+      number_of_immediate
+      total_number_of_immediate
+      number_of_transitive
+      total_number_of_transitive
+  =
+  let results =
+    dummy_results
+      number_of_immediate
+      total_number_of_immediate
+      number_of_transitive
+      total_number_of_transitive
+  in
+  let lock_dir_path = Stdune.Path.Source.of_string "dune.lock" in
+  let message = Dune_pkg.Outdated.For_tests.pp ~transitive ~lock_dir_path results in
+  Console.print [ message ]
+;;
+
+(* We now test the entire output of the command to see how it will look. *)
+let%expect_test "testing entire output" =
+  test_entire_output ~transitive:false 2 3 2 3;
+  [%expect
+    {|
+4/6 packages in dune.lock are outdated.
+Showing immediate dependencies, use --transitive to see the rest.
+- foo0 1.0.0 < 2.0.0
+- foo1 1.0.0 < 2.0.0
+  |}];
+  test_entire_output ~transitive:true 2 3 2 3;
+  [%expect
+    {|
+4/6 packages in dune.lock are outdated.
+- foo0 1.0.0 < 2.0.0
+- foo1 1.0.0 < 2.0.0
+- bar0 1.0.0 < 2.0.0
+- bar1 1.0.0 < 2.0.0
+  |}]
+;;

unikernel/duniverse/dune_/test/expect-tests/dune_rpc/dune

@@ -0,0 +1,22 @@
+(library
+ (name dune_rpc_tests)
+ (modules dune_rpc_tests)
+ (inline_tests)
+ (libraries
+  ocaml_config
+  dune_util
+  dune_rpc_private
+  dune_rpc_server
+  dune_rpc_client
+  stdune
+  test_scheduler
+  csexp
+  fiber
+  ;; This is because of the (implicit_transitive_deps false)
+  ;; in dune-project
+  ppx_expect.config
+  ppx_expect.config_types
+  base
+  ppx_inline_test.config)
+ (preprocess
+  (pps ppx_expect)))

unikernel/duniverse/dune_/test/expect-tests/dune_rpc/dune_rpc_tests.ml

@@ -0,0 +1,947 @@
+open! Stdune
+open! Fiber.O
+module Dune_rpc = Dune_rpc_private
+open Dune_rpc
+open Dune_rpc_server
+module Scheduler = Test_scheduler
+
+let () = Printexc.record_backtrace false
+let () = Dune_util.Log.init_disabled ()
+let print pp = Format.printf "%a@." Pp.to_fmt pp
+let print_dyn dyn = print (Dyn.pp dyn)
+
+module Chan = struct
+  module Mvar = Fiber.Mvar
+
+  type t =
+    { (* Read end. Populated by writing by [snd] *)
+      in_ : Sexp.t Fiber.Stream.In.t * Sexp.t Fiber.Stream.Out.t
+    ; (* Write end. Can be read via [fst] *)
+      out : Sexp.t Fiber.Stream.In.t * Sexp.t Fiber.Stream.Out.t
+    }
+
+  let create () = { in_ = Fiber.Stream.pipe (); out = Fiber.Stream.pipe () }
+  let close t = Fiber.Stream.Out.write (snd t.out) None
+
+  let write t s =
+    let+ () =
+      Fiber.sequential_iter s ~f:(fun s -> Fiber.Stream.Out.write (snd t.out) (Some s))
+    in
+    Ok ()
+  ;;
+
+  let read t = Fiber.Stream.In.read (fst t.in_)
+
+  let connect c1 c2 =
+    Fiber.fork_and_join_unit
+      (fun () -> Fiber.Stream.connect (fst c1.out) (snd c2.in_))
+      (fun () -> Fiber.Stream.connect (fst c2.out) (snd c1.in_))
+  ;;
+
+  let name _ = "unnamed"
+end
+
+module Drpc = struct
+  module Client =
+    Dune_rpc.Client.Make
+      (Dune_rpc_client.Private.Fiber)
+      (struct
+        include Chan
+
+        let write t = function
+          | None -> close t
+          | Some packets -> write t packets >>| Result.ok_exn
+        ;;
+      end)
+
+  module Server = Dune_rpc_server.Make (Chan)
+end
+
+open Drpc
+
+let on_init _ _ = Fiber.return ()
+
+let setup_client_server () =
+  let client_chan = Chan.create () in
+  let server_chan = Chan.create () in
+  let sessions = Fiber.Stream.In.of_list [ server_chan ] in
+  let connect () = Chan.connect client_chan server_chan in
+  client_chan, sessions, connect
+;;
+
+let test ?(private_menu = []) ?(real_methods = true) ~client ~handler ~init () =
+  if real_methods
+  then
+    Handler.implement_notification handler Procedures.Public.shutdown (fun _ _ ->
+      failwith "shutdown called");
+  let run =
+    let client_chan, sessions, connect = setup_client_server () in
+    let client () =
+      Drpc.Client.connect_with_menu client_chan init ~private_menu ~f:(fun c ->
+        let* () = client c in
+        Chan.close client_chan)
+    in
+    let server () =
+      let+ () = Drpc.Server.serve sessions None (Dune_rpc_server.make handler) in
+      printfn "server: finished."
+    in
+    Fiber.parallel_iter [ connect; client; server ] ~f:(fun f -> f ())
+  in
+  Scheduler.run (Scheduler.create ()) run
+;;
+
+let init ?(id = Id.make (Csexp.Atom "test-client")) ?(version = 1, 1) () =
+  { Initialize.Request.dune_version = version
+  ; protocol_version = Protocol.latest_version
+  ; id
+  }
+;;
+
+let%expect_test "initialize scheduler with rpc" =
+  let handler = Handler.create ~on_init ~version:(2, 0) () in
+  let init = init () in
+  test
+    ~init
+    ~client:(fun _ ->
+      printfn "client: connected. now terminating";
+      Fiber.return ())
+    ~handler
+    ();
+  [%expect
+    {|
+    client: connected. now terminating
+    server: finished. |}]
+;;
+
+let%expect_test "no methods in common" =
+  let handler = Handler.create ~on_init ~version:(2, 0) () in
+  let init = init ~version:(2, 5) () in
+  test ~init ~real_methods:false ~client:(fun _ -> assert false) ~handler ();
+  [%expect.unreachable]
+[@@expect.uncaught_exn
+  {|
+  ( "Server_aborted\
+   \n  [ [ \"message\"; \"Server and client have no method versions in common\" ] ]")
+  Trailing output
+  ---------------
+  server: finished. |}]
+;;
+
+let simple_request
+      (type a b)
+      ?(version = 1)
+      ~method_
+      (req : (a, Conv.values) Conv.t)
+      (resp : (b, Conv.values) Conv.t)
+  =
+  let v = Decl.Request.make_current_gen ~req ~resp ~version in
+  Decl.Request.make ~method_ ~generations:[ v ]
+;;
+
+let request_exn client witness n =
+  let* staged = Client.Versioned.prepare_request client witness in
+  let staged =
+    match staged with
+    | Ok s -> s
+    | Error e -> raise (Dune_rpc.Version_error.E e)
+  in
+  Client.request client staged n
+;;
+
+let%expect_test "call method with matching versions" =
+  let decl = simple_request ~method_:"double" Conv.int Conv.int in
+  let handler =
+    let rpc = Handler.create ~on_init ~version:(1, 1) () in
+    let () =
+      let cb _ x =
+        if x = 0
+        then
+          raise
+            (Response.Error.E
+               (Response.Error.create ~kind:Invalid_request ~message:"0 not allowed" ()))
+        else Fiber.return (x + x)
+      in
+      Handler.implement_request rpc decl cb
+    in
+    rpc
+  in
+  let witness = Decl.Request.witness decl in
+  let client client =
+    printfn "client: sending request";
+    let* resp = request_exn client witness 5 in
+    (match resp with
+     | Error _ -> assert false
+     | Ok s -> printfn "client: result %d" s);
+    printfn "client: sending invalid request";
+    let* resp = request_exn client witness 0 in
+    (match resp with
+     | Error e -> printfn "client: error %s" e.message
+     | Ok _ -> assert false);
+    Fiber.return ()
+  in
+  let init =
+    { Initialize.Request.dune_version = 1, 1
+    ; protocol_version = Protocol.latest_version
+    ; id = Id.make (Atom "test-client")
+    }
+  in
+  test ~init ~client ~handler ~private_menu:[ Request decl ] ();
+  [%expect
+    {|
+    client: sending request
+    client: result 10
+    client: sending invalid request
+    client: error 0 not allowed
+    server: finished. |}]
+;;
+
+let%expect_test "call method with no matching versions" =
+  let decl = simple_request ~method_:"double" Conv.int Conv.int in
+  let handler =
+    let rpc = Handler.create ~on_init ~version:(2, 0) () in
+    let () =
+      let cb _ x = Fiber.return (x + x) in
+      Handler.implement_request rpc decl cb
+    in
+    rpc
+  in
+  let client client =
+    printfn "client: preparing request";
+    let* resp = Client.Versioned.prepare_request client (Decl.Request.witness decl) in
+    (match resp with
+     | Error e -> printfn "client: error %s" (Dune_rpc.Version_error.message e)
+     | Ok _ -> assert false);
+    Fiber.return ()
+  in
+  let init =
+    { Initialize.Request.dune_version = 1, 1
+    ; protocol_version = Protocol.latest_version
+    ; id = Id.make (Atom "test-client")
+    }
+  in
+  let decl' = simple_request ~method_:"double" ~version:2 Conv.int Conv.int in
+  test ~init ~client ~handler ~private_menu:[ Request decl' ] ();
+  [%expect
+    {|
+    client: preparing request
+    client: error invalid method
+    server: finished. |}]
+;;
+
+module Add = struct
+  type req =
+    { x : int
+    ; y : int
+    ; others : int list
+    }
+
+  type resp =
+    | No_others of int
+    | With_others of
+        { xy : int
+        ; all : int
+        }
+
+  module V1_only = struct
+    let req = Conv.pair Conv.int Conv.int
+    let resp = Conv.int
+  end
+
+  let v1_only =
+    Decl.Request.make_current_gen
+      ~req:(Conv.pair Conv.int Conv.int)
+      ~resp:Conv.int
+      ~version:1
+  ;;
+
+  let v1 =
+    let upgrade_req (x, y) = { x; y; others = [] } in
+    let downgrade_req { x; y; others = _ } = x, y in
+    let upgrade_resp x = No_others x in
+    let downgrade_resp = function
+      | No_others x -> x
+      | With_others { xy; all = _ } -> xy
+    in
+    Decl.Request.make_gen
+      ~req:(Conv.pair Conv.int Conv.int)
+      ~resp:Conv.int
+      ~upgrade_req
+      ~downgrade_req
+      ~upgrade_resp
+      ~downgrade_resp
+      ~version:1
+  ;;
+
+  let v2 =
+    let req =
+      let open Conv in
+      let parse =
+        record
+          (three
+             (field "x" (required int))
+             (field "y" (required int))
+             (field "others" (required (list int))))
+      in
+      let to_ (x, y, others) = { x; y; others } in
+      let from { x; y; others } = x, y, others in
+      iso parse to_ from
+    in
+    let resp =
+      let open Conv in
+      let no_others = constr "no_others" int (fun x -> No_others x) in
+      let with_others =
+        constr "with_others" (pair int int) (fun (xy, all) -> With_others { xy; all })
+      in
+      sum
+        [ econstr no_others; econstr with_others ]
+        (function
+          | No_others x -> case x no_others
+          | With_others { xy; all } -> case (xy, all) with_others)
+    in
+    Decl.Request.make_current_gen ~req ~resp ~version:2
+  ;;
+end
+
+let add_v1_only = Decl.Request.make ~method_:"add" ~generations:[ Add.v1_only ]
+let add_v1_v2 = Decl.Request.make ~method_:"add" ~generations:[ Add.v1; Add.v2 ]
+
+let%expect_test "client is newer than server" =
+  let handler =
+    let rpc = Handler.create ~on_init ~version:(2, 0) () in
+    let () =
+      let cb _ (x, y) = Fiber.return (x + y) in
+      Handler.implement_request rpc add_v1_only cb
+    in
+    rpc
+  in
+  let client client =
+    printfn "client: sending request";
+    let+ resp =
+      request_exn
+        client
+        (Decl.Request.witness add_v1_v2)
+        { x = 10; y = 15; others = [ -25 ] }
+    in
+    match resp with
+    | Error _ -> assert false
+    | Ok (With_others _) -> assert false
+    | Ok (No_others x) -> printfn "client: %d" x
+  in
+  let init =
+    { Initialize.Request.dune_version = 1, 9
+    ; protocol_version = Protocol.latest_version
+    ; id = Id.make (Atom "test-client")
+    }
+  in
+  test ~private_menu:[ Request add_v1_v2 ] ~init ~client ~handler ();
+  [%expect
+    {|
+    client: sending request
+    client: 25
+    server: finished. |}]
+;;
+
+let%expect_test "client is older than server" =
+  let handler =
+    let rpc = Handler.create ~on_init ~version:(2, 0) () in
+    let () =
+      let cb _ { Add.x; y; others } =
+        match others with
+        | [] -> Fiber.return (Add.No_others (x + y))
+        | _ :: _ -> assert false
+      in
+      Handler.implement_request rpc add_v1_v2 cb
+    in
+    rpc
+  in
+  let client client =
+    printfn "client: sending request";
+    let+ resp = request_exn client (Decl.Request.witness add_v1_only) (20, 30) in
+    match resp with
+    | Error _ -> assert false
+    | Ok x -> printfn "client: %d" x
+  in
+  let init =
+    { Initialize.Request.dune_version = 1, 9
+    ; protocol_version = Protocol.latest_version
+    ; id = Id.make (Atom "test-client")
+    }
+  in
+  test ~private_menu:[ Request add_v1_only ] ~init ~client ~handler ();
+  [%expect
+    {|
+    client: sending request
+    client: 50
+    server: finished. |}]
+;;
+
+let%test_module "long polling" =
+  (module struct
+    let v1 =
+      Decl.Request.make_current_gen ~req:Id.sexp ~resp:(Conv.option Conv.int) ~version:1
+    ;;
+
+    let sub_proc =
+      Dune_rpc.Procedures.Poll.make (Dune_rpc.Procedures.Poll.Name.make "pulse") [ v1 ]
+    ;;
+
+    let sub_decl = Sub.of_procedure sub_proc
+    let version = 3, 0
+    let init = init ~version ()
+    let rpc () = Handler.create ~on_init ~version ()
+
+    let server f =
+      let rpc = rpc () in
+      let () =
+        let on_poll _session = f () in
+        let on_cancel _session =
+          printfn "server: polling cancelled";
+          Fiber.return ()
+        in
+        Handler.For_tests.implement_poll rpc sub_proc ~on_poll ~on_cancel
+      in
+      rpc
+    ;;
+
+    let server_long_poll svar =
+      let rpc = rpc () in
+      let () =
+        Handler.implement_long_poll
+          rpc
+          sub_proc
+          svar
+          ~equal:Int.equal
+          ~diff:(fun ~last ~now ->
+            match last with
+            | None -> now
+            | Some last -> now - last)
+      in
+      rpc
+    ;;
+
+    let%expect_test "long polling - client side termination" =
+      let client client =
+        let* poller = Client.poll client sub_decl in
+        let poller =
+          match poller with
+          | Ok p -> p
+          | Error e -> raise (Version_error.E e)
+        in
+        let req () =
+          let+ res = Client.Stream.next poller in
+          match res with
+          | None -> printfn "client: no more values"
+          | Some a -> printfn "client: received %d" a
+        in
+        let* () = req () in
+        let* () = req () in
+        Client.Stream.cancel poller
+      in
+      let handler =
+        let state = ref 0 in
+        server (fun () ->
+          incr state;
+          Fiber.return (Some !state))
+      in
+      test ~init ~client ~handler ~private_menu:[ Poll sub_proc ] ();
+      [%expect
+        {|
+    client: received 1
+    client: received 2
+    server: polling cancelled
+    server: finished. |}]
+    ;;
+
+    let%expect_test "long polling - server side termination" =
+      let client client =
+        printfn "client: long polling";
+        let* poller = Client.poll client sub_decl in
+        let poller =
+          match poller with
+          | Ok p -> p
+          | Error e -> raise (Version_error.E e)
+        in
+        let+ () =
+          Fiber.repeat_while ~init:() ~f:(fun () ->
+            let+ res = Client.Stream.next poller in
+            match res with
+            | None -> None
+            | Some a ->
+              printfn "client: received %d" a;
+              Some ())
+        in
+        printfn "client: subscription terminated"
+      in
+      let handler =
+        let state = ref 0 in
+        server (fun _poller ->
+          incr state;
+          Fiber.return (if !state = 3 then None else Some !state))
+      in
+      test ~init ~client ~handler ~private_menu:[ Poll sub_proc ] ();
+      [%expect
+        {|
+    client: long polling
+    client: received 1
+    client: received 2
+    client: subscription terminated
+    server: finished. |}]
+    ;;
+
+    let%expect_test "long polling - client cancels while request is in-flight" =
+      let ready_to_cancel : unit Fiber.Ivar.t = Fiber.Ivar.create () in
+      let svar = Fiber.Svar.create 0 in
+      let handler = server_long_poll svar in
+      let client client =
+        let* poller =
+          let+ poller = Client.poll client sub_decl in
+          match poller with
+          | Ok p -> p
+          | Error e -> raise (Version_error.E e)
+        in
+        let req () =
+          let+ res = Client.Stream.next poller in
+          match res with
+          | None -> printfn "client: no more values"
+          | Some a -> printfn "client: received %d" a
+        in
+        let* () = Fiber.Svar.write svar 1 in
+        let* () = req () in
+        Fiber.fork_and_join_unit
+          (fun () ->
+             let* () = Fiber.Ivar.read ready_to_cancel in
+             printfn "client: cancelling";
+             Client.Stream.cancel poller)
+          (fun () ->
+             printfn "client: waiting for second value (that will never come)";
+             let+ () = Fiber.fork_and_join_unit req (Fiber.Ivar.fill ready_to_cancel) in
+             printfn "client: finishing session")
+      in
+      test ~init ~client ~handler ~private_menu:[ Poll sub_proc ] ();
+      [%expect.unreachable]
+    [@@expect.uncaught_exn
+      {|
+      (Test_scheduler.Never)
+      Trailing output
+      ---------------
+      client: received 1
+      client: waiting for second value (that will never come)
+      client: cancelling
+      client: no more values
+      client: finishing session |}]
+    ;;
+
+    let%expect_test "long polling - server side termination" =
+      let client client =
+        printfn "client: long polling";
+        let* poller = Client.poll client sub_decl in
+        let poller =
+          match poller with
+          | Ok p -> p
+          | Error e -> raise (Version_error.E e)
+        in
+        let+ () =
+          Fiber.repeat_while ~init:() ~f:(fun () ->
+            let+ res = Client.Stream.next poller in
+            match res with
+            | None -> None
+            | Some a ->
+              printfn "client: received %d" a;
+              Some ())
+        in
+        printfn "client: subscription terminated"
+      in
+      let handler =
+        let state = ref 0 in
+        server (fun _poller ->
+          incr state;
+          Fiber.return (if !state = 3 then None else Some !state))
+      in
+      test ~init ~client ~handler ~private_menu:[ Poll sub_proc ] ();
+      [%expect
+        {|
+    client: long polling
+    client: received 1
+    client: received 2
+    client: subscription terminated
+    server: finished. |}]
+    ;;
+  end)
+;;
+
+let%expect_test "server to client request" =
+  let decl = simple_request ~method_:"double" Conv.int Conv.int in
+  let client_finish = Fiber.Ivar.create () in
+  let pool = Fiber.Pool.create () in
+  let on_upgrade session _menu =
+    let witness = Decl.Request.witness decl in
+    let* () =
+      Fiber.Pool.task pool ~f:(fun () ->
+        let* () = Fiber.Pool.close pool in
+        print_endline "server: sending request to client";
+        let+ res =
+          Session.request session witness (Dune_rpc.Id.make (Csexp.Atom "test")) 10
+        in
+        Printf.printf "client: received response %d\n" res)
+    in
+    Fiber.Ivar.fill client_finish ()
+  in
+  let handler = Handler.create ~on_init ~on_upgrade ~version:(2, 0) () in
+  Handler.declare_request handler decl;
+  let client _ =
+    Fiber.fork_and_join_unit
+      (fun () -> Fiber.Ivar.read client_finish)
+      (fun () -> Fiber.Pool.run pool)
+  in
+  let init =
+    { Initialize.Request.dune_version = 1, 1
+    ; protocol_version = Protocol.latest_version
+    ; id = Id.make (Atom "test-client")
+    }
+  in
+  test
+    ~init
+    ~client
+    ~handler
+    ~private_menu:
+      [ Handle_request
+          ( decl
+          , let doubler x =
+              print_endline "client: received request from server";
+              Fiber.return (x * 2)
+            in
+            doubler )
+      ]
+    ();
+  [%expect
+    {|
+    server: sending request to client
+    client: received request from server
+    client: received response 20
+    server: finished. |}]
+;;
+
+let%test_module "finalization" =
+  (module struct
+    let decl = simple_request ~method_:"double" Conv.unit Conv.unit
+    let witness = Decl.Request.witness decl
+
+    type callback =
+      | Print
+      | Fail
+
+    let dyn_of_callback =
+      let open Dyn in
+      function
+      | Print -> variant "Print" []
+      | Fail -> variant "Fail" []
+    ;;
+
+    type callbacks =
+      { on_init : callback
+      ; on_terminate : callback
+      ; on_upgrade : callback
+      }
+
+    let dyn_of_callback { on_init; on_terminate; on_upgrade } =
+      Dyn.record
+        [ "on_init", dyn_of_callback on_init
+        ; "on_terminate", dyn_of_callback on_terminate
+        ; "on_upgrade", dyn_of_callback on_upgrade
+        ]
+    ;;
+
+    let handler { on_init; on_terminate; on_upgrade } =
+      let f name what =
+        printfn "server: %s" name;
+        match what with
+        | Print -> Fiber.return ()
+        | Fail -> raise Dune_util.Report_error.Already_reported
+      in
+      let on_init _ _ = f "init" on_init in
+      let on_terminate _ = f "terminate" on_terminate in
+      let on_upgrade _ _ = f "upgrade" on_upgrade in
+      Handler.create ~on_terminate ~on_init ~on_upgrade ~version:(1, 1) ()
+    ;;
+
+    let test callback =
+      let handler =
+        let rpc = handler callback in
+        let () =
+          let cb _ () = failwith "never works" in
+          Handler.implement_request rpc decl cb
+        in
+        rpc
+      in
+      let client client =
+        printfn "client: sending request";
+        let+ resp = request_exn client witness () in
+        match resp with
+        | Error error -> print_dyn @@ Response.Error.to_dyn error
+        | Ok _ -> assert false
+      in
+      let init =
+        { Initialize.Request.dune_version = 1, 1
+        ; protocol_version = Protocol.latest_version
+        ; id = Id.make (Atom "test-client")
+        }
+      in
+      test ~init ~client ~handler ~private_menu:[ Request decl ] ()
+    ;;
+
+    let%expect_test "termination is always called" =
+      let kind = [ Print; Fail ] in
+      let callbacks =
+        List.concat_map kind ~f:(fun on_init ->
+          List.concat_map kind ~f:(fun on_terminate ->
+            List.concat_map kind ~f:(fun on_upgrade ->
+              [ { on_init; on_terminate; on_upgrade } ])))
+      in
+      List.iter callbacks ~f:(fun callback ->
+        dyn_of_callback callback |> print_dyn;
+        (try test callback with
+         | exn ->
+           let exn = Exn_with_backtrace.capture exn in
+           Format.printf "%a@.@." Exn_with_backtrace.pp_uncaught exn);
+        print_endline "---------------");
+      [%expect
+        {|
+        { on_init = Print; on_terminate = Print; on_upgrade = Print }
+        server: init
+        server: upgrade
+        client: sending request
+        { payload =
+            Some [ [ [ "exn"; "Failure(\"never works\")" ]; [ "backtrace"; "" ] ] ]
+        ; message = "server error"
+        ; kind = Code_error
+        }
+        server: terminate
+        server: finished.
+        ---------------
+        { on_init = Print; on_terminate = Print; on_upgrade = Fail }
+        server: init
+        server: upgrade
+        server: terminate
+        server: finished.
+        client: sending request
+        { payload =
+            Some
+              [ [ "id"; [ "auto"; "0" ] ]
+              ; [ "req"; [ [ "method"; "double" ]; [ "params"; [] ] ] ]
+              ]
+        ; message = "request sent while connection is dead"
+        ; kind = Connection_dead
+        }
+        ---------------
+        { on_init = Print; on_terminate = Fail; on_upgrade = Print }
+        server: init
+        server: upgrade
+        client: sending request
+        { payload =
+            Some [ [ [ "exn"; "Failure(\"never works\")" ]; [ "backtrace"; "" ] ] ]
+        ; message = "server error"
+        ; kind = Code_error
+        }
+        server: terminate
+        server: finished.
+        ---------------
+        { on_init = Print; on_terminate = Fail; on_upgrade = Fail }
+        server: init
+        server: upgrade
+        server: terminate
+        /-----------------------------------------------------------------------
+        | Internal error: Uncaught exception.
+        | Dune_util__Report_error.Already_reported
+        \-----------------------------------------------------------------------
+
+
+        ---------------
+        { on_init = Fail; on_terminate = Print; on_upgrade = Print }
+        server: init
+        server: terminate
+        server: finished.
+        /-----------------------------------------------------------------------
+        | Internal error: Uncaught exception.
+        | Response.E
+        |   { payload = Some [ [ "id"; [ "initialize" ] ] ]
+        |   ; message =
+        |       "connection terminated. this request will never receive a response"
+        |   ; kind = Connection_dead
+        |   }
+        \-----------------------------------------------------------------------
+
+
+        ---------------
+        { on_init = Fail; on_terminate = Print; on_upgrade = Fail }
+        server: init
+        server: terminate
+        server: finished.
+        /-----------------------------------------------------------------------
+        | Internal error: Uncaught exception.
+        | Response.E
+        |   { payload = Some [ [ "id"; [ "initialize" ] ] ]
+        |   ; message =
+        |       "connection terminated. this request will never receive a response"
+        |   ; kind = Connection_dead
+        |   }
+        \-----------------------------------------------------------------------
+
+
+        ---------------
+        { on_init = Fail; on_terminate = Fail; on_upgrade = Print }
+        server: init
+        server: terminate
+        /-----------------------------------------------------------------------
+        | Internal error: Uncaught exception.
+        | Dune_util__Report_error.Already_reported
+        \-----------------------------------------------------------------------
+
+
+        ---------------
+        { on_init = Fail; on_terminate = Fail; on_upgrade = Fail }
+        server: init
+        server: terminate
+        /-----------------------------------------------------------------------
+        | Internal error: Uncaught exception.
+        | Dune_util__Report_error.Already_reported
+        \-----------------------------------------------------------------------
+
+
+        --------------- |}]
+    ;;
+  end)
+;;
+
+let%expect_test "sexp_for_digest" =
+  let open Dune_rpc_private in
+  let print_sexp_for_digest conv =
+    Pp.to_fmt Format.std_formatter (Sexp.pp (Conv.sexp_for_digest conv))
+  in
+  print_sexp_for_digest
+    (Conv.five
+       (Conv.field "a" (Conv.required Conv.string))
+       (Conv.field "b" (Conv.optional Conv.int))
+       (Conv.field "c" (Conv.required Conv.float))
+       (Conv.field "d" (Conv.required Conv.unit))
+       (Conv.field "e" (Conv.optional Conv.char)));
+  [%expect
+    {|
+      (Iso
+       (Both
+        (Both (Field a (Required String)) (Field b (Optional Int)))
+        (Iso
+         (Both
+          (Field c (Required Float))
+          (Both (Field d (Required Unit)) (Field e (Optional Char))))))) |}];
+  print_sexp_for_digest (Conv.iso Conv.sexp (fun x -> x) (fun x -> x));
+  [%expect {| (Iso Sexp) |}];
+  let id_iso = Conv.iso Conv.sexp (fun x -> x) (fun x -> x) in
+  print_sexp_for_digest
+    (Conv.pair
+       (Conv.version ~until:(1, 2) ~since:(2, 3) id_iso)
+       (Conv.version ~since:(1, 2) id_iso));
+  [%expect
+    {|
+    (Pair
+     (Version (Iso Sexp) (since 2 3) (until 1 2))
+     (Version (Iso Sexp) (since 1 2))) |}];
+  let list_conv inner =
+    Conv.fixpoint (fun conv ->
+      let nil = Conv.constr "nil" Conv.unit (fun () -> []) in
+      let cons = Conv.constr "cons" (Conv.pair inner conv) (fun (x, xs) -> x :: xs) in
+      Conv.sum
+        [ Conv.econstr nil; Conv.econstr cons ]
+        (function
+          | [] -> Conv.case () nil
+          | x :: xs -> Conv.case (x, xs) cons))
+  in
+  print_sexp_for_digest (list_conv Conv.int);
+  [%expect {| (Fixpoint (Sum (nil Unit) (cons (Pair Int (Recurse 0))))) |}];
+  print_sexp_for_digest (list_conv (list_conv Conv.int));
+  (* Recursion uses De Bruijn indices because we want equal structures to
+     produce the same digest. *)
+  [%expect
+    {|
+    (Fixpoint
+     (Sum
+      (nil Unit)
+      (cons
+       (Pair
+        (Fixpoint (Sum (nil Unit) (cons (Pair Int (Recurse 0)))))
+        (Recurse 0))))) |}]
+;;
+
+let%expect_test "print digests for all public RPCs" =
+  let open Dune_rpc_private in
+  Decl.Request.print_generations Procedures.Public.ping;
+  [%expect
+    {|
+    Version 1:
+      Request: Unit
+      Response: Unit
+    |}];
+  Decl.Request.print_generations Procedures.Public.diagnostics;
+  [%expect
+    {|
+    Version 1:
+      Request: Unit
+      Response: ffd3de9652c685594aacfc51d28f2533
+    Version 2:
+      Request: Unit
+      Response: 0d4442e0c36d6727a9acf9aabce6a6ad
+    |}];
+  Decl.Notification.print_generations Procedures.Public.shutdown;
+  [%expect {| Version 1: Unit |}];
+  Decl.Request.print_generations Procedures.Public.format_dune_file;
+  [%expect
+    {|
+    Version 1:
+      Request: 15eae4b546faf05a0fc3b6d03aed0c63
+      Response: String
+    |}];
+  Decl.Request.print_generations Procedures.Public.promote;
+  [%expect
+    {|
+    Version 1:
+      Request: String
+      Response: Unit
+    |}];
+  Decl.Request.print_generations Procedures.Public.build_dir;
+  [%expect
+    {|
+    Version 1:
+      Request: Unit
+      Response: String
+    |}];
+  Decl.Notification.print_generations Procedures.Server_side.abort;
+  [%expect {| Version 1: 0e9dfd1099101769896cf0bb06f891c6 |}];
+  Decl.Notification.print_generations Procedures.Server_side.log;
+  [%expect {| Version 1: 0e9dfd1099101769896cf0bb06f891c6 |}];
+  Decl.Request.print_generations (Procedures.Poll.poll Procedures.Poll.progress);
+  [%expect
+    {|
+    Version 1:
+      Request: Sexp
+      Response: 889aa68f4ad3fc68ef5dfffbb7282c18
+    Version 2:
+      Request: Sexp
+      Response: 929074caab98360dc7116b6f27c2b9ad
+    |}];
+  Decl.Request.print_generations (Procedures.Poll.poll Procedures.Poll.diagnostic);
+  [%expect
+    {|
+    Version 1:
+      Request: Sexp
+      Response: 443627a52ab5595206164d020ff01c56
+    Version 2:
+      Request: Sexp
+      Response: 12995aa06697c01ef35c0339bd2fa29e
+    |}];
+  Decl.Request.print_generations (Procedures.Poll.poll Procedures.Poll.running_jobs);
+  [%expect
+    {|
+    Version 1:
+      Request: Sexp
+      Response: 33528f248084297d123a6ebd4c3ddee0
+    |}]
+;;

unikernel/duniverse/dune_/test/expect-tests/dune_rpc_e2e/dune

@@ -0,0 +1,101 @@
+(env
+ (_
+  (env-vars
+   ; We set ocaml to always be colored since it changes the output of
+   ; ocamlc error messages. See https://github.com/ocaml/ocaml/issues/14144
+   (OCAML_COLOR always))))
+
+(library
+ (name dune_rpc_e2e)
+ (modules dune_rpc_e2e)
+ (libraries
+  dune_rpc_client
+  dune_rpc_private
+  dune_util
+  stdune
+  spawn
+  csexp
+  fiber
+  dune_engine
+  dune_rpc_impl
+  csexp_rpc
+  ;; This is because of the (implicit_transitive_deps false)
+  ;; in dune-project
+  ppx_expect.config
+  ppx_expect.config_types
+  base
+  ppx_inline_test.config)
+ (preprocess
+  (pps ppx_expect)))
+
+(library
+ (name dune_rpc_diagnostics)
+ (modules dune_rpc_diagnostics)
+ (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
+  base
+  ppx_inline_test.config)
+ (preprocess
+  (pps ppx_expect)))
+
+(library
+ (name dune_rpc_registry_test)
+ (modules dune_rpc_registry_test)
+ (inline_tests
+  (deps
+   (package dune)))
+ (libraries
+  dune_rpc_private
+  dune_rpc_e2e
+  dune_engine
+  dune_rpc_impl
+  spawn
+  stdune
+  fiber
+  xdg
+  unix
+  ;; This is because of the (implicit_transitive_deps false)
+  ;; in dune-project
+  ppx_expect.config
+  ppx_expect.config_types
+  base
+  ppx_inline_test.config)
+ (preprocess
+  (pps ppx_expect)))
+
+(library
+ (name dune_rpc_jobs_test)
+ (modules dune_rpc_jobs)
+ (inline_tests
+  ;; this test is flaky
+  (enabled_if false)
+  (deps
+   (package dune)))
+ (libraries
+  fiber
+  stdune
+  dune_rpc_client
+  dune_rpc_e2e
+  dune_rpc_private
+  dune_rpc_impl
+  unix
+  ;; This is because of the (implicit_transitive_deps false)
+  ;; in dune-project
+  ppx_expect.config
+  ppx_expect.config_types
+  base
+  ppx_inline_test.config)
+ (preprocess
+  (pps ppx_expect)))

unikernel/duniverse/dune_/test/expect-tests/dune_rpc_e2e/dune_rpc_diagnostics.ml

@@ -0,0 +1,819 @@
+open Stdune
+open Fiber.O
+module Client = Dune_rpc_client.Client
+open Dune_rpc_e2e
+module Dune_rpc = Dune_rpc_private
+module Sub = Dune_rpc.Sub
+module Diagnostic = Dune_rpc.Diagnostic
+module Request = Dune_rpc.Public.Request
+module Response = Dune_rpc.Response
+
+let%expect_test "turn on and shutdown" =
+  let test () =
+    with_dune_watch (fun _pid ->
+      run_client (fun client ->
+        let+ () = dune_build client "." in
+        printfn "shutting down"))
+  in
+  run test;
+  [%expect
+    {|
+    Building .
+    Build . succeeded
+    shutting down |}]
+;;
+
+let files = List.iter ~f:(fun (f, contents) -> Io.String_path.write_file f contents)
+
+let on_diagnostic_event diagnostics =
+  let cwd = Sys.getcwd () in
+  let sanitize_path path =
+    match String.drop_prefix path ~prefix:cwd with
+    | None -> path
+    | Some s -> "$CWD" ^ s
+  in
+  let sanitize_pp pp = Pp.verbatim (Format.asprintf "%a@." Pp.to_fmt pp) in
+  let sanitize_loc =
+    let sanitize_position (p : Lexing.position) =
+      { p with pos_fname = sanitize_path p.pos_fname }
+    in
+    fun (loc : Lexbuf.Loc.t) ->
+      Loc.of_lexbuf_loc loc |> Loc.map_pos ~f:sanitize_position |> Loc.to_lexbuf_loc
+  in
+  (* function to remove remove pp tags and hide junk from paths *)
+  let map_event (d : Diagnostic.Event.t) f : Diagnostic.Event.t =
+    match d with
+    | Remove e -> Remove (f e)
+    | Add e -> Add (f e)
+  in
+  let sanitize (d : Diagnostic.t) =
+    let directory = Option.map d.directory ~f:sanitize_path in
+    let promotion =
+      List.map d.promotion ~f:(fun (p : Diagnostic.Promotion.t) ->
+        let in_build = sanitize_path p.in_build in
+        let in_source = sanitize_path p.in_source in
+        { Diagnostic.Promotion.in_build; in_source })
+    in
+    let related =
+      List.map d.related ~f:(fun (related : Diagnostic.Related.t) ->
+        let loc = sanitize_loc related.loc in
+        let message = sanitize_pp related.message in
+        { Diagnostic.Related.message; loc })
+    in
+    { d with
+      message = sanitize_pp d.message
+    ; loc = Option.map d.loc ~f:sanitize_loc
+    ; directory
+    ; promotion
+    ; related
+    }
+  in
+  if List.is_empty diagnostics
+  then print_endline "<no diagnostics>"
+  else
+    List.iter diagnostics ~f:(fun (e : Diagnostic.Event.t) ->
+      (match e with
+       | Remove _ -> ()
+       | Add e ->
+         Diagnostic.promotion e
+         |> List.iter ~f:(fun promotion ->
+           let path = Diagnostic.Promotion.in_build promotion in
+           if not (Sys.file_exists path)
+           then printfn "FAILURE: promotion file %s does not exist" (sanitize_path path)));
+      let e = map_event e sanitize in
+      printfn "%s" (Dyn.to_string (Diagnostic.Event.to_dyn e)))
+;;
+
+let setup_diagnostics f =
+  let exec _pid =
+    run_client (fun client ->
+      (* First we test for regular errors *)
+      files [ "dune-project", "(lang dune 3.0)" ];
+      f client)
+  in
+  run (fun () -> with_dune_watch exec)
+;;
+
+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_diagnostics poll =
+  let+ res = Client.Stream.next poll in
+  match res with
+  | None -> printfn "client: no more diagnostics"
+  | Some diag -> on_diagnostic_event diag
+;;
+
+let diagnostic_with_build setup target =
+  let exec _pid =
+    run_client (fun client ->
+      (* First we test for regular errors *)
+      files (("dune-project", "(lang dune 3.0)") :: setup);
+      let* () = dune_build client target in
+      let* poll = poll_exn client Dune_rpc.Public.Sub.diagnostic in
+      let* () = print_diagnostics poll in
+      Client.Stream.cancel poll)
+  in
+  run (fun () -> with_dune_watch exec)
+;;
+
+let%expect_test "error in dune file" =
+  diagnostic_with_build [ "dune", "(library (name foo))" ] "foo.cma";
+  [%expect
+    {|
+    Building foo.cma
+    Build foo.cma succeeded
+    <no diagnostics> |}]
+;;
+
+let%expect_test "related error" =
+  diagnostic_with_build
+    [ "dune", "(library (name foo))"; "foo.mli", "val x : int"; "foo.ml", "let x = true" ]
+    "foo.cma";
+  [%expect
+    {|
+    Building foo.cma
+    Build foo.cma failed
+    [ "Add"
+    ; [ [ "directory"; "$CWD" ]
+      ; [ "id"; "0" ]
+      ; [ "loc"
+        ; [ [ "start"
+            ; [ [ "pos_bol"; "0" ]
+              ; [ "pos_cnum"; "0" ]
+              ; [ "pos_fname"; "$CWD/foo.ml" ]
+              ; [ "pos_lnum"; "1" ]
+              ]
+            ]
+          ; [ "stop"
+            ; [ [ "pos_bol"; "0" ]
+              ; [ "pos_cnum"; "0" ]
+              ; [ "pos_fname"; "$CWD/foo.ml" ]
+              ; [ "pos_lnum"; "1" ]
+              ]
+            ]
+          ]
+        ]
+      ; [ "message"
+        ; [ "Verbatim"
+          ; "The implementation foo.ml does not match the interface foo.mli: \n\
+             Values do not match: val x : bool is not included in val x : int\n\
+             The type bool is not compatible with the type int\n\
+             "
+          ]
+        ]
+      ; [ "promotion"; [] ]
+      ; [ "related"
+        ; [ [ [ "loc"
+              ; [ [ "start"
+                  ; [ [ "pos_bol"; "0" ]
+                    ; [ "pos_cnum"; "0" ]
+                    ; [ "pos_fname"; "$CWD/foo.mli" ]
+                    ; [ "pos_lnum"; "1" ]
+                    ]
+                  ]
+                ; [ "stop"
+                  ; [ [ "pos_bol"; "0" ]
+                    ; [ "pos_cnum"; "11" ]
+                    ; [ "pos_fname"; "$CWD/foo.mli" ]
+                    ; [ "pos_lnum"; "1" ]
+                    ]
+                  ]
+                ]
+              ]
+            ; [ "message"; [ "Verbatim"; "Expected declaration\n\
+                                          " ] ]
+            ]
+          ; [ [ "loc"
+              ; [ [ "start"
+                  ; [ [ "pos_bol"; "0" ]
+                    ; [ "pos_cnum"; "4" ]
+                    ; [ "pos_fname"; "$CWD/foo.ml" ]
+                    ; [ "pos_lnum"; "1" ]
+                    ]
+                  ]
+                ; [ "stop"
+                  ; [ [ "pos_bol"; "0" ]
+                    ; [ "pos_cnum"; "5" ]
+                    ; [ "pos_fname"; "$CWD/foo.ml" ]
+                    ; [ "pos_lnum"; "1" ]
+                    ]
+                  ]
+                ]
+              ]
+            ; [ "message"; [ "Verbatim"; "Actual declaration\n\
+                                          " ] ]
+            ]
+          ]
+        ]
+      ; [ "severity"; "error" ]
+      ; [ "targets"; [] ]
+      ]
+    ]
+    |}];
+  diagnostic_with_build
+    [ "dune", "(library (name foo)) (executable (name foo))"; "foo.ml", "" ]
+    "@check";
+  [%expect
+    {|
+    Building @check
+    Build @check failed
+    [ "Add"
+    ; [ [ "id"; "0" ]
+      ; [ "loc"
+        ; [ [ "start"
+            ; [ [ "pos_bol"; "0" ]
+              ; [ "pos_cnum"; "0" ]
+              ; [ "pos_fname"; "$CWD/dune" ]
+              ; [ "pos_lnum"; "1" ]
+              ]
+            ]
+          ; [ "stop"
+            ; [ [ "pos_bol"; "0" ]
+              ; [ "pos_cnum"; "20" ]
+              ; [ "pos_fname"; "$CWD/dune" ]
+              ; [ "pos_lnum"; "1" ]
+              ]
+            ]
+          ]
+        ]
+      ; [ "message"
+        ; [ "Verbatim"; "Module \"Foo\" is used in several stanzas:\n\
+                         " ]
+        ]
+      ; [ "promotion"; [] ]
+      ; [ "related"
+        ; [ [ [ "loc"
+              ; [ [ "start"
+                  ; [ [ "pos_bol"; "0" ]
+                    ; [ "pos_cnum"; "21" ]
+                    ; [ "pos_fname"; "$CWD/dune" ]
+                    ; [ "pos_lnum"; "1" ]
+                    ]
+                  ]
+                ; [ "stop"
+                  ; [ [ "pos_bol"; "0" ]
+                    ; [ "pos_cnum"; "44" ]
+                    ; [ "pos_fname"; "$CWD/dune" ]
+                    ; [ "pos_lnum"; "1" ]
+                    ]
+                  ]
+                ]
+              ]
+            ; [ "message"; [ "Verbatim"; "Used in this\n\
+                                          stanza\n\
+                                          " ] ]
+            ]
+          ]
+        ]
+      ; [ "severity"; "error" ]
+      ; [ "targets"; [] ]
+      ]
+    ] |}]
+;;
+
+let%expect_test "promotion" =
+  diagnostic_with_build
+    [ ( "dune"
+      , {|
+(rule (alias foo) (action (diff x x.gen)))
+(rule (with-stdout-to x.gen (echo "toto")))
+|}
+      )
+    ; "x", "titi"
+    ]
+    "(alias foo)";
+  [%expect
+    {|
+    Building (alias foo)
+    Build (alias foo) failed
+    [ "Add"
+    ; [ [ "id"; "0" ]
+      ; [ "loc"
+        ; [ [ "start"
+            ; [ [ "pos_bol"; "0" ]
+              ; [ "pos_cnum"; "0" ]
+              ; [ "pos_fname"; "$CWD/x" ]
+              ; [ "pos_lnum"; "1" ]
+              ]
+            ]
+          ; [ "stop"
+            ; [ [ "pos_bol"; "0" ]
+              ; [ "pos_cnum"; "0" ]
+              ; [ "pos_fname"; "$CWD/x" ]
+              ; [ "pos_lnum"; "1" ]
+              ]
+            ]
+          ]
+        ]
+      ; [ "message"
+        ; [ "Verbatim"
+          ; "Error: Files _build/default/x and _build/default/x.gen differ.\n\
+             "
+          ]
+        ]
+      ; [ "promotion"
+        ; [ [ [ "in_build"; "$CWD/_build/default/x.gen" ]
+            ; [ "in_source"; "$CWD/x" ]
+            ]
+          ]
+        ]
+      ; [ "related"; [] ]
+      ; [ "severity"; "error" ]
+      ; [ "targets"; [] ]
+      ]
+    ] |}]
+;;
+
+let%expect_test "optional promotion" =
+  diagnostic_with_build
+    [ ( "dune"
+      , {|
+(rule
+ (alias foo)
+ (action
+  (progn
+   (with-stdout-to output.expected (echo "foo"))
+   (with-stdout-to output.actual (echo "bar"))
+   (diff? output.expected output.actual))))
+|}
+      )
+    ]
+    "(alias foo)";
+  [%expect
+    {|
+    Building (alias foo)
+    Build (alias foo) failed
+    FAILURE: promotion file $CWD/_build/default/output.actual does not exist
+    [ "Add"
+    ; [ [ "id"; "0" ]
+      ; [ "loc"
+        ; [ [ "start"
+            ; [ [ "pos_bol"; "0" ]
+              ; [ "pos_cnum"; "0" ]
+              ; [ "pos_fname"; "$CWD/output.expected" ]
+              ; [ "pos_lnum"; "1" ]
+              ]
+            ]
+          ; [ "stop"
+            ; [ [ "pos_bol"; "0" ]
+              ; [ "pos_cnum"; "0" ]
+              ; [ "pos_fname"; "$CWD/output.expected" ]
+              ; [ "pos_lnum"; "1" ]
+              ]
+            ]
+          ]
+        ]
+      ; [ "message"
+        ; [ "Verbatim"
+          ; "Error: Files _build/default/output.expected and _build/default/output.actual\n\
+             differ.\n\
+             "
+          ]
+        ]
+      ; [ "promotion"
+        ; [ [ [ "in_build"; "$CWD/_build/default/output.actual" ]
+            ; [ "in_source"; "$CWD/output.expected" ]
+            ]
+          ]
+        ]
+      ; [ "related"; [] ]
+      ; [ "severity"; "error" ]
+      ; [ "targets"; [] ]
+      ]
+    ] |}]
+;;
+
+let%expect_test "warning detection" =
+  diagnostic_with_build
+    [ "dune", "(executable (flags -w +26) (name foo))"
+    ; "foo.ml", "let () = let x = 10 in ()"
+    ]
+    "./foo.exe";
+  [%expect
+    {|
+    Building ./foo.exe
+    Build ./foo.exe succeeded
+    <no diagnostics> |}]
+;;
+
+let%expect_test "error from user rule" =
+  diagnostic_with_build
+    [ "dune", "(rule (target foo) (action (bash \"echo foobar\")))" ]
+    "./foo";
+  [%expect
+    {|
+    Building ./foo
+    Build ./foo failed
+    [ "Add"
+    ; [ [ "id"; "0" ]
+      ; [ "loc"
+        ; [ [ "start"
+            ; [ [ "pos_bol"; "0" ]
+              ; [ "pos_cnum"; "0" ]
+              ; [ "pos_fname"; "$CWD/dune" ]
+              ; [ "pos_lnum"; "1" ]
+              ]
+            ]
+          ; [ "stop"
+            ; [ [ "pos_bol"; "0" ]
+              ; [ "pos_cnum"; "49" ]
+              ; [ "pos_fname"; "$CWD/dune" ]
+              ; [ "pos_lnum"; "1" ]
+              ]
+            ]
+          ]
+        ]
+      ; [ "message"
+        ; [ "Verbatim"
+          ; "Error: Rule failed to generate the following targets:\n\
+             - foo\n\
+             "
+          ]
+        ]
+      ; [ "promotion"; [] ]
+      ; [ "related"; [] ]
+      ; [ "severity"; "error" ]
+      ; [ "targets"; [] ]
+      ]
+    ] |}]
+;;
+
+let%expect_test "library error location" =
+  diagnostic_with_build
+    [ "dune", "(library (name foo) (libraries fake-library))"; "foo.ml", "" ]
+    "./foo.cma";
+  [%expect
+    {|
+    Building ./foo.cma
+    Build ./foo.cma failed
+    [ "Add"
+    ; [ [ "id"; "0" ]
+      ; [ "loc"
+        ; [ [ "start"
+            ; [ [ "pos_bol"; "0" ]
+              ; [ "pos_cnum"; "31" ]
+              ; [ "pos_fname"; "$CWD/dune" ]
+              ; [ "pos_lnum"; "1" ]
+              ]
+            ]
+          ; [ "stop"
+            ; [ [ "pos_bol"; "0" ]
+              ; [ "pos_cnum"; "43" ]
+              ; [ "pos_fname"; "$CWD/dune" ]
+              ; [ "pos_lnum"; "1" ]
+              ]
+            ]
+          ]
+        ]
+      ; [ "message"
+        ; [ "Verbatim"; "Error: Library \"fake-library\" not found.\n\
+                         " ]
+        ]
+      ; [ "promotion"; [] ]
+      ; [ "related"; [] ]
+      ; [ "severity"; "error" ]
+      ; [ "targets"; [] ]
+      ]
+    ] |}]
+;;
+
+let%expect_test "create and fix error" =
+  setup_diagnostics (fun client ->
+    files [ "dune", "(executable (name foo))"; "foo.ml", "let () = print_endline 123" ];
+    let* poll = poll_exn client Dune_rpc.Public.Sub.diagnostic in
+    let* () = print_diagnostics poll in
+    [%expect
+      {|
+        <no diagnostics> |}];
+    let* () = dune_build client "./foo.exe" in
+    [%expect
+      {|
+        Building ./foo.exe
+        Build ./foo.exe failed |}];
+    let* () = print_diagnostics poll in
+    [%expect
+      {|
+      [ "Add"
+      ; [ [ "directory"; "$CWD" ]
+        ; [ "id"; "0" ]
+        ; [ "loc"
+          ; [ [ "start"
+              ; [ [ "pos_bol"; "0" ]
+                ; [ "pos_cnum"; "23" ]
+                ; [ "pos_fname"; "$CWD/foo.ml" ]
+                ; [ "pos_lnum"; "1" ]
+                ]
+              ]
+            ; [ "stop"
+              ; [ [ "pos_bol"; "0" ]
+                ; [ "pos_cnum"; "26" ]
+                ; [ "pos_fname"; "$CWD/foo.ml" ]
+                ; [ "pos_lnum"; "1" ]
+                ]
+              ]
+            ]
+          ]
+        ; [ "message"
+          ; [ "Verbatim"
+            ; "The constant 123 has type int but an expression was expected of type\n\
+              \  string\n\
+               "
+            ]
+          ]
+        ; [ "promotion"; [] ]
+        ; [ "related"; [] ]
+        ; [ "severity"; "error" ]
+        ; [ "targets"; [] ]
+        ]
+      ]
+      |}];
+    files [ "foo.ml", "let () = print_endline \"foo\"" ];
+    let* () = dune_build client "./foo.exe" in
+    [%expect
+      {|
+        Building ./foo.exe
+        Build ./foo.exe succeeded |}];
+    let+ () = print_diagnostics poll in
+    [%expect
+      {|
+      [ "Remove"
+      ; [ [ "directory"; "$CWD" ]
+        ; [ "id"; "0" ]
+        ; [ "loc"
+          ; [ [ "start"
+              ; [ [ "pos_bol"; "0" ]
+                ; [ "pos_cnum"; "23" ]
+                ; [ "pos_fname"; "$CWD/foo.ml" ]
+                ; [ "pos_lnum"; "1" ]
+                ]
+              ]
+            ; [ "stop"
+              ; [ [ "pos_bol"; "0" ]
+                ; [ "pos_cnum"; "26" ]
+                ; [ "pos_fname"; "$CWD/foo.ml" ]
+                ; [ "pos_lnum"; "1" ]
+                ]
+              ]
+            ]
+          ]
+        ; [ "message"
+          ; [ "Verbatim"
+            ; "The constant 123 has type int but an expression was expected of type\n\
+              \  string\n\
+               "
+            ]
+          ]
+        ; [ "promotion"; [] ]
+        ; [ "related"; [] ]
+        ; [ "severity"; "error" ]
+        ; [ "targets"; [] ]
+        ]
+      ]
+      |}]);
+  [%expect {| |}]
+;;
+
+let request_exn client req n =
+  let* staged = Client.Versioned.prepare_request client req in
+  match staged with
+  | Ok req -> Client.request client req n
+  | Error e -> raise (Dune_rpc.Version_error.E e)
+;;
+
+let%expect_test "formatting dune files" =
+  let exec _pid =
+    run_client (fun client ->
+      (* First we test for regular errors *)
+      files [ "dune-project", "(lang dune 3.0)" ];
+      let unformatted = "(\nlibrary (name foo\n))" in
+      printfn "Unformatted:\n%s" unformatted;
+      let run uri what =
+        let+ res =
+          request_exn client Request.format_dune_file (uri, `Contents unformatted)
+        in
+        match res with
+        | Ok s -> printfn "Formatted (%s):\n%s" what s
+        | Error e ->
+          Format.eprintf
+            "Error formatting:@.%s@."
+            (Dyn.to_string (Response.Error.to_dyn e))
+      in
+      let* () = run Dune_rpc.Path.(relative dune_root "dune") "relative" in
+      [%expect
+        {|
+          Unformatted:
+          (
+          library (name foo
+          ))
+          Formatted (relative):
+          (library
+           (name foo)) |}];
+      let+ () =
+        run (Dune_rpc.Path.absolute (Filename.concat (Sys.getcwd ()) "dune")) "absolute"
+      in
+      [%expect
+        {|
+          Formatted (absolute):
+          (library
+           (name foo)) |}])
+  in
+  run (fun () -> with_dune_watch exec);
+  [%expect {| |}]
+;;
+
+let%expect_test "promoting dune files" =
+  let exec _pid =
+    run_client (fun client ->
+      (* First we test for regular errors *)
+      let fname = "x" in
+      let promoted = "x.gen" in
+      files
+        [ "dune-project", "(lang dune 3.0)"
+        ; "x", "titi"
+        ; ( "dune"
+          , sprintf
+              {|
+(rule (alias foo) (action (diff %s %s)))
+(rule (with-stdout-to %s (echo "toto")))
+|}
+              fname
+              promoted
+              promoted )
+        ];
+      let* () = dune_build client "(alias foo)" in
+      [%expect
+        {|
+          Building (alias foo)
+          Build (alias foo) failed |}];
+      print_endline "attempting to promote";
+      let+ res =
+        request_exn client Request.promote Dune_rpc.Path.(relative dune_root fname)
+      in
+      (match res with
+       | Ok () ->
+         let contents = Io.String_path.read_file fname in
+         printfn "promoted file contents:\n%s" contents
+       | Error e ->
+         Format.eprintf
+           "Error formatting:@.%s@."
+           (Dyn.to_string (Dune_rpc.Response.Error.to_dyn e)));
+      [%expect
+        {|
+          attempting to promote
+          promoted file contents:
+          toto |}])
+  in
+  run (fun () -> with_dune_watch exec);
+  [%expect {| |}]
+;;
+
+let%expect_test "multiple errors in one file" =
+  let source =
+    {|
+module A : sig
+
+  val f : unit
+  [@@alert foo "foobar"]
+
+end = struct
+  let f = ()
+end
+
+let f = A.f
+let g = A.f
+|}
+  in
+  setup_diagnostics (fun client ->
+    files [ "dune", "(executable (name foo))"; "foo.ml", source ];
+    let* poll = poll_exn client Dune_rpc.Public.Sub.diagnostic in
+    let* () = print_diagnostics poll in
+    [%expect
+      {|
+        <no diagnostics> |}];
+    let* () = dune_build client "./foo.exe" in
+    [%expect
+      {|
+        Building ./foo.exe
+        Build ./foo.exe failed |}];
+    let+ () = print_diagnostics poll in
+    [%expect
+      {|
+        [ "Add"
+        ; [ [ "directory"; "$CWD" ]
+          ; [ "id"; "0" ]
+          ; [ "loc"
+            ; [ [ "start"
+                ; [ [ "pos_bol"; "0" ]
+                  ; [ "pos_cnum"; "8" ]
+                  ; [ "pos_fname"; "$CWD/foo.ml" ]
+                  ; [ "pos_lnum"; "11" ]
+                  ]
+                ]
+              ; [ "stop"
+                ; [ [ "pos_bol"; "0" ]
+                  ; [ "pos_cnum"; "11" ]
+                  ; [ "pos_fname"; "$CWD/foo.ml" ]
+                  ; [ "pos_lnum"; "11" ]
+                  ]
+                ]
+              ]
+            ]
+          ; [ "message"; [ "Verbatim"; "foobar\n\
+                                        " ] ]
+          ; [ "promotion"; [] ]
+          ; [ "related"; [] ]
+          ; [ "severity"; "error" ]
+          ; [ "targets"; [] ]
+          ]
+        ]
+        [ "Add"
+        ; [ [ "directory"; "$CWD" ]
+          ; [ "id"; "1" ]
+          ; [ "loc"
+            ; [ [ "start"
+                ; [ [ "pos_bol"; "0" ]
+                  ; [ "pos_cnum"; "8" ]
+                  ; [ "pos_fname"; "$CWD/foo.ml" ]
+                  ; [ "pos_lnum"; "12" ]
+                  ]
+                ]
+              ; [ "stop"
+                ; [ [ "pos_bol"; "0" ]
+                  ; [ "pos_cnum"; "11" ]
+                  ; [ "pos_fname"; "$CWD/foo.ml" ]
+                  ; [ "pos_lnum"; "12" ]
+                  ]
+                ]
+              ]
+            ]
+          ; [ "message"; [ "Verbatim"; "foobar\n\
+                                        " ] ]
+          ; [ "promotion"; [] ]
+          ; [ "related"; [] ]
+          ; [ "severity"; "error" ]
+          ; [ "targets"; [] ]
+          ]
+        ]
+        [ "Add"
+        ; [ [ "directory"; "$CWD" ]
+          ; [ "id"; "2" ]
+          ; [ "loc"
+            ; [ [ "start"
+                ; [ [ "pos_bol"; "0" ]
+                  ; [ "pos_cnum"; "4" ]
+                  ; [ "pos_fname"; "$CWD/foo.ml" ]
+                  ; [ "pos_lnum"; "11" ]
+                  ]
+                ]
+              ; [ "stop"
+                ; [ [ "pos_bol"; "0" ]
+                  ; [ "pos_cnum"; "5" ]
+                  ; [ "pos_fname"; "$CWD/foo.ml" ]
+                  ; [ "pos_lnum"; "11" ]
+                  ]
+                ]
+              ]
+            ]
+          ; [ "message"; [ "Verbatim"; "unused value f.\n\
+                                        " ] ]
+          ; [ "promotion"; [] ]
+          ; [ "related"; [] ]
+          ; [ "severity"; "error" ]
+          ; [ "targets"; [] ]
+          ]
+        ]
+        [ "Add"
+        ; [ [ "directory"; "$CWD" ]
+          ; [ "id"; "3" ]
+          ; [ "loc"
+            ; [ [ "start"
+                ; [ [ "pos_bol"; "0" ]
+                  ; [ "pos_cnum"; "4" ]
+                  ; [ "pos_fname"; "$CWD/foo.ml" ]
+                  ; [ "pos_lnum"; "12" ]
+                  ]
+                ]
+              ; [ "stop"
+                ; [ [ "pos_bol"; "0" ]
+                  ; [ "pos_cnum"; "5" ]
+                  ; [ "pos_fname"; "$CWD/foo.ml" ]
+                  ; [ "pos_lnum"; "12" ]
+                  ]
+                ]
+              ]
+            ]
+          ; [ "message"; [ "Verbatim"; "unused value g.\n\
+                                        " ] ]
+          ; [ "promotion"; [] ]
+          ; [ "related"; [] ]
+          ; [ "severity"; "error" ]
+          ; [ "targets"; [] ]
+          ]
+        ] |}]);
+  [%expect {||}]
+;;

unikernel/duniverse/dune_/test/expect-tests/dune_rpc_e2e/dune_rpc_e2e.ml

@@ -0,0 +1,199 @@
+open Stdune
+open Fiber.O
+module Scheduler = Dune_engine.Scheduler
+module Dune_rpc = Dune_rpc_private
+module Request = Dune_rpc.Public.Request
+module Diagnostic = Dune_rpc.Diagnostic
+module Client = Dune_rpc_client.Client
+module Session = Csexp_rpc.Session
+
+(* enable to debug process stdout/stderr *)
+let debug = false
+let () = if debug then Dune_util.Log.init ~file:Stderr ()
+
+let dune_prog =
+  lazy
+    (let path = Env_path.path Env.initial in
+     Bin.which ~path "dune" |> Option.value_exn |> Path.to_absolute_filename)
+;;
+
+let init_chan ~root_dir =
+  let build_dir = Filename.concat root_dir "_build" in
+  let once () =
+    let env = Env.get Env.initial in
+    match Dune_rpc_impl.Where.Where.get ~env ~build_dir with
+    | Error exn -> Exn.raise exn
+    | Ok None -> Fiber.return None
+    | Ok (Some where) ->
+      let+ conn = Client.Connection.connect where in
+      (match conn with
+       | Ok s -> Some s
+       | Error _ -> None)
+  in
+  let rec loop () =
+    let* res = once () in
+    match res with
+    | Some res -> Fiber.return res
+    | None -> Scheduler.sleep ~seconds:0.2 >>= loop
+  in
+  loop ()
+;;
+
+let request_exn client witness n =
+  let* staged = Client.Versioned.prepare_request client witness in
+  let staged =
+    match staged with
+    | Ok s -> s
+    | Error e -> raise (Dune_rpc.Version_error.E e)
+  in
+  Client.request client staged n
+;;
+
+let notification_exn client witness n =
+  let* staged = Client.Versioned.prepare_notification client witness in
+  let staged =
+    match staged with
+    | Ok s -> s
+    | Error e -> raise (Dune_rpc.Version_error.E e)
+  in
+  Client.notification client staged n
+;;
+
+let run_client ?handler f =
+  let* chan = init_chan ~root_dir:"." in
+  let initialize =
+    let id = Dune_rpc.Id.make (Atom "test") in
+    Dune_rpc.Initialize.Request.create ~id
+  in
+  Dune_rpc_impl.Client.client ?handler chan initialize ~f:(fun client ->
+    Fiber.finalize
+      (fun () -> f client)
+      ~finally:(fun () ->
+        notification_exn client Dune_rpc.Public.Notification.shutdown ()))
+;;
+
+let read_lines in_ =
+  let in_ = Unix.in_channel_of_descr in_ in
+  let rec loop acc =
+    let* res = Scheduler.async (fun () -> input_line in_) in
+    match res with
+    | Ok a -> loop (a :: acc)
+    | Error e ->
+      (match e.exn with
+       | End_of_file -> ()
+       | _ ->
+         Format.eprintf "Error reading channel: %a@.%!" Exn_with_backtrace.pp_uncaught e);
+      Fiber.return (String.concat (List.rev acc) ~sep:"\n")
+  in
+  let+ res = loop [] in
+  close_in_noerr in_;
+  res
+;;
+
+let run ?env ~prog ~argv () =
+  let stdout_i, stdout_w = Unix.pipe ~cloexec:true () in
+  let stderr_i, stderr_w = Unix.pipe ~cloexec:true () in
+  let pid =
+    let argv = prog :: argv in
+    let env = Option.map ~f:Spawn.Env.of_list env in
+    Spawn.spawn
+      ~prog
+      ~argv
+      ~stdout:stdout_w
+      ~stderr:stderr_w
+      ~stdin:(Lazy.force Dev_null.in_)
+      ?env
+      ()
+    |> Pid.of_int
+  in
+  Unix.close stdout_w;
+  Unix.close stderr_w;
+  ( pid
+  , (let+ proc = Scheduler.wait_for_process ~timeout_seconds:3.0 pid in
+     if proc.status <> Unix.WEXITED 0
+     then (
+       let name =
+         sprintf "%s %s" ("$PATH/" ^ Filename.basename prog) (String.concat ~sep:" " argv)
+       in
+       match proc.status with
+       | Unix.WEXITED i -> printfn "%s returned %d" name i
+       | Unix.WSIGNALED i -> printfn "%s received signal %i" name i
+       | _ -> assert false))
+  , read_lines stdout_i
+  , read_lines stderr_i )
+;;
+
+let run_server ?(watch_mode_args = [ "--passive-watch-mode" ]) ?env ~root_dir () =
+  run
+    ?env
+    ~prog:(Lazy.force dune_prog)
+    ~argv:([ "build"; "--root"; root_dir ] @ watch_mode_args)
+    ()
+;;
+
+let dune_build client what =
+  printfn "Building %s" what;
+  let+ res =
+    request_exn client (Dune_rpc.Decl.Request.witness Dune_rpc_impl.Decl.build) [ what ]
+  in
+  match res with
+  | Error e ->
+    Format.eprintf
+      "Error building %s:@.%s@."
+      what
+      (Dyn.to_string (Dune_rpc.Response.Error.to_dyn e))
+  | Ok res ->
+    printfn
+      "Build %s %s"
+      what
+      (match res with
+       | Success -> "succeeded"
+       | Failure _ -> "failed")
+;;
+
+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 ?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))
+      (fun () -> Fiber.fork_and_join (fun () -> server_stdout) (fun () -> server_stderr))
+  in
+  (* We wait until the tests finish to print stdout and stderr for determinism.
+     But this has the disadvantage that the fiber above will not always
+     terminate for failed tests. Thus, the output below will never be shown. *)
+  if debug
+  then (
+    if stdout <> "" then printfn "stdout:\n%s" stdout;
+    if stderr <> "" then printfn "stderr:\n%s" stderr);
+  res
+;;
+
+let config =
+  Dune_engine.Clflags.display := Quiet;
+  { Scheduler.Config.concurrency = 1
+  ; stats = None
+  ; print_ctrl_c_warning = false
+  ; watch_exclusions = []
+  }
+;;
+
+let run run =
+  let cwd = Sys.getcwd () in
+  let dir = Temp.create Dir ~prefix:"dune" ~suffix:"rpc_test" in
+  let run () =
+    Fiber.with_error_handler run ~on_error:(fun exn ->
+      Exn_with_backtrace.pp_uncaught Format.err_formatter exn;
+      Format.pp_print_flush Format.err_formatter ();
+      Exn_with_backtrace.reraise exn)
+  in
+  Exn.protect
+    ~finally:(fun () -> Sys.chdir cwd)
+    ~f:(fun () ->
+      Sys.chdir (Path.to_string dir);
+      Scheduler.Run.go config run ~timeout_seconds:5.0 ~on_event:(fun _ _ -> ()))
+;;

unikernel/duniverse/dune_/test/expect-tests/dune_rpc_e2e/dune_rpc_e2e.mli

@@ -0,0 +1,16 @@
+open Stdune
+
+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
+  :  ?handler:Dune_rpc_client.Client.Handler.t
+  -> (Dune_rpc_client.Client.t -> 'a Fiber.t)
+  -> 'a Fiber.t
+
+val run : (unit -> 'a Fiber.t) -> 'a

unikernel/duniverse/dune_/test/expect-tests/dune_rpc_e2e/dune_rpc_jobs.ml

@@ -0,0 +1,85 @@
+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...
+    Stop 1
+    Start 2 _build/default/foo |}]
+;;

unikernel/duniverse/dune_/test/expect-tests/dune_rpc_e2e/dune_rpc_registry_test.ml

@@ -0,0 +1,110 @@
+open Stdune
+open Fiber.O
+module Where = Dune_rpc_private.Where
+module Registry = Dune_rpc_private.Registry
+module Scheduler = Dune_engine.Scheduler
+module Poll_active = Dune_rpc_impl.Poll_active
+open Dune_rpc_e2e
+
+let try_ ~times ~delay_seconds ~f =
+  let rec loop = function
+    | 0 -> Fiber.return None
+    | n ->
+      let* res = f () in
+      (match res with
+       | Some s -> Fiber.return (Some s)
+       | None ->
+         let* () = Scheduler.sleep ~seconds:delay_seconds in
+         loop (n - 1))
+  in
+  loop times
+;;
+
+let run =
+  let cwd = Sys.getcwd () in
+  Dune_engine.Clflags.display := Quiet;
+  let config =
+    { Scheduler.Config.concurrency = 1
+    ; stats = None
+    ; print_ctrl_c_warning = false
+    ; watch_exclusions = []
+    }
+  in
+  fun run ->
+    let dir = Temp.create Dir ~prefix:"dune" ~suffix:"rpc_test" in
+    let run () =
+      Fiber.with_error_handler run ~on_error:(fun exn ->
+        Exn_with_backtrace.pp_uncaught Format.err_formatter exn;
+        Format.pp_print_flush Format.err_formatter ();
+        Exn_with_backtrace.reraise exn)
+    in
+    Exn.protect
+      ~finally:(fun () -> Sys.chdir cwd)
+      ~f:(fun () ->
+        Sys.chdir (Path.to_string dir);
+        Scheduler.Run.go config run ~timeout_seconds:5.0 ~on_event:(fun _ _ -> ()))
+;;
+
+let%expect_test "turn on dune watch and wait until the connection is listed" =
+  let case () =
+    let runtime_dir = "_runtime_dir" in
+    Unix.mkdir runtime_dir 0o777;
+    let xdg_runtime_dir = Filename.concat "." runtime_dir in
+    let config =
+      Registry.Config.create
+        (Xdg.create
+           ~env:(function
+             | "XDG_RUNTIME_DIR" -> Some xdg_runtime_dir
+             | _ -> None)
+           ())
+    in
+    let poll = Registry.create config in
+    let+ dune =
+      let env =
+        ("XDG_RUNTIME_DIR=" ^ xdg_runtime_dir) :: Array.to_list (Unix.environment ())
+      in
+      with_dune_watch ~env (fun pid ->
+        let+ res =
+          try_ ~times:5 ~delay_seconds:0.2 ~f:(fun () ->
+            let+ refresh = Poll_active.poll poll in
+            match refresh with
+            | Error _ -> None
+            | Ok r ->
+              if List.is_non_empty (Registry.Refresh.removed r)
+              then Code_error.raise "removed should be empty" [];
+              (match Registry.Refresh.errored r with
+               | [] -> ()
+               | errors ->
+                 List.map errors ~f:(fun (name, exn) -> name, Exn.to_dyn exn)
+                 |> Code_error.raise "errored should be empty");
+              (match Registry.Refresh.added r with
+               | [ a ] -> Some a
+               | [] -> None
+               | _ :: _ ->
+                 Code_error.raise "added returned more than one dune instance" []))
+        in
+        Unix.kill (Stdune.Pid.to_int pid) Sys.sigint;
+        res)
+    in
+    match dune with
+    | None -> printfn "[FAILURE] unable to find connection"
+    | Some dune ->
+      let root = Registry.Dune.root dune in
+      let where =
+        match Registry.Dune.where dune with
+        | `Ip (host, port) -> `Ip (host, port)
+        | `Unix path ->
+          let cwd = Sys.getcwd () in
+          `Unix
+            (match String.drop_prefix path ~prefix:cwd with
+             | None -> path
+             | Some s -> "$CWD" ^ s)
+      in
+      printfn "[PASS] found %s at %s" root (Where.to_string where)
+  in
+  run case;
+  [%expect
+    {|
+    $PATH/dune build --root . --passive-watch-mode returned 130
+    [PASS] found . at unix:path=%24CWD/_build/.rpc/dune |}]
+;;

unikernel/duniverse/dune_/test/expect-tests/dune_rpc_impl/dune

@@ -0,0 +1,21 @@
+(library
+ (name dune_rpc_impl_tests)
+ (modules dune_rpc_impl_tests)
+ (inline_tests)
+ (libraries
+  ; ocaml_config
+  ; dune_util
+  dune_console
+  dune_rpc_private
+  dune_rpc_impl
+  dune_engine
+  dune_re
+  stdune
+  ;; This is because of the (implicit_transitive_deps false)
+  ;; in dune-project
+  ppx_expect.config
+  ppx_expect.config_types
+  base
+  ppx_inline_test.config)
+ (preprocess
+  (pps ppx_expect)))

unikernel/duniverse/dune_/test/expect-tests/dune_rpc_impl/dune_rpc_impl_tests.ml

@@ -0,0 +1,243 @@
+open Stdune
+module Dune_rpc = Dune_rpc_private
+module Re = Dune_re
+
+let () =
+  Stdune.Path.set_root (Stdune.Path.External.of_filename_relative_to_initial_cwd ".");
+  Stdune.Path.Build.set_build_dir (Stdune.Path.Outside_build_dir.of_string "_build")
+;;
+
+let test ~dir ~f main =
+  let description = `Diagnostic (Dune_rpc.Compound_user_error.make ~main ~related:[]) in
+  Dune_console.printf "---- Original ----";
+  f main;
+  Dune_console.printf "------- RPC ------";
+  Dune_engine.Build_system_error.For_tests.make ~description ~dir ~promotion:None ()
+  |> Dune_rpc_impl.Diagnostics.For_tests.diagnostic_of_error
+  |> Dune_rpc_private.Diagnostic.to_user_message
+  |> f
+;;
+
+let test_plain ~dir main = test main ~dir ~f:Dune_console.print_user_message
+
+let test_dyn ~dir main =
+  test main ~dir ~f:(fun x ->
+    Stdune.User_message.pp x
+    |> Pp.to_dyn Stdune.User_message.Style.to_dyn
+    |> Dyn.to_string
+    |> print_endline)
+;;
+
+let scrub output =
+  Re.replace_string
+    (Re.compile (Re.str Stdune.Path.(to_absolute_filename root)))
+    ~by:"TEST"
+    output
+  |> print_endline
+;;
+
+let%expect_test "serialize and deserialize error message" =
+  let dir = None in
+  let message = User_error.make [ Pp.verbatim "Oh no!" ] in
+  test_plain ~dir message;
+  test_dyn ~dir message;
+  [%expect
+    {|
+    ---- Original ----
+    Error: Oh no!
+    ------- RPC ------
+    Error: Oh no!
+    ---- Original ----
+    Vbox
+      (0,
+       Seq
+         (Box
+            (0,
+             Concat
+               (Break (("", 1, ""), ("", 0, "")),
+                [ Seq (Tag (Error, Verbatim "Error"), Char :)
+                ; Verbatim "Oh no!"
+                ])),
+          Break (("", 0, ""), ("", 0, ""))))
+    ------- RPC ------
+    Vbox
+      (0,
+       Seq
+         (Box
+            (0,
+             Vbox
+               (0,
+                Box
+                  (0,
+                   Concat
+                     (Break (("", 1, ""), ("", 0, "")),
+                      [ Seq (Tag (Error, Verbatim "Error"), Char :)
+                      ; Verbatim "Oh no!"
+                      ])))),
+          Break (("", 0, ""), ("", 0, "")))) |}]
+;;
+
+let%expect_test "serialize and deserialize error message with location" =
+  let loc = Stdune.Loc.of_pos ("Bar", 1, 2, 3) in
+  let dir = Some (Stdune.Path.of_string "/Foo") in
+  let message = User_error.make ~loc [ Pp.verbatim "An error with location!" ] in
+  test_plain ~dir message;
+  test_dyn ~dir message;
+  [%expect
+    {|
+    ---- Original ----
+    File "Bar", line 1, characters 2-3:
+    Error: An error with location!
+    ------- RPC ------
+    File "/Foo/Bar", line 1, characters 2-3:
+    Error: An error with location!
+    ---- Original ----
+    Vbox
+      (0,
+       Concat
+         (Nop,
+          [ Seq
+              (Box (0, Tag (Loc, Text "File \"Bar\", line 1, characters 2-3:")),
+               Break (("", 0, ""), ("", 0, "")))
+          ; Seq
+              (Box
+                 (0,
+                  Concat
+                    (Break (("", 1, ""), ("", 0, "")),
+                     [ Seq (Tag (Error, Verbatim "Error"), Char :)
+                     ; Verbatim "An error with location!"
+                     ])),
+               Break (("", 0, ""), ("", 0, "")))
+          ]))
+    ------- RPC ------
+    Vbox
+      (0,
+       Concat
+         (Nop,
+          [ Seq
+              (Box
+                 (0, Tag (Loc, Text "File \"/Foo/Bar\", line 1, characters 2-3:")),
+               Break (("", 0, ""), ("", 0, "")))
+          ; Seq
+              (Box
+                 (0,
+                  Vbox
+                    (0,
+                     Box
+                       (0,
+                        Concat
+                          (Break (("", 1, ""), ("", 0, "")),
+                           [ Seq (Tag (Error, Verbatim "Error"), Char :)
+                           ; Verbatim "An error with location!"
+                           ])))),
+               Break (("", 0, ""), ("", 0, "")))
+          ])) |}]
+;;
+
+let%expect_test "serialize and deserialize error with location excerpt and hint" =
+  Io.String_path.write_file "foo.ml" "let x = 1\nlet y = 2\nlet z = 3\n";
+  let loc = Stdune.Loc.of_pos ("foo.ml", 1, 2, 3) in
+  let dir = Some (Stdune.Path.of_string ".") in
+  let hints = [ Pp.verbatim "Hint 1"; Pp.verbatim "Hint 2" ] in
+  let message = User_error.make ~loc ~hints [ Pp.verbatim "An error with location!" ] in
+  test_plain ~dir message;
+  test_dyn ~dir message;
+  scrub [%expect.output];
+  [%expect
+    {|
+    ---- Original ----
+    File "foo.ml", line 1, characters 2-3:
+    1 | let x = 1
+          ^
+    Error: An error with location!
+    Hint: Hint 1
+    Hint: Hint 2
+    ------- RPC ------
+    File "TEST/foo.ml", line 1, characters 2-3:
+    1 | let x = 1
+          ^
+    Error: An error with location!
+    Hint: Hint 1
+    Hint: Hint 2
+    ---- Original ----
+    Vbox
+      (0,
+       Concat
+         (Nop,
+          [ Seq
+              (Box
+                 (0, Tag (Loc, Text "File \"foo.ml\", line 1, characters 2-3:")),
+               Break (("", 0, ""), ("", 0, "")))
+          ; Seq
+              (Box
+                 (0,
+                  Concat
+                    (Break (("", 1, ""), ("", 0, "")),
+                     [ Seq (Tag (Error, Verbatim "Error"), Char :)
+                     ; Verbatim "An error with location!"
+                     ])),
+               Break (("", 0, ""), ("", 0, "")))
+          ; Seq
+              (Box
+                 (0,
+                  Seq
+                    (Seq
+                       (Tag (Hint, Verbatim "Hint:"),
+                        Break (("", 1, ""), ("", 0, ""))),
+                     Verbatim "Hint 1")),
+               Break (("", 0, ""), ("", 0, "")))
+          ; Seq
+              (Box
+                 (0,
+                  Seq
+                    (Seq
+                       (Tag (Hint, Verbatim "Hint:"),
+                        Break (("", 1, ""), ("", 0, ""))),
+                     Verbatim "Hint 2")),
+               Break (("", 0, ""), ("", 0, "")))
+          ]))
+    ------- RPC ------
+    Vbox
+      (0,
+       Concat
+         (Nop,
+          [ Seq
+              (Box
+                 (0,
+                  Tag
+                    (Loc,
+                     Text
+                       "File \"TEST/foo.ml\", line 1, characters 2-3:")),
+               Break (("", 0, ""), ("", 0, "")))
+          ; Seq
+              (Box
+                 (0,
+                  Vbox
+                    (0,
+                     Concat
+                       (Break (("", 0, ""), ("", 0, "")),
+                        [ Box
+                            (0,
+                             Concat
+                               (Break (("", 1, ""), ("", 0, "")),
+                                [ Seq (Tag (Error, Verbatim "Error"), Char :)
+                                ; Verbatim "An error with location!"
+                                ]))
+                        ; Box
+                            (0,
+                             Seq
+                               (Seq
+                                  (Tag (Hint, Verbatim "Hint:"),
+                                   Break (("", 1, ""), ("", 0, ""))),
+                                Verbatim "Hint 1"))
+                        ; Box
+                            (0,
+                             Seq
+                               (Seq
+                                  (Tag (Hint, Verbatim "Hint:"),
+                                   Break (("", 1, ""), ("", 0, ""))),
+                                Verbatim "Hint 2"))
+                        ]))),
+               Break (("", 0, ""), ("", 0, "")))
+          ])) |}]
+;;

unikernel/duniverse/dune_/test/expect-tests/dune_sexp/dune

@@ -0,0 +1,15 @@
+(library
+ (name dune_sexp_tests)
+ (inline_tests)
+ (libraries
+  dune_tests_common
+  stdune
+  dune_sexp
+  ;; This is because of the (implicit_transitive_deps false)
+  ;; in dune-project
+  ppx_expect.config
+  ppx_expect.config_types
+  base
+  ppx_inline_test.config)
+ (preprocess
+  (pps ppx_expect)))

unikernel/duniverse/dune_/test/expect-tests/dune_sexp/dune_sexp_tests.ml

@@ -0,0 +1,89 @@
+open Stdune
+
+let () = Dune_tests_common.init ()
+
+(* Testing the parsing of byte values *)
+let parse_bytes value =
+  Dune_sexp.Ast.atom_or_quoted_string Loc.none value
+  |> Dune_sexp.Decoder.parse Dune_sexp.Decoder.bytes_unit Univ_map.empty
+;;
+
+let rec long_power (l : int64) (n : int) : int64 =
+  if n = 0 then 1L else Int64.mul l @@ long_power l (n - 1)
+;;
+
+let parse_and_assert ?check value =
+  let value = parse_bytes value in
+  (match check with
+   | None -> ()
+   | Some check -> assert (value = check));
+  value
+;;
+
+let test_bytes ?check value = parse_and_assert ?check value |> Printf.printf "%#Ld\n"
+
+(* Hack to insert underscores for hex values. Digits must only be 0-9 *)
+let test_bytes_hex ?check value =
+  match parse_and_assert ?check value |> sprintf "%Lx" |> Int.of_string with
+  | Some x -> x |> Printf.sprintf "0x%#d\n" |> print_endline
+  | None -> print_endline "hex value must not have letters"
+;;
+
+(* Test parsing of integers. *)
+
+let%expect_test "parsing no suffix" =
+  try test_bytes "100" with
+  | exn ->
+    User_message.print (User_message.make [ Exn.pp exn ]);
+    [%expect
+      {|
+      File "<none>", line 1, characters 0-0:
+      Error: missing suffix, use one of B, kB, KiB, MB, MiB, GB, GiB, TB, TiB |}]
+;;
+
+(* Test all suffixes. We print binary units in hex to better see output. *)
+
+let%expect_test "parsing B suffix" =
+  test_bytes "1B" ~check:(long_power 1024L 0);
+  [%expect {| 1 |}]
+;;
+
+let%expect_test "parsing kB suffix" =
+  test_bytes "1kB" ~check:(long_power 1000L 1);
+  [%expect {| 1_000 |}]
+;;
+
+let%expect_test "parsing KiB suffix" =
+  test_bytes_hex "1KiB" ~check:(long_power 1024L 1);
+  [%expect {| 0x400 |}]
+;;
+
+let%expect_test "parsing MB suffix" =
+  test_bytes "1MB" ~check:(long_power 1000L 2);
+  [%expect {| 1_000_000 |}]
+;;
+
+let%expect_test "parsing MiB suffix" =
+  test_bytes_hex "1MiB" ~check:(long_power 1024L 2);
+  [%expect {| 0x100_000 |}]
+;;
+
+let%expect_test "parsing GB suffix" =
+  test_bytes "1GB" ~check:(long_power 1000L 3);
+  [%expect {| 1_000_000_000 |}]
+;;
+
+let%expect_test "parsing GiB suffix" =
+  test_bytes_hex "1GiB" ~check:(long_power 1024L 3);
+  [%expect {| 0x40_000_000 |}]
+;;
+
+let%expect_test "parsing TB suffix" =
+  test_bytes "1TB" ~check:(long_power 1000L 4);
+  [%expect {| 1_000_000_000_000 |}]
+;;
+
+let%expect_test "parsing TiB suffix" =
+  test_bytes_hex "1TiB" ~check:(long_power 1024L 4);
+  [%expect {| 0x10_000_000_000 |}]
+;;

unikernel/duniverse/dune_/test/expect-tests/dune_stats/dune

@@ -0,0 +1,17 @@
+(library
+ (name dune_stats_tests)
+ (inline_tests
+  (deps
+   (sandbox always)))
+ (libraries
+  dune_stats
+  stdune
+  unix
+  ;; This is because of the (implicit_transitive_deps false)
+  ;; in dune-project
+  ppx_expect.config
+  ppx_expect.config_types
+  base
+  ppx_inline_test.config)
+ (preprocess
+  (pps ppx_expect)))

unikernel/duniverse/dune_/test/expect-tests/dune_stats/dune_stats_tests.ml

@@ -0,0 +1,21 @@
+open Stdune
+
+let%expect_test "fd counting" =
+  let module Fd_count = Dune_stats.Private.Fd_count in
+  let get () =
+    match Fd_count.get () with
+    | This n -> n
+    | Unknown -> failwith "no fd counting available"
+  in
+  let base = get () in
+  let r, w = Unix.pipe () in
+  let log () = printfn "fd count: %d" (get () - base) in
+  log ();
+  [%expect {| fd count: 2 |}];
+  Unix.close r;
+  log ();
+  [%expect {| fd count: 1 |}];
+  Unix.close w;
+  log ();
+  [%expect {| fd count: 0 |}]
+;;

unikernel/duniverse/dune_/test/expect-tests/dune_util/dune

@@ -0,0 +1,19 @@
+(library
+ (name flock_tests)
+ (inline_tests
+  (enabled_if
+   (<> %{system} win))
+  (deps
+   (sandbox always)))
+ (libraries
+  dune_util
+  dyn
+  stdune
+  ;; This is because of the (implicit_transitive_deps false)
+  ;; in dune-project
+  ppx_expect.config
+  ppx_expect.config_types
+  base
+  ppx_inline_test.config)
+ (preprocess
+  (pps ppx_expect)))

unikernel/duniverse/dune_/test/expect-tests/dune_util/flock_tests.ml

@@ -0,0 +1,67 @@
+open Stdune
+
+let%expect_test "blocking lock" =
+  let fd = Unix.openfile "tlc1" [ Unix.O_CREAT ] 0o777 in
+  let lock = Flock.create fd in
+  print_endline "acquiring lock";
+  (match Flock.lock_block lock Exclusive with
+   | Ok () -> print_endline "acquired lock"
+   | Error _ -> assert false);
+  (match Flock.unlock lock with
+   | Ok () -> print_endline "released lock"
+   | Error _ -> assert false);
+  Unix.close fd;
+  [%expect
+    {|
+    acquiring lock
+    acquired lock
+    released lock |}]
+;;
+
+let%expect_test "nonblocking lock" =
+  let fd flag = Unix.openfile "tlc2" [ flag ] 0o777 in
+  let fd1 = fd Unix.O_CREAT in
+  let lock1 = Flock.create fd1 in
+  print_endline "acquiring lock";
+  (match Flock.lock_non_block lock1 Exclusive with
+   | Ok `Success -> print_endline "acquired lock"
+   | Ok `Failure | Error _ -> assert false);
+  let fd2 = fd Unix.O_RDONLY in
+  let lock2 = Flock.create fd2 in
+  (match Flock.lock_non_block lock2 Exclusive with
+   | Ok `Failure -> print_endline "verified that we can't lock again"
+   | Ok `Success -> Code_error.raise "acquired lock again" []
+   | Error err ->
+     Code_error.raise "err" [ "message", Dyn.string @@ Unix.error_message err ]);
+  (match Flock.unlock lock1 with
+   | Ok () -> print_endline "released lock"
+   | Error _ -> assert false);
+  let lock2 = Flock.create fd2 in
+  (match Flock.lock_non_block lock2 Exclusive with
+   | Ok `Success -> print_endline "managed to lock after unlock"
+   | Ok `Failure | Error _ -> assert false);
+  Unix.close fd1;
+  Unix.close fd2;
+  [%expect
+    {|
+    acquiring lock
+    acquired lock
+    verified that we can't lock again
+    released lock
+    managed to lock after unlock |}]
+;;
+
+let%expect_test "double lock" =
+  let fd = Unix.openfile "tlc3" [ Unix.O_CREAT ] 0o600 in
+  let lock = Flock.create fd in
+  (match Flock.lock_non_block lock Exclusive with
+   | Ok `Success -> print_endline "lock 1 worked"
+   | _ -> assert false);
+  (match Flock.lock_non_block lock Exclusive with
+   | Ok `Success -> print_endline "lock 2 worked"
+   | _ -> assert false);
+  [%expect
+    {|
+    lock 1 worked
+    lock 2 worked |}]
+;;

unikernel/duniverse/dune_/test/expect-tests/fiber_event_bus/dune

@@ -0,0 +1,18 @@
+(library
+ (name fiber_event_bus_tests)
+ (modules fiber_event_bus_tests)
+ (inline_tests)
+ (libraries
+  stdune
+  fiber
+  fiber_event_bus
+  test_scheduler
+  dune_tests_common
+  ;; This is because of the (implicit_transitive_deps false)
+  ;; in dune-project
+  ppx_expect.config
+  ppx_expect.config_types
+  base
+  ppx_inline_test.config)
+ (preprocess
+  (pps ppx_expect)))

unikernel/duniverse/dune_/test/expect-tests/fiber_event_bus/fiber_event_bus_tests.ml

@@ -0,0 +1,159 @@
+open Stdune
+open Fiber.O
+
+let () = Dune_tests_common.init ()
+
+let push_log = function
+  | `Ok -> printfn "Successful push."
+  | `Closed -> printfn "Couldn't push! Bus was closed."
+;;
+
+let pop_log = function
+  | `Next a -> printfn "Popped %S." a
+  | `Closed -> printfn "Couldn't pop! Bus was closed."
+;;
+
+let push t s =
+  let+ r = Fiber_event_bus.push t s in
+  push_log r
+;;
+
+let pop t =
+  let+ r = Fiber_event_bus.pop t in
+  pop_log r
+;;
+
+let create () =
+  let bus = Fiber_event_bus.create () in
+  printfn "Created bus.";
+  bus
+;;
+
+let close t =
+  let+ () = Fiber_event_bus.close t in
+  printfn "Closed bus."
+;;
+
+let test f =
+  let scheduler = Test_scheduler.create () in
+  let exec = Fiber.of_thunk (fun () -> f scheduler) in
+  Test_scheduler.run scheduler exec
+;;
+
+let%expect_test "Push followed by pop and then close" =
+  test (fun _scheduler ->
+    let event_bus = create () in
+    let* () = push event_bus "Hello"
+    and* () = pop event_bus in
+    let* () = close event_bus in
+    Fiber.return ());
+  [%expect
+    {|
+    Created bus.
+    Popped "Hello".
+    Successful push.
+    Closed bus. |}]
+;;
+
+let%expect_test "Double close" =
+  test (fun _scheduler ->
+    let event_bus = create () in
+    let* () = close event_bus in
+    let* () = close event_bus in
+    Fiber.return ());
+  [%expect
+    {|
+    Created bus.
+    Closed bus.
+    Closed bus. |}]
+;;
+
+let%expect_test "Push together with delayed close should close bus and block push." =
+  test (fun scheduler ->
+    let event_bus = create () in
+    let* () = push event_bus "Hello"
+    and* () = Test_scheduler.yield scheduler >>> close event_bus in
+    Fiber.return ());
+  [%expect
+    {|
+    Created bus.
+    Closed bus.
+    Couldn't push! Bus was closed. |}]
+;;
+
+let%expect_test "Pop together with delayed close should close bus and block pop." =
+  test (fun scheduler ->
+    let event_bus = create () in
+    let* () = pop event_bus
+    and* () = Test_scheduler.yield scheduler >>> close event_bus in
+    Fiber.return ());
+  [%expect
+    {|
+    Created bus.
+    Closed bus.
+    Couldn't pop! Bus was closed. |}]
+;;
+
+let%expect_test "2 pushes and delayed close" =
+  test (fun scheduler ->
+    let event_bus = create () in
+    let* () = push event_bus "Hello"
+    and* () = push event_bus "World!"
+    and* () = Test_scheduler.yield scheduler >>> close event_bus in
+    Fiber.return ());
+  [%expect
+    {|
+    Created bus.
+    Closed bus.
+    Couldn't push! Bus was closed.
+    Couldn't push! Bus was closed. |}]
+;;
+
+let%expect_test "2 pops and delayed close" =
+  test (fun scheduler ->
+    let event_bus = create () in
+    let* () = pop event_bus
+    and* () = pop event_bus
+    and* () = Test_scheduler.yield scheduler >>> close event_bus in
+    Fiber.return ());
+  [%expect
+    {|
+    Created bus.
+    Closed bus.
+    Couldn't pop! Bus was closed.
+    Couldn't pop! Bus was closed. |}]
+;;
+
+let%expect_test "Push and pop with a delayed close" =
+  test (fun scheduler ->
+    let event_bus = create () in
+    let* () = push event_bus "Hello"
+    and* () = pop event_bus
+    and* () = Test_scheduler.yield scheduler >>> close event_bus in
+    Fiber.return ());
+  [%expect
+    {|
+    Created bus.
+    Popped "Hello".
+    Successful push.
+    Closed bus. |}]
+;;
+
+let%expect_test "2 pushes together with 2 pops then a close" =
+  test (fun _scheduler ->
+    let event_bus = create () in
+    let* () = push event_bus "Hello"
+    and* () = push event_bus "World!"
+    and* () = pop event_bus
+    and* () = pop event_bus in
+    let* () = close event_bus in
+    Fiber.return ());
+  [%expect
+    {|
+    Created bus.
+    Popped "Hello".
+    Popped "World!".
+    Successful push.
+    Successful push.
+    Closed bus. |}]
+;;

unikernel/duniverse/dune_/test/expect-tests/findlib_tests.ml

@@ -0,0 +1,223 @@
+open Stdune
+module Lib_name = Dune_lang.Lib_name
+module Meta = Dune_findlib.Findlib.Meta
+module Findlib_config = Dune_findlib.Findlib.Config
+
+include struct
+  open Dune_lang
+  module Lib_dep = Lib_dep
+  module Package = Package
+end
+
+open Dune_rules
+open Dune_rules.For_tests
+open Dune_tests_common
+
+let () = init ()
+
+let foo_meta =
+  {|
+requires = "bar"
+requires(ppx_driver) = "baz"
+|}
+;;
+
+let db_path : Path.Outside_build_dir.t =
+  External (Path.External.of_filename_relative_to_initial_cwd "../unit-tests/findlib-db")
+;;
+
+let print_pkg ppf pkg =
+  let info = Dune_package.Lib.info pkg in
+  let name = Lib_info.name info in
+  Format.fprintf ppf "<package:%s>" (Lib_name.to_string name)
+;;
+
+let findlib =
+  let lib_config : Lib_config.t =
+    { has_native = true
+    ; ext_lib = ".a"
+    ; ext_obj = ".o"
+    ; os_type = Ocaml_config.Os_type.Other ""
+    ; architecture = ""
+    ; system = ""
+    ; model = ""
+    ; natdynlink_supported = Dynlink_supported.By_the_os.of_bool true
+    ; ext_dll = ".so"
+    ; stdlib_dir = Path.source @@ Path.Source.(relative root) "stdlib"
+    ; ccomp_type = Cc
+    ; ocaml_version_string = "4.02.3"
+    ; ocaml_version = Ocaml.Version.make (4, 14, 1)
+    }
+  in
+  Memo.lazy_ (fun () ->
+    Findlib.For_tests.create ~paths:[ Path.outside_build_dir db_path ] ~lib_config)
+;;
+
+let resolve_pkg s =
+  (let lib_name = Lib_name.of_string s in
+   let open Memo.O in
+   let* findlib = Memo.Lazy.force findlib in
+   Findlib.find findlib lib_name)
+  |> Memo.run
+  |> Test_scheduler.(run (create ()))
+;;
+
+let elide_db_path path =
+  let prefix = Path.Outside_build_dir.to_string db_path in
+  let path = Path.to_string path in
+  String.drop_prefix_if_exists path ~prefix
+;;
+
+let print_pkg_archives pkg =
+  let pkg = resolve_pkg pkg in
+  let print_lib kind entry =
+    let entry =
+      Dune_package.Lib.info entry
+      |> Lib_info.archives
+      |> Ocaml.Mode.Dict.map ~f:(List.map ~f:elide_db_path)
+      |> Ocaml.Mode.Dict.to_dyn (Dyn.list Dyn.string)
+    in
+    Dyn.variant
+      (match kind with
+       | `Available -> "Available"
+       | `Hidden -> "Hidden")
+      [ entry ]
+    |> print_dyn
+  in
+  match pkg with
+  | Ok (Library x) -> print_lib `Available x
+  | Ok (Hidden_library x) -> print_lib `Hidden x
+  | Ok e -> Dune_package.Entry.to_dyn e |> print_dyn
+  | Error err -> Findlib.Unavailable_reason.to_dyn err |> print_dyn
+;;
+
+let%expect_test _ =
+  print_pkg_archives "qux";
+  [%expect {| Available { byte = [ "/qux/qux.cma" ]; native = [] } |}]
+;;
+
+let%expect_test _ =
+  print_pkg_archives "xyz";
+  [%expect {| Available { byte = [ "/xyz.cma" ]; native = [] } |}]
+;;
+
+let () = Printexc.record_backtrace true
+
+let%expect_test "configurator" =
+  print_pkg_archives "dune.configurator";
+  [%expect
+    {|
+    Deprecated_library_name
+      { old_public_name = "dune.configurator"
+      ; new_public_name = "dune-configurator"
+      } |}]
+;;
+
+let%expect_test "builtins" =
+  print_pkg_archives "str";
+  [%expect
+    {|
+    Available { byte = []; native = [] } |}];
+  print_pkg_archives "dynlink";
+  [%expect
+    {|
+    Hidden
+      { byte = [ "stdlib/dynlink.cma" ]; native = [ "stdlib/dynlink.cmxa" ] } |}]
+;;
+
+let%expect_test _ =
+  let pkg =
+    match resolve_pkg "foo" with
+    | Ok (Library x) -> x
+    | _ -> assert false
+  in
+  (* "foo" should depend on "baz" *)
+  let info = Dune_package.Lib.info pkg in
+  let requires = Lib_info.requires info in
+  let dyn = Dyn.list Lib_dep.to_dyn requires in
+  let pp = Dyn.pp dyn in
+  Format.printf "%a@." Pp.to_fmt pp;
+  [%expect {|[ re_export "baz"; "xyz" ]|}]
+;;
+
+(* Meta parsing/simplification *)
+
+let%expect_test _ =
+  Meta.of_string foo_meta ~name:(Some (Package.Name.of_string "foo"))
+  |> Meta.Simplified.to_dyn
+  |> print_dyn;
+  [%expect
+    {|
+    { name = Some "foo"
+    ; vars =
+        map
+          { "requires" :
+              { set_rules =
+                  [ { var = "requires"
+                    ; predicates = []
+                    ; action = Set
+                    ; value = "bar"
+                    }
+                  ; { var = "requires"
+                    ; predicates = [ Pos "ppx_driver" ]
+                    ; action = Set
+                    ; value = "baz"
+                    }
+                  ]
+              ; add_rules = []
+              }
+          }
+    ; subs = []
+    } |}]
+;;
+
+let conf () =
+  let memo =
+    let open Memo.O in
+    Findlib_config.discover_from_env
+      ~which:(fun _ -> assert false)
+      ~ocamlpath:(Memo.return [])
+      ~env:
+        (Env.initial
+         |> Env.add
+              ~var:"OCAMLFIND_CONF"
+              ~value:
+                (Path.Outside_build_dir.relative db_path "../toolchain"
+                 |> Path.Outside_build_dir.to_string))
+      ~findlib_toolchain:(Some "tlc")
+    >>| Option.value_exn
+  in
+  Memo.run memo |> Test_scheduler.(run (create ()))
+;;
+
+let%expect_test _ =
+  let conf = conf () in
+  print_dyn (Findlib_config.to_dyn conf);
+  [%expect
+    {|
+    { config =
+        { vars =
+            map
+              { "FOO_BAR" :
+                  { set_rules =
+                      [ { preds_required = set { "env"; "tlc" }
+                        ; preds_forbidden = set {}
+                        ; value = "my variable"
+                        }
+                      ]
+                  ; add_rules = []
+                  }
+              }
+        ; preds = set { "tlc" }
+        }
+    ; toolchain = Some "tlc"
+    } |}];
+  print_dyn (Env.to_dyn (Findlib_config.env conf));
+  [%expect {| map { "FOO_BAR" : "my variable" } |}];
+  Findlib_config.ocamlpath conf
+  |> Memo.run
+  |> Test_scheduler.(run (create ()))
+  |> Dyn.(list Path.to_dyn)
+  |> print_dyn;
+  [%expect {| [] |}]
+;;

unikernel/duniverse/dune_/test/expect-tests/fsevents/dune

@@ -0,0 +1,22 @@
+(library
+ (name fsevents_tests)
+ (inline_tests
+  (enabled_if
+   (and
+    (<> %{env:CI=false} true)
+    (= %{system} macosx)))
+  (deps
+   (sandbox always)))
+ (libraries
+  unix
+  fsevents
+  stdune
+  threads.posix
+  ;; This is because of the (implicit_transitive_deps false)
+  ;; in dune-project
+  ppx_expect.config
+  ppx_expect.config_types
+  base
+  ppx_inline_test.config)
+ (preprocess
+  (pps ppx_expect)))

unikernel/duniverse/dune_/test/expect-tests/fsevents/fsevents_tests.ml

@@ -0,0 +1,311 @@
+open Stdune
+module Event = Fsevents.Event
+
+module Logger : sig
+  type t
+
+  val create : unit -> t
+  val printfn : t -> ('a, unit, string, unit) format4 -> 'a
+  val flush : t -> unit
+end = struct
+  type t = { messages : string Queue.t }
+
+  let create () = { messages = Queue.create () }
+  let printfn t fmt = Printf.ksprintf (fun s -> Queue.push t.messages s) fmt
+
+  let flush t =
+    let rec loop () =
+      match Queue.pop t.messages with
+      | None -> ()
+      | Some s ->
+        print_endline s;
+        loop ()
+    in
+    loop ()
+  ;;
+end
+
+let timeout_thread ~wait f =
+  let spawn () =
+    Thread.delay wait;
+    f ()
+  in
+  let (_ : Thread.t) = Thread.create spawn () in
+  ()
+;;
+
+let start_filename = ".dune_fsevents_start"
+let end_filename = ".dune_fsevents_end"
+
+let emit_start dir =
+  ignore (Fpath.mkdir_p dir);
+  Io.String_path.write_file (Filename.concat dir start_filename) ""
+;;
+
+let emit_stop dir =
+  ignore (Fpath.mkdir_p dir);
+  Io.String_path.write_file (Filename.concat dir end_filename) ""
+;;
+
+let test f =
+  let cv = Condition.create () in
+  let mutex = Mutex.create () in
+  let finished = ref false in
+  let finish () =
+    Mutex.lock mutex;
+    finished := true;
+    Condition.signal cv;
+    Mutex.unlock mutex
+  in
+  timeout_thread ~wait:3.0 (fun () ->
+    Mutex.lock mutex;
+    if not !finished
+    then (
+      Format.eprintf "Test timed out@.";
+      finished := true;
+      Condition.signal cv);
+    Mutex.unlock mutex);
+  let test () =
+    let dir = Temp.create Dir ~prefix:"fsevents_dune" ~suffix:"" in
+    let old = Sys.getcwd () in
+    Sys.chdir (Path.to_string dir);
+    Exn.protect
+      ~f:(fun () -> f finish)
+      ~finally:(fun () ->
+        Sys.chdir old;
+        Temp.destroy Dir dir)
+  in
+  let (_ : Thread.t) = Thread.create test () in
+  Mutex.lock mutex;
+  while not !finished do
+    Condition.wait cv mutex
+  done;
+  Mutex.unlock mutex
+;;
+
+let print_event ~logger ~cwd e =
+  let dyn =
+    let open Dyn in
+    record
+      [ "action", Event.dyn_of_action (Event.action e)
+      ; "kind", Event.dyn_of_kind (Event.kind e)
+      ; ( "path"
+        , string
+            (let path = Event.path e in
+             match String.drop_prefix ~prefix:cwd path with
+             | None -> path
+             | Some p -> "$TESTCASE_ROOT" ^ p) )
+      ]
+  in
+  Logger.printfn logger "> %s" (Dyn.to_string dyn)
+;;
+
+let make_callback sync ~f =
+  (* hack to skip the first event if it's creating the temp dir *)
+  let state = ref `Looking_start in
+  fun events ->
+    let is_marker event filename =
+      Event.kind event = File
+      && Filename.basename (Event.path event) = filename
+      && Event.action event = Create
+    in
+    let events =
+      List.fold_left events ~init:[] ~f:(fun acc event ->
+        match !state with
+        | `Looking_start ->
+          if is_marker event start_filename
+          then (
+            state := `Keep;
+            sync#start);
+          acc
+        | `Finish -> acc
+        | `Keep ->
+          if is_marker event end_filename
+          then (
+            state := `Finish;
+            sync#stop;
+            acc)
+          else event :: acc)
+    in
+    match events with
+    | [] -> ()
+    | _ -> List.rev events |> List.iter ~f:(f ~logger:sync#logger)
+;;
+
+type test_config =
+  { on_event : logger:Logger.t -> Event.t -> unit
+  ; exclusion_paths : string list
+  ; dir : string
+  }
+
+let default_test_config cwd =
+  { on_event = print_event ~cwd; dir = cwd; exclusion_paths = [] }
+;;
+
+let test_with_multiple_fsevents ~setup ~test:f =
+  test (fun finish ->
+    let cwd = Sys.getcwd () in
+    let make_sync t config =
+      let logger = Logger.create () in
+      object
+        val mutable started = false
+        val mutable stopped = false
+        method logger = logger
+        method started = started
+        method stopped = stopped
+        method start = started <- true
+
+        method stop =
+          stopped <- true;
+          Fsevents.stop (Option.value_exn !t)
+
+        method emit_start = if not started then emit_start config.dir
+        method emit_stop = if not stopped then emit_stop config.dir
+      end
+    in
+    let configs = setup ~cwd (default_test_config cwd) in
+    let fsevents, syncs =
+      List.map configs ~f:(fun config ->
+        let t = ref None in
+        let sync = make_sync t config in
+        let res =
+          Fsevents.create
+            ~paths:[ config.dir ]
+            ~latency:0.0
+            ~f:(make_callback sync ~f:config.on_event)
+        in
+        (match config.exclusion_paths with
+         | [] -> ()
+         | paths ->
+           (* apple doesn't like [paths] empty *)
+           Fsevents.set_exclusion_paths res ~paths);
+        t := Some res;
+        res, sync)
+      |> List.unzip
+    in
+    let dispatch_queue = Fsevents.Dispatch_queue.create () in
+    List.iter fsevents ~f:(fun f -> Fsevents.start f dispatch_queue);
+    let (t : Thread.t) =
+      Thread.create
+        (fun () ->
+           let rec await ~emit ~continue = function
+             | [] -> ()
+             | xs ->
+               List.iter xs ~f:emit;
+               Unix.sleepf 0.2;
+               await ~emit ~continue (List.filter xs ~f:continue)
+           in
+           await
+             ~emit:(fun sync -> sync#emit_start)
+             ~continue:(fun sync -> not sync#started)
+             syncs;
+           f ();
+           await
+             ~emit:(fun sync -> sync#emit_stop)
+             ~continue:(fun sync -> not sync#stopped)
+             syncs)
+        ()
+    in
+    (match Fsevents.Dispatch_queue.wait_until_stopped dispatch_queue with
+     | Error Exit -> print_endline "[EXIT]"
+     | Error _ -> assert false
+     | Ok () -> ());
+    Thread.join t;
+    List.iter syncs ~f:(fun c -> Logger.flush c#logger);
+    finish ())
+;;
+
+let test_with_operations ?on_event ?exclusion_paths f =
+  test_with_multiple_fsevents ~test:f ~setup:(fun ~cwd config ->
+    let config =
+      match exclusion_paths with
+      | None -> config
+      | Some f -> { config with exclusion_paths = f cwd }
+    in
+    [ (match on_event with
+       | None -> config
+       | Some on_event -> { config with on_event })
+    ])
+;;
+
+let%expect_test "file create event" =
+  test_with_operations (fun () -> Io.String_path.write_file "./file" "foobar");
+  [%expect
+    {|
+    > { action = "Create"; kind = "File"; path = "$TESTCASE_ROOT/file" } |}]
+;;
+
+let%expect_test "dir create event" =
+  test_with_operations (fun () -> ignore (Fpath.mkdir "./blahblah"));
+  [%expect
+    {|
+    > { action = "Create"; kind = "Dir"; path = "$TESTCASE_ROOT/blahblah" } |}]
+;;
+
+let%expect_test "move file" =
+  test_with_operations (fun () ->
+    Io.String_path.write_file "old" "foobar";
+    Unix.rename "old" "new");
+  [%expect
+    {|
+    > { action = "Create"; kind = "File"; path = "$TESTCASE_ROOT/old" }
+    > { action = "Rename"; kind = "File"; path = "$TESTCASE_ROOT/new" } |}]
+;;
+
+let%expect_test "raise inside callback" =
+  test_with_operations
+    ~on_event:(fun ~logger _ ->
+      Logger.printfn logger "exiting.";
+      raise Exit)
+    (fun () ->
+       Io.String_path.write_file "old" "foobar";
+       Io.String_path.write_file "old" "foobar";
+       (* Delay to allow the event handler callback to catch the exception
+         before stopping the watcher. *)
+       Unix.sleepf 1.0);
+  [%expect
+    {|
+    [EXIT]
+    exiting. |}]
+;;
+
+let%expect_test "set exclusion paths" =
+  let run paths =
+    let ignored = "ignored" in
+    test_with_operations
+      ~exclusion_paths:(fun cwd -> [ paths cwd ignored ])
+      (fun () ->
+         let (_ : Fpath.mkdir_p_result) = Fpath.mkdir_p ignored in
+         Io.String_path.write_file (Filename.concat ignored "old") "foobar")
+  in
+  (* absolute paths work *)
+  run Filename.concat;
+  [%expect
+    {|
+    > { action = "Create"; kind = "Dir"; path = "$TESTCASE_ROOT/ignored" } |}];
+  (* but relative paths do not *)
+  run (fun _ name -> name);
+  [%expect
+    {|
+    > { action = "Create"; kind = "Dir"; path = "$TESTCASE_ROOT/ignored" }
+    > { action = "Create"; kind = "File"; path = "$TESTCASE_ROOT/ignored/old" } |}]
+;;
+
+let%expect_test "multiple fsevents" =
+  test_with_multiple_fsevents
+    ~setup:(fun ~cwd config ->
+      let create path =
+        let dir = Filename.concat cwd path in
+        ignore (Fpath.mkdir dir);
+        { config with dir }
+      in
+      [ create "foo"; create "bar" ])
+    ~test:(fun () ->
+      Io.String_path.write_file "foo/file" "";
+      Io.String_path.write_file "bar/file" "";
+      Io.String_path.write_file "xxx" "" (* this one is ignored *));
+  [%expect
+    {|
+    > { action = "Create"; kind = "File"; path = "$TESTCASE_ROOT/foo/file" }
+    > { action = "Create"; kind = "File"; path = "$TESTCASE_ROOT/bar/file" } |}]
+;;

unikernel/duniverse/dune_/test/expect-tests/inotify_tests/dune

@@ -0,0 +1,21 @@
+(library
+ (name inotify_tests)
+ (inline_tests
+  (enabled_if
+   (= %{system} linux))
+  (deps
+   (sandbox always)))
+ (libraries
+  async_inotify_for_dune
+  threads
+  ppx_expect.config
+  ppx_expect.config_types
+  base
+  stdune
+  ppx_inline_test.config
+  threads.posix
+  stdio
+  spawn
+  unix)
+ (preprocess
+  (pps ppx_expect)))

unikernel/duniverse/dune_/test/expect-tests/inotify_tests/inotify_tests.ml

@@ -0,0 +1,426 @@
+open Stdune
+open Async_inotify_for_dune
+open Printf
+
+let ( / ) a b =
+  match a with
+  | "." -> b
+  | _ -> Filename.concat a b
+;;
+
+let create_file fn = Io.String_path.write_file fn ""
+let mkdir fn = Unix.mkdir fn 0o777
+let rm = Sys.remove
+let rmdir = Unix.rmdir
+
+let string_of_event ev =
+  let s = Async_inotify.Event.to_string ev in
+  (* Add space padding to make events aligned *)
+  let kind, rest = String.lsplit2_exn s ~on:' ' in
+  sprintf "%-10s%s" kind rest
+;;
+
+let print_event ev = print_endline (string_of_event ev)
+let print_events = List.iter ~f:print_event
+let remove_dot_slash s = String.drop_prefix s ~prefix:"./" |> Option.value ~default:s
+
+(* Events generated from watching directory "." are prefixed with ".". Remove
+   the prefix as it's not super interesting. *)
+let remove_dot_slash_from_event : Async_inotify.Event.t -> Async_inotify.Event.t
+  = function
+  | Created s -> Created (remove_dot_slash s)
+  | Unlinked s -> Unlinked (remove_dot_slash s)
+  | Modified s -> Modified (remove_dot_slash s)
+  | Moved x ->
+    Moved
+      (match x with
+       | Away s -> Away (remove_dot_slash s)
+       | Into s -> Into (remove_dot_slash s)
+       | Move (a, b) -> Move (remove_dot_slash a, remove_dot_slash b))
+  | Queue_overflow -> Queue_overflow
+;;
+
+let watch, collect_events =
+  (* Files used to mark the beginning and end of tests. *)
+  let beginning_of_test_file =
+    Temp.create Temp.File ~prefix:"BEGINNING_OF_TEST" ~suffix:""
+  in
+  let end_of_test_file = Temp.create Temp.File ~prefix:"END_OF_TEST" ~suffix:"" in
+  let beginning_of_test_file = Path.to_string beginning_of_test_file in
+  let end_of_test_file = Path.to_string end_of_test_file in
+  create_file beginning_of_test_file;
+  create_file end_of_test_file;
+  let events = Queue.create () in
+  let mutex = Mutex.create () in
+  let cond = Condition.create () in
+  let inotify =
+    Async_inotify.create
+      ~spawn_thread:(fun f -> ignore (Thread.create f () : Thread.t))
+      ~modify_event_selector:`Closed_writable_fd
+      ~log_error:print_endline
+      ~send_emit_events_job_to_scheduler:(fun f ->
+        Mutex.lock mutex;
+        Queue.push events f;
+        Condition.signal cond;
+        Mutex.unlock mutex)
+  in
+  let watch fn = Async_inotify.add inotify fn in
+  watch beginning_of_test_file;
+  watch end_of_test_file;
+  let next_events () =
+    Mutex.lock mutex;
+    while Queue.is_empty events do
+      Condition.wait cond mutex
+    done;
+    let f = Queue.pop_exn events in
+    Mutex.unlock mutex;
+    f ()
+  in
+  let rec collect_events acc = function
+    | [] ->
+      let events = next_events () in
+      collect_events acc events
+    | Async_inotify.Event.Modified fn :: events when fn = end_of_test_file ->
+      if not (List.is_empty events)
+      then (
+        printf "***** Leftover events after end of test marker event *****\n";
+        print_events events);
+      List.rev acc
+    | ev :: events -> collect_events (ev :: acc) events
+  in
+  let collect_events () =
+    (* Mark the beginning of the current test *)
+    create_file end_of_test_file;
+    let events =
+      match next_events () with
+      | [] -> assert false
+      | Async_inotify.Event.Modified fn :: events when fn = beginning_of_test_file ->
+        collect_events [] events
+      | events ->
+        printf "***** First event is not the beginning of test marker *****\n";
+        collect_events [] events
+    in
+    (* Mark the beginning of the next test *)
+    create_file beginning_of_test_file;
+    events
+  in
+  create_file beginning_of_test_file;
+  watch, collect_events
+;;
+
+(* Run a function in a sub-directory *)
+let in_sub_dir =
+  let n = ref 0 in
+  fun f ->
+    incr n;
+    let dir = sprintf "test%d" !n in
+    mkdir dir;
+    Sys.chdir dir;
+    Exn.protect ~finally:(fun () -> Sys.chdir "..") ~f
+;;
+
+let%expect_test "Simple test" =
+  in_sub_dir
+  @@ fun () ->
+  let fn = "file" in
+  create_file fn;
+  watch fn;
+  create_file fn;
+  print_events (collect_events ());
+  [%expect {| modified  file |}]
+;;
+
+let fold_int n ~init ~f =
+  let rec loop i acc = if i = n then acc else loop (i + 1) (f i acc) in
+  loop 0 init
+;;
+
+type kind =
+  | File
+  | Dir
+
+let rec gen_tree acc ~dir ~depth ~files_per_dir ~sub_dirs_per_dir =
+  let acc =
+    fold_int files_per_dir ~init:acc ~f:(fun n acc ->
+      let fn = dir / sprintf "f%d" (n + 1) in
+      create_file fn;
+      (File, fn) :: acc)
+  in
+  if depth = 0
+  then acc
+  else
+    fold_int sub_dirs_per_dir ~init:acc ~f:(fun n acc ->
+      let dir = dir / sprintf "d%d" (n + 1) in
+      let acc = (Dir, dir) :: acc in
+      mkdir dir;
+      gen_tree acc ~dir ~depth:(depth - 1) ~files_per_dir ~sub_dirs_per_dir)
+;;
+
+let gen_tree ~depth ~files_per_dir ~sub_dirs_per_dir =
+  List.rev (gen_tree [ Dir, "." ] ~dir:"." ~depth ~files_per_dir ~sub_dirs_per_dir)
+;;
+
+let%expect_test "Show that gen_tree generates filenames in the right order" =
+  in_sub_dir
+  @@ fun () ->
+  List.iter (gen_tree ~depth:1 ~files_per_dir:2 ~sub_dirs_per_dir:2) ~f:(fun (_, fn) ->
+    print_endline fn);
+  [%expect
+    {|
+    .
+    f1
+    f2
+    d1
+    d1/f1
+    d1/f2
+    d2
+    d2/f1
+    d2/f2 |}]
+;;
+
+(* Return the expected set of inotify events *)
+let gen_changes files =
+  List.concat_map files ~f:(function
+    | Dir, fn ->
+      let new_file = fn / "new-file" in
+      let new_dir = fn / "new-dir" in
+      create_file new_file;
+      mkdir new_dir;
+      rmdir new_dir;
+      rm new_file;
+      [ Async_inotify.Event.Created new_file
+      ; Modified new_file
+      ; Created new_dir
+      ; Unlinked new_dir
+      ; Unlinked new_file
+      ]
+    | File, fn ->
+      create_file fn;
+      (* We get the event twice because we are watching both the file and the
+         directory *)
+      [ Modified fn; Modified fn ])
+;;
+
+let setup1 ~depth ~files_per_dir ~sub_dirs_per_dir =
+  let files = gen_tree ~depth ~files_per_dir ~sub_dirs_per_dir in
+  List.iter files ~f:(fun (_kind, fn) -> watch fn);
+  files, collect_events
+;;
+
+let check_events ~real_events ~expected_events =
+  let real_events = List.map real_events ~f:remove_dot_slash_from_event in
+  print_endline (if real_events = expected_events then "Success" else "FAILURE");
+  print_endline "";
+  let rec loop real expected =
+    match real, expected with
+    | [], [] -> ()
+    | ev :: real, [] ->
+      printf "%s <- XXX expected no more events\n" (string_of_event ev);
+      print_events real
+    | [], ev :: _ -> printf "XXX expected:  %s\n" (Async_inotify.Event.to_string ev)
+    | ev :: real, ev' :: expected ->
+      if ev = ev'
+      then (
+        print_event ev;
+        loop real expected)
+      else (
+        printf
+          "%s <- XXX first mismatch, expected: %s\n"
+          (string_of_event ev)
+          (Async_inotify.Event.to_string ev');
+        print_events real)
+  in
+  loop real_events expected_events
+;;
+
+let%expect_test "Check that FS events are reported chronologically" =
+  in_sub_dir
+  @@ fun () ->
+  let files, collect_events = setup1 ~depth:2 ~files_per_dir:3 ~sub_dirs_per_dir:2 in
+  let expected_events = gen_changes files in
+  check_events ~expected_events ~real_events:(collect_events ());
+  [%expect
+    {|
+    Success
+
+    created   new-file
+    modified  new-file
+    created   new-dir
+    unlinked  new-dir
+    unlinked  new-file
+    modified  f1
+    modified  f1
+    modified  f2
+    modified  f2
+    modified  f3
+    modified  f3
+    created   d1/new-file
+    modified  d1/new-file
+    created   d1/new-dir
+    unlinked  d1/new-dir
+    unlinked  d1/new-file
+    modified  d1/f1
+    modified  d1/f1
+    modified  d1/f2
+    modified  d1/f2
+    modified  d1/f3
+    modified  d1/f3
+    created   d1/d1/new-file
+    modified  d1/d1/new-file
+    created   d1/d1/new-dir
+    unlinked  d1/d1/new-dir
+    unlinked  d1/d1/new-file
+    modified  d1/d1/f1
+    modified  d1/d1/f1
+    modified  d1/d1/f2
+    modified  d1/d1/f2
+    modified  d1/d1/f3
+    modified  d1/d1/f3
+    created   d1/d2/new-file
+    modified  d1/d2/new-file
+    created   d1/d2/new-dir
+    unlinked  d1/d2/new-dir
+    unlinked  d1/d2/new-file
+    modified  d1/d2/f1
+    modified  d1/d2/f1
+    modified  d1/d2/f2
+    modified  d1/d2/f2
+    modified  d1/d2/f3
+    modified  d1/d2/f3
+    created   d2/new-file
+    modified  d2/new-file
+    created   d2/new-dir
+    unlinked  d2/new-dir
+    unlinked  d2/new-file
+    modified  d2/f1
+    modified  d2/f1
+    modified  d2/f2
+    modified  d2/f2
+    modified  d2/f3
+    modified  d2/f3
+    created   d2/d1/new-file
+    modified  d2/d1/new-file
+    created   d2/d1/new-dir
+    unlinked  d2/d1/new-dir
+    unlinked  d2/d1/new-file
+    modified  d2/d1/f1
+    modified  d2/d1/f1
+    modified  d2/d1/f2
+    modified  d2/d1/f2
+    modified  d2/d1/f3
+    modified  d2/d1/f3
+    created   d2/d2/new-file
+    modified  d2/d2/new-file
+    created   d2/d2/new-dir
+    unlinked  d2/d2/new-dir
+    unlinked  d2/d2/new-file
+    modified  d2/d2/f1
+    modified  d2/d2/f1
+    modified  d2/d2/f2
+    modified  d2/d2/f2
+    modified  d2/d2/f3
+    modified  d2/d2/f3 |}]
+;;
+
+(* Check interleaving more specifically *)
+let%expect_test "Check that FS events are reported chronologically 2" =
+  in_sub_dir
+  @@ fun () ->
+  mkdir "a";
+  mkdir "b";
+  watch "a";
+  watch "b";
+  let expected_events = Queue.create () in
+  let expect (ev : Async_inotify.Event.t) = Queue.push expected_events ev in
+  let create_file fn =
+    create_file fn;
+    expect (Created fn);
+    expect (Modified fn)
+  in
+  create_file "a/x";
+  create_file "b/x";
+  create_file "a/y";
+  let expected_events = Queue.to_list expected_events in
+  check_events ~expected_events ~real_events:(collect_events ());
+  [%expect
+    {|
+    Success
+
+    created   a/x
+    modified  a/x
+    created   b/x
+    modified  b/x
+    created   a/y
+    modified  a/y |}]
+;;
+
+let run cmd =
+  match
+    snd
+      (Unix.waitpid
+         []
+         (Unix.create_process
+            (List.hd cmd)
+            (Array.of_list cmd)
+            Unix.stdin
+            Unix.stdout
+            Unix.stderr))
+  with
+  | WEXITED 0 -> ()
+  | _ -> assert false
+;;
+
+(* Check that ordering is respected when the changes are made by an external
+   process. Which is the assumption we are making for the fs sync mechanism of
+   the file watcher. *)
+let%expect_test "Check that FS events are reported chronologically 3" =
+  in_sub_dir
+  @@ fun () ->
+  mkdir "_build";
+  mkdir "_build/.sync";
+  watch ".";
+  watch "_build/.sync";
+  let actions =
+    [ `Me; `Ext; `Me; `Ext; `Ext ] |> List.mapi ~f:(fun i who -> string_of_int i, who)
+  in
+  let actions = actions @ [ "_build/.sync/1", `Me ] in
+  let do_actions () =
+    List.iter actions ~f:(fun (fn, who) ->
+      match who with
+      | `Me -> create_file fn
+      | `Ext -> run [ "touch"; fn ])
+  in
+  do_actions ();
+  let expected_events =
+    List.concat_map actions ~f:(fun (fn, _who) ->
+      [ Async_inotify.Event.Created fn; Modified fn ])
+  in
+  check_events ~expected_events ~real_events:(collect_events ());
+  [%expect
+    {|
+    Success
+
+    created   0
+    modified  0
+    created   1
+    modified  1
+    created   2
+    modified  2
+    created   3
+    modified  3
+    created   4
+    modified  4
+    created   _build/.sync/1
+    modified  _build/.sync/1 |}];
+  (* Repeat the operation multiple times *)
+  for _ = 0 to 100 do
+    List.iter actions ~f:(fun (fn, _) -> rm fn);
+    ignore (collect_events () : _ list);
+    do_actions ();
+    let real_events = collect_events () |> List.map ~f:remove_dot_slash_from_event in
+    if expected_events <> real_events
+    then (
+      print_endline "--------------------";
+      check_events ~real_events ~expected_events)
+  done
+;;

unikernel/duniverse/dune_/test/expect-tests/jsoo_tests.ml

@@ -0,0 +1,48 @@
+open Stdune
+module Jsoo_rules = Dune_rules.Jsoo_rules
+
+let%expect_test _ =
+  let test s l =
+    match Jsoo_rules.Version.of_string s with
+    | None -> print_endline "Could not parse version"
+    | Some version ->
+      let c = Jsoo_rules.Version.compare version l in
+      let r =
+        match c with
+        | Eq -> "="
+        | Lt -> "<"
+        | Gt -> ">"
+      in
+      print_endline r
+  in
+  (* equal *)
+  test "5.0.1" (5, 0);
+  [%expect {| = |}];
+  test "5.0.0" (5, 0);
+  [%expect {| = |}];
+  test "5.0" (5, 0);
+  [%expect {| = |}];
+  test "5" (5, 0);
+  [%expect {| = |}];
+  test "5.0+1" (5, 0);
+  [%expect {| = |}];
+  test "5.0~1" (5, 0);
+  [%expect {| = |}];
+  test "5.0+1" (5, 0);
+  [%expect {| = |}];
+  test "5.0.1+git-5.0.1-14-g904cf100b0" (5, 0);
+  [%expect {| = |}];
+  test "5.0.1" (5, 1);
+  [%expect {| < |}];
+  test "5.0" (5, 1);
+  [%expect {| < |}];
+  test "5.1.1" (5, 0);
+  [%expect {| > |}];
+  test "5.1" (5, 0);
+  [%expect {| > |}];
+  test "4.0.1" (5, 0);
+  [%expect {| < |}];
+  test "5.0.1" (4, 0);
+  [%expect {| > |}];
+  ()
+;;

unikernel/duniverse/dune_/test/expect-tests/memo/dune

@@ -0,0 +1,18 @@
+(library
+ (name dune_memo_unit_tests)
+ (inline_tests)
+ (libraries
+  dune_tests_common
+  stdune
+  dune_lang
+  fiber
+  memo
+  test_scheduler
+  ;; This is because of the (implicit_transitive_deps false)
+  ;; in dune-project
+  ppx_expect.config
+  ppx_expect.config_types
+  base
+  ppx_inline_test.config)
+ (preprocess
+  (pps ppx_expect)))

unikernel/duniverse/dune_/test/expect-tests/memo/graph_dump/dump_graph_tests.ml

@@ -0,0 +1,193 @@
+open Stdune
+open Memo.O
+module Graph = Dune_graph.Graph
+
+module Scheduler = struct
+  let t = Test_scheduler.create ()
+  let yield () = Test_scheduler.yield t
+  let run f = Test_scheduler.run t f
+end
+
+(* to run a computation *)
+let run m = Scheduler.run (Memo.run m)
+
+let run_memo f v =
+  try run (Memo.exec f v) with
+  | Memo.Error.E _ -> ()
+;;
+
+let a = Memo.create "A" ~input:(module Unit) (fun () -> Memo.return ())
+
+let b =
+  Memo.create
+    "B"
+    ~input:(module Unit)
+    (fun () ->
+       let+ () = Memo.exec a () in
+       ())
+;;
+
+let c =
+  Memo.create
+    "C"
+    ~input:(module Unit)
+    (fun () ->
+       let+ () = Memo.exec a () in
+       ())
+;;
+
+let d =
+  Memo.create
+    "D"
+    ~input:(module Unit)
+    (fun () ->
+       let* () = Memo.exec b () in
+       let+ () = Memo.exec c () in
+       ())
+;;
+
+let e =
+  Memo.create
+    "E"
+    ~input:(module Unit)
+    (fun () ->
+       let* () = Memo.exec d () in
+       failwith "Oops, error!")
+;;
+
+let () = run_memo e ()
+
+let%expect_test _ =
+  let graph = Scheduler.run (Memo.dump_cached_graph (Memo.cell d ())) in
+  Graph.print graph ~format:Graph.File_format.Gexf;
+  [%expect
+    {|
+    <?xml version="1.0" encoding="UTF-8"?>
+    <gexf xmlns="http://www.gexf.net/1.2draft" version="1.2">
+    <graph mode="static" defaultedgetype="directed">
+    <nodes>
+    <node id="1" label="D" />
+    <node id="2" label="B" />
+    <node id="3" label="A" />
+    <node id="4" label="C" />
+    </nodes>
+    <edges>
+    <edge id="0" source="1" target="2" />
+    <edge id="1" source="1" target="4" />
+    <edge id="2" source="2" target="3" />
+    <edge id="3" source="4" target="3" />
+    </edges>
+    </graph>
+    </gexf> |}]
+;;
+
+let%expect_test _ =
+  let graph = Scheduler.run (Memo.dump_cached_graph (Memo.cell d ())) in
+  Graph.print graph ~format:Graph.File_format.Dot;
+  [%expect
+    {|
+    strict digraph {
+    n_1 -> n_2
+    n_1 -> n_4
+    n_2 -> n_3
+    n_4 -> n_3
+    } |}]
+;;
+
+let%expect_test _ =
+  let graph = Scheduler.run (Memo.dump_cached_graph ~time_nodes:true (Memo.cell d ())) in
+  Graph.For_tests.print
+    graph
+    ~format:Graph.File_format.Gexf
+    ~opaque_attributes:(Int.Set.singleton 0);
+  [%expect
+    {|
+    <?xml version="1.0" encoding="UTF-8"?>
+    <gexf xmlns="http://www.gexf.net/1.2draft" version="1.2">
+    <graph mode="static" defaultedgetype="directed">
+    <nodes>
+    <attributes class="node">
+    <attribute id="0" title="runtime" type="float" />
+    </attributes>
+    <node id="1" label="D">
+    <attvalues>
+    <attvalue for="0" value="<opaque>" />
+    </attvalues>
+    </node>
+    <node id="2" label="B">
+    <attvalues>
+    <attvalue for="0" value="<opaque>" />
+    </attvalues>
+    </node>
+    <node id="3" label="A">
+    <attvalues>
+    <attvalue for="0" value="<opaque>" />
+    </attvalues>
+    </node>
+    <node id="4" label="C">
+    <attvalues>
+    <attvalue for="0" value="<opaque>" />
+    </attvalues>
+    </node>
+    </nodes>
+    <edges>
+    <edge id="0" source="1" target="2" />
+    <edge id="1" source="1" target="4" />
+    <edge id="2" source="2" target="3" />
+    <edge id="3" source="4" target="3" />
+    </edges>
+    </graph>
+    </gexf> |}]
+;;
+
+let%expect_test _ =
+  let graph = Scheduler.run (Memo.dump_cached_graph ~time_nodes:true (Memo.cell e ())) in
+  Graph.For_tests.print
+    graph
+    ~format:Graph.File_format.Gexf
+    ~opaque_attributes:(Int.Set.singleton 0);
+  [%expect
+    {|
+    <?xml version="1.0" encoding="UTF-8"?>
+    <gexf xmlns="http://www.gexf.net/1.2draft" version="1.2">
+    <graph mode="static" defaultedgetype="directed">
+    <nodes>
+    <attributes class="node">
+    <attribute id="0" title="runtime" type="float" />
+    </attributes>
+    <node id="0" label="E">
+    <attvalues>
+    <attvalue for="0" value="<opaque>" />
+    </attvalues>
+    </node>
+    <node id="1" label="D">
+    <attvalues>
+    <attvalue for="0" value="<opaque>" />
+    </attvalues>
+    </node>
+    <node id="2" label="B">
+    <attvalues>
+    <attvalue for="0" value="<opaque>" />
+    </attvalues>
+    </node>
+    <node id="3" label="A">
+    <attvalues>
+    <attvalue for="0" value="<opaque>" />
+    </attvalues>
+    </node>
+    <node id="4" label="C">
+    <attvalues>
+    <attvalue for="0" value="<opaque>" />
+    </attvalues>
+    </node>
+    </nodes>
+    <edges>
+    <edge id="0" source="0" target="1" />
+    <edge id="1" source="1" target="2" />
+    <edge id="2" source="1" target="4" />
+    <edge id="3" source="2" target="3" />
+    <edge id="4" source="4" target="3" />
+    </edges>
+    </graph>
+    </gexf> |}]
+;;

unikernel/duniverse/dune_/test/expect-tests/memo/graph_dump/dune

@@ -0,0 +1,15 @@
+(library
+ (name dune_memo_graph_dump_tests)
+ (inline_tests)
+ (libraries
+  stdune
+  dune_graph
+  memo
+  test_scheduler
+  ;; This is because of the (implicit_transitive_deps false)
+  ;; in dune-project
+  ppx_expect.config_types
+  base
+  ppx_inline_test.config)
+ (preprocess
+  (pps ppx_expect)))

unikernel/duniverse/dune_/test/expect-tests/memo/run_with_error_handler.ml

@@ -0,0 +1,68 @@
+open Stdune
+module Caml_lazy = Lazy
+
+module Scheduler = struct
+  let t = Test_scheduler.create ()
+  let yield () = Test_scheduler.yield t
+  let run f = Test_scheduler.run t f
+end
+
+let rec delay_n_time_units counter n =
+  if n = 0
+  then Fiber.return ()
+  else (
+    assert (n > 0);
+    Fiber.bind (Scheduler.yield ()) ~f:(fun () ->
+      incr counter;
+      delay_n_time_units counter (n - 1)))
+;;
+
+(* This test demonstrates that [Memo.run_with_error_handler] does indeed return
+   exceptions early, but it also demonstrates a problem where if you run
+   multiple instances of [run_with_error_handler] in parallel then some of them
+   get their errors delayed. *)
+let%expect_test "Memo.run_with_error_handler" =
+  let time_counter = ref 0 in
+  let error_node =
+    Memo.Lazy.create (fun () ->
+      Memo.of_reproducible_fiber
+        (Fiber.fork_and_join_unit
+           (fun () -> Fiber.map (Scheduler.yield ()) ~f:(fun () -> failwith "Error_node"))
+           (fun () -> delay_n_time_units time_counter 10)))
+  in
+  let n1 = Memo.Lazy.create (fun () -> Memo.Lazy.force error_node) in
+  let n2 = Memo.Lazy.create (fun () -> Memo.Lazy.force error_node) in
+  let run_memo_and_collect_errors m =
+    let trace = ref [] in
+    let log s = trace := (s, !time_counter) :: !trace in
+    Fiber.map
+      (Fiber.map_reduce_errors
+         (module Monoid.Unit)
+         ~on_error:(fun _exn ->
+           log "late";
+           Fiber.return ())
+         (fun () ->
+            Memo.run_with_error_handler m ~handle_error_no_raise:(fun _exn ->
+              log "early";
+              Fiber.return ())))
+      ~f:(fun _result -> !trace)
+  in
+  let trace1, trace2 =
+    Scheduler.run
+      (Fiber.fork_and_join
+         (fun () -> run_memo_and_collect_errors (fun () -> Memo.Lazy.force n1))
+         (fun () -> run_memo_and_collect_errors (fun () -> Memo.Lazy.force n2)))
+  in
+  let print_trace l =
+    List.iter (List.rev l) ~f:(fun (what, when_) -> Printf.printf "%s@%d\n" what when_)
+  in
+  print_trace trace1;
+  print_trace trace2;
+  [%expect
+    {|
+early@0
+late@10
+early@10
+late@10
+  |}]
+;;

unikernel/duniverse/dune_/test/expect-tests/module_tests.ml

@@ -0,0 +1,31 @@
+open Stdune
+module Kind = Dune_rules.Module.Kind
+
+(* See #10264 *)
+let%expect_test "Module.Kind encoding round trip" =
+  let module_name s = Dune_rules.Module_name.of_string s in
+  let test k =
+    let ast = Kind.encode k in
+    let sexp = Dune_sexp.Ast.add_loc ~loc:Loc.none ast in
+    let decoded =
+      match Dune_lang.Decoder.parse Kind.decode Univ_map.empty sexp with
+      | r -> Ok r
+      | exception e -> Error e
+    in
+    let dyn =
+      Dyn.record
+        [ "ast", Dyn.string (Dune_sexp.to_string ast)
+        ; "decoded", Or_exn.to_dyn Kind.to_dyn decoded
+        ]
+    in
+    Dune_tests_common.print_dyn dyn
+  in
+  test Impl;
+  [%expect {| { ast = "impl"; decoded = Ok "impl" } |}];
+  test (Alias []);
+  [%expect {| { ast = "alias"; decoded = Ok "alias" } |}];
+  test (Alias [ module_name "A" ]);
+  [%expect {| { ast = "(alias (A))"; decoded = Ok [ "alias"; [ "A" ] ] } |}];
+  test (Alias [ module_name "A"; module_name "B" ]);
+  [%expect {| { ast = "(alias (A B))"; decoded = Ok [ "alias"; [ "A"; "B" ] ] } |}]
+;;

unikernel/duniverse/dune_/test/expect-tests/ocamlobjinfo_tests.ml

@@ -0,0 +1,151 @@
+open! Stdune
+open Dune_tests_common
+module Ocamlobjinfo = Dune_rules.For_tests.Ocamlobjinfo
+
+let () = init ()
+
+let fixture =
+  {ocamlobjinfo|
+File _build/install/default/lib/dune/_stdune/stdune__Env.cmx
+Name: Stdune__Env
+CRC of implementation: b678d7aae434ca3158721e3a37a15776
+Globals defined:
+        Stdune__Env
+Interfaces imported:
+        053326e853ce10e1fadf8d891f08f891        Unix
+        596c497318b5c3057b47b9d6747ef5d1        Uchar
+        3fe6d98e0634486be22d9de07aa0709a        Sys
+        6339e2b71e8c583a81e808954faf6818        StringLabels
+        953d4ea121ff79e9719730997e04436d        Stdune__String
+        744ae4e7c80910dd9302bf207d11274f        Stdune__Sexp_intf
+        3a8d88a2c7628492ca76328610a53b04        Stdune__Sexp
+        788120b20799b5148dc44c2effd9db08        Stdune__Set_intf
+        764302df6c51161e13ccc4553710003d        Stdune__Set
+        7577d25061f730d87e8e0ab574216d9c        Stdune__Result
+        4d34756156087d6e6530be0d3275bde4        Stdune__Path
+        e8eebf0307152a528b7d97ebdf37d1dc        Stdune__Ordering
+        1fb9ae8c1fb73c55a857f02869cfbeab        Stdune__Map_intf
+        96daa1ecff8c9bc6c5aadf39201c2f0d        Stdune__Map
+        5b332ee2108ade34f2abc1448318c5a0        Stdune__Loc
+        721c54b94b8c3b89fffc8587041c241a        Stdune__List
+        0c6e26bc5bc285a87ab7304ee5f3bf0a        Stdune__Hashtbl_intf
+        8df5a38cb2f28d4cf23f6cd8a6c4c923        Stdune__Hashtbl
+        0ff241a400cabb742a8d681c7132c350        Stdune__Hashable
+        b438dbe8d4c60ca1bb06d04c7bc95652        Stdune__Exn
+        a1b4f657ccceb16196f104a53a0e199a        Stdune__Env
+        7643682d2d95acbcf8834a351a1e2779        Stdune__Either
+        826226f09894dc48694a431d13b9e541        Stdune__Comparator
+        69861cabc5a73becd98269ce298eaa59        Stdune__Bin
+        cbf0ce887ccceaff96f4a22a8f057799        Stdune__Array
+        37cf8dd4fc4be5636ff9f78604107f8b        Stdune__
+        28a12def19edf36c317c30fafcc03d6d        Set
+        e5dfd0ca6436c8abad976fc9e914999a        Printf
+        1b461321ebcc8e419f24eb531c5ac7ac        Printexc
+        9b04ecdc97e5102c1d342892ef7ad9a2        Pervasives
+        db5fc31b815ab3040d5a9940a91712c4        MoreLabels
+        8b8de381501aa7862270c15619322ee7        Map
+        f4e829075d9d0bb7de979cfc49c2600b        ListLabels
+        0971650cdf1fa8e506e733e9a5da2628        Lexing
+        0a88e320f172d3413ba0d5e0f9c70ccd        Hashtbl
+        1a17539924469551f027475153d4d3b5        Format
+        a4afff2bf4082efda68a6a65cf31f8e2        Stdlib__Result_compat
+        de733b926f4af640c957c8129aba4139        Stdlib__Result
+        ba19641102c1711bdb2476bb8b8dbe32        Stdlib__
+        7b10d1bd2d88af9c1da841149c988d94        Stdlib
+        cd4856c93f21942683ce190142e88396        Complex
+        79ae8c0eb753af6b441fe05456c7970b        CamlinternalFormatBasics
+        4ff98b0650eef9c38ee9c9930e0c3e9b        CamlinternalBigarray
+        9c9b3639d23d7746c571cdf04646eb29        Buffer
+        c4974e11dd7c941c002b826edc727de8        ArrayLabels
+Implementations imported:
+        e28bcdad48b0cb1739e47106149016cb        Unix
+        3c11d6a8ae012d6541b58cecff4809d5        Sys
+        --------------------------------        Stdune__String
+        --------------------------------        Stdune__Sexp
+        --------------------------------        Stdune__Set
+        --------------------------------        Stdune__Map
+        --------------------------------        Stdune__List
+        --------------------------------        Stdune__Exn
+        --------------------------------        Stdune__Bin
+        --------------------------------        Stdune__Array
+        a3cdcb16ec3b460d51a685302e993c0b        Printf
+Clambda approximation:
+  _
+Currying functions: 3 2
+Apply functions: 3 2
+Send functions:
+Force link: no
+|ocamlobjinfo}
+;;
+
+let parse s = Ocamlobjinfo.parse s |> Ocamlobjinfo.to_dyn |> print_dyn
+
+let%expect_test _ =
+  parse fixture;
+  [%expect
+    {|
+{ impl =
+    set
+      { "printf"
+      ; "stdune__Array"
+      ; "stdune__Bin"
+      ; "stdune__Exn"
+      ; "stdune__List"
+      ; "stdune__Map"
+      ; "stdune__Set"
+      ; "stdune__Sexp"
+      ; "stdune__String"
+      ; "sys"
+      ; "unix"
+      }
+; intf =
+    set
+      { "arrayLabels"
+      ; "buffer"
+      ; "camlinternalBigarray"
+      ; "camlinternalFormatBasics"
+      ; "complex"
+      ; "format"
+      ; "hashtbl"
+      ; "lexing"
+      ; "listLabels"
+      ; "map"
+      ; "moreLabels"
+      ; "pervasives"
+      ; "printexc"
+      ; "printf"
+      ; "set"
+      ; "stdlib"
+      ; "stdlib__"
+      ; "stdlib__Result"
+      ; "stdlib__Result_compat"
+      ; "stdune__"
+      ; "stdune__Array"
+      ; "stdune__Bin"
+      ; "stdune__Comparator"
+      ; "stdune__Either"
+      ; "stdune__Env"
+      ; "stdune__Exn"
+      ; "stdune__Hashable"
+      ; "stdune__Hashtbl"
+      ; "stdune__Hashtbl_intf"
+      ; "stdune__List"
+      ; "stdune__Loc"
+      ; "stdune__Map"
+      ; "stdune__Map_intf"
+      ; "stdune__Ordering"
+      ; "stdune__Path"
+      ; "stdune__Result"
+      ; "stdune__Set"
+      ; "stdune__Set_intf"
+      ; "stdune__Sexp"
+      ; "stdune__Sexp_intf"
+      ; "stdune__String"
+      ; "stringLabels"
+      ; "sys"
+      ; "uchar"
+      ; "unix"
+      }
+}
+|}]
+;;

unikernel/duniverse/dune_/test/expect-tests/persistent_tests.ml

@@ -0,0 +1,58 @@
+open Stdune
+module Persistent = Dune_util.Persistent
+module Digest = Dune_digest
+
+let test (type a) (module Persistent : Persistent.Desc with type t = a) (example : a) =
+  let digest = Digest.generic example |> Digest.to_string in
+  printfn "%s version %d\n%s\n---\n" Persistent.name Persistent.version digest
+;;
+
+let%expect_test "persistent digests" =
+  Persistent.test_examples ()
+  (* These digests are to make sure that we're bumping the version whenever we
+     change the format of the values stored with [Persistent].
+
+     The usual workflow goes something like this:
+
+     1. The format of [Persistent.t] changes
+     2. The new value is reflected by the value returned [test_example]
+     3. The digest in this test suite changes and the test therefore fails
+
+     To fix the test, the correct thing to do is to bump the appropriate
+     version number where the persistent module is defined *)
+  |> Stdlib.Seq.iter (fun (Persistent.T (desc, example)) -> test desc example);
+  [%expect
+    {|
+    PROMOTED-TO-DELETE version 3
+    65e543aaf5ccc8148d50a1305aa3622b
+    ---
+
+    DIGEST-DB version 7
+    48031a13035ffa6b93b6b79ce277d39c
+    ---
+
+    INSTALL-COOKIE version 2
+    da4ce847dd41df462849adecfe43f4eb
+    ---
+
+    TO-PROMOTE version 3
+    f2d6070d92c27497a6c2d89782d81c99
+    ---
+
+    COPY-LINE-DIRECTIVE-MAP version 2
+    72eb282c39bb084e69d6bd1615b8aaec
+    ---
+
+    CRAM-RESULT version 1
+    65e543aaf5ccc8148d50a1305aa3622b
+    ---
+
+    merlin-conf version 7
+    a14a4700929a15bb2030e36f71e66d20
+    ---
+
+    INCREMENTAL-DB version 6
+    5d401c8cac2683cee736494457885f1f
+    ---
+    |}]
+;;

unikernel/duniverse/dune_/test/expect-tests/process_tests.ml

@@ -0,0 +1,32 @@
+open Stdune
+open! Dune_tests_common
+open Dune_engine
+
+let go =
+  let config =
+    Clflags.display := Short;
+    { Scheduler.Config.concurrency = 1
+    ; stats = None
+    ; print_ctrl_c_warning = true
+    ; watch_exclusions = []
+    }
+  in
+  Scheduler.Run.go config ~file_watcher:No_watcher ~on_event:(fun _ _ -> ())
+;;
+
+let true_ = Bin.which "true" ~path:(Env_path.path Env.initial) |> Option.value_exn
+
+let%expect_test "null input" =
+  let stdin_from = Process.(Io.null In) in
+  let run () = Process.run ~display:Quiet ~stdin_from Strict true_ [] in
+  let _res = go run in
+  [%expect {||}]
+;;
+
+let%expect_test "null output" =
+  let stdout_to = Process.(Io.null Out) in
+  let stderr_to = Process.(Io.null Out) in
+  let run () = Process.run ~display:Quiet ~stdout_to ~stderr_to Strict true_ [] in
+  let _res = go run in
+  [%expect {||}]
+;;

unikernel/duniverse/dune_/test/expect-tests/scheduler_tests.ml

@@ -0,0 +1,110 @@
+open Stdune
+open! Dune_tests_common
+open Dune_engine
+open Fiber.O
+
+let () = init ()
+
+let default =
+  Clflags.display := Short;
+  { Scheduler.Config.concurrency = 1
+  ; stats = None
+  ; print_ctrl_c_warning = false
+  ; watch_exclusions = []
+  }
+;;
+
+let go ?(timeout_seconds = 0.3) ?(config = default) f =
+  try
+    Scheduler.Run.go
+      ~timeout_seconds
+      config
+      ~file_watcher:No_watcher
+      ~on_event:(fun _ _ -> ())
+      f
+  with
+  | Scheduler.Run.Shutdown.E Requested -> ()
+;;
+
+let true_ = Bin.which "true" ~path:(Env_path.path Env.initial) |> Option.value_exn
+let cell = Memo.lazy_cell Memo.return
+
+let%expect_test "cancelling a build" =
+  let build_started = Fiber.Ivar.create () in
+  let build_cancelled = Fiber.Ivar.create () in
+  go (fun () ->
+    Fiber.fork_and_join_unit
+      (fun () ->
+         Scheduler.Run.poll
+           (let* () = Fiber.Ivar.fill build_started () in
+            let* () = Fiber.Ivar.read build_cancelled in
+            let* res =
+              Fiber.collect_errors (fun () ->
+                Scheduler.with_job_slot (fun _ _ -> Fiber.return ()))
+            in
+            print_endline
+              (match res with
+               | Ok () -> "FAIL: build wasn't cancelled"
+               | Error _ -> "PASS: build was cancelled");
+            let* () = Scheduler.shutdown () in
+            Fiber.never))
+      (fun () ->
+         let* () = Fiber.Ivar.read build_started in
+         let* () =
+           Scheduler.inject_memo_invalidation (Memo.Cell.invalidate cell ~reason:Unknown)
+         in
+         (* Wait for the scheduler to acknowledge the change *)
+         let* () = Scheduler.wait_for_build_input_change () in
+         Fiber.Ivar.fill build_cancelled ()));
+  [%expect {| PASS: build was cancelled |}]
+;;
+
+(* CR-soon jeremiedimino: currently cancelling a build cancels not only this
+   build but also all running fibers, including ones that are unrelated. *)
+let%expect_test "cancelling a build: effect on other fibers" =
+  let build_started = Fiber.Ivar.create () in
+  go (fun () ->
+    Fiber.fork_and_join_unit
+      (fun () ->
+         Scheduler.Run.poll
+           (let* () = Fiber.Ivar.fill build_started () in
+            Fiber.never))
+      (fun () ->
+         let* () = Fiber.Ivar.read build_started in
+         let* () =
+           Scheduler.inject_memo_invalidation (Memo.Cell.invalidate cell ~reason:Unknown)
+         in
+         let* () = Scheduler.wait_for_build_input_change () in
+         let* res = Fiber.collect_errors (fun () -> Fiber.return ()) in
+         print_endline
+           (match res with
+            | Ok () -> "PASS: we can still run things outside the build"
+            | Error _ -> "FAIL: other fiber got cancelled");
+         Scheduler.shutdown ()));
+  [%expect {| PASS: we can still run things outside the build |}]
+;;
+
+let%expect_test "raise inside Scheduler.Run.go" =
+  (try
+     (go
+      @@ fun () ->
+      Fiber.fork_and_join_unit
+        (fun () ->
+           print_endline "t1";
+           Fiber.return ())
+        (fun () -> raise Exit));
+     assert false
+   with
+   | Dune_util.Report_error.Already_reported -> print_endline "--> exception observed");
+  [%expect
+    {|
+    t1
+    Error: exception Stdlib.Exit
+
+    I must not crash.  Uncertainty is the mind-killer. Exceptions are the
+    little-death that brings total obliteration.  I will fully express my cases.
+    Execution will pass over me and through me.  And when it has gone past, I
+    will unwind the stack along its path.  Where the cases are handled there will
+    be nothing.  Only I will remain.
+    --> exception observed |}]
+;;

unikernel/duniverse/dune_/test/expect-tests/scheme/dune

@@ -0,0 +1,17 @@
+(library
+ (name scheme_tests)
+ (libraries
+  stdune
+  dune_engine
+  scheme
+  fiber
+  memo
+  ;; This is because of the (implicit_transitive_deps false)
+  ;; in dune-project
+  ppx_expect.config
+  ppx_expect.config_types
+  base
+  ppx_inline_test.config)
+ (inline_tests)
+ (preprocess
+  (pps ppx_expect)))

unikernel/duniverse/dune_/test/expect-tests/scheme/scheme_tests.ml

@@ -0,0 +1,208 @@
+open Stdune
+open Memo.O
+
+let print = Printf.printf "%s\n"
+
+module Directory_rules = struct
+  type element =
+    | File of string
+    | Thunk of (unit -> t)
+
+  and t = element Appendable_list.t
+
+  let empty = Appendable_list.empty
+  let union = Appendable_list.( @ )
+  let concat t = List.fold_left t ~init:empty ~f:union
+  let thunk f = Appendable_list.singleton (Thunk f)
+  let file f = Appendable_list.singleton (File f)
+
+  let rec force l =
+    List.concat_map (Appendable_list.to_list l) ~f:(function
+      | File t -> [ t ]
+      | Thunk f -> force (f ()))
+  ;;
+end
+
+module Scheme = struct
+  include Scheme
+
+  (* Calls [print] every time any code embedded in the scheme runs, be it a
+     [Thunk] constructor or an [Approximation] function.
+
+     The argument of [print] identifies which thunk got run (the path to that
+     thunk within the [Scheme.t] value). *)
+  let instrument ~print =
+    let print path suffix = print (String.concat (List.rev path @ [ suffix ]) ~sep:":") in
+    let rec go ~path t : _ Scheme.t =
+      match (t : _ Scheme.t) with
+      | Empty -> Empty
+      | Union (t1, t2) -> Union (go ~path:("l" :: path) t1, go ~path:("r" :: path) t2)
+      | Approximation (dirs, rules) ->
+        let path = "t" :: path in
+        Approximation (dirs, go ~path rules)
+      | Finite m -> Finite m
+      | Thunk t ->
+        Thunk
+          (fun () ->
+            print path "thunk";
+            t ())
+    in
+    go ~path:[]
+  ;;
+
+  (* [collect_rules_simple] is oversimplified in two ways: - it does not share
+     the work of scheme flattening, so repeated lookups do repeated work - it
+     does not check that approximations are correct
+
+     If approximations are not correct, it will honor the approximation. So
+     approximations act like views that prevent the rules from being seen rather
+     than from being declared in the first place. *)
+  let collect_rules_simple =
+    let rec go t ~dir =
+      match t with
+      | Empty -> Memo.return Directory_rules.empty
+      | Union (a, b) ->
+        let+ a = go a ~dir
+        and+ b = go b ~dir in
+        Directory_rules.union a b
+      | Approximation (dirs, t) ->
+        (match Dune_engine.Dir_set.mem dirs dir with
+         | true -> go t ~dir
+         | false -> Memo.return Directory_rules.empty)
+      | Finite rules ->
+        Memo.return
+          (match Path.Build.Map.find rules dir with
+           | None -> Directory_rules.empty
+           | Some rule -> rule)
+      | Thunk f ->
+        let* t = f () in
+        go t ~dir
+    in
+    go
+  ;;
+
+  let evaluate = evaluate ~union:Directory_rules.union
+
+  let get_rules t ~dir =
+    let+ rules, _ = Evaluated.get_rules t ~dir in
+    Option.value rules ~default:Directory_rules.empty
+  ;;
+end
+
+module Dir_set = Dune_engine.Dir_set
+
+module Path = struct
+  include Path.Build
+
+  let of_string str =
+    L.relative
+      root
+      (match String.split str ~on:'/' with
+       | [ "" ] -> []
+       | [ "." ] -> []
+       | other -> other)
+  ;;
+end
+
+let record_calls scheme ~f =
+  let calls = ref [] in
+  let scheme = Scheme.instrument ~print:(fun s -> calls := s :: !calls) scheme in
+  let+ res = f scheme in
+  Directory_rules.force res, !calls
+;;
+
+let print_rules scheme ~dir =
+  let* res1, calls1 = record_calls scheme ~f:(Scheme.collect_rules_simple ~dir) in
+  let+ res2, calls2 =
+    record_calls scheme ~f:(fun scheme ->
+      Scheme.evaluate scheme >>= Scheme.get_rules ~dir)
+  in
+  if not ((res1 : string list) = res2)
+  then
+    Code_error.raise
+      "Naive [collect_rules_simple] gives result inconsistent with [Scheme.evaluate]"
+      [ "res1", Dyn.(list string) res1; "res2", Dyn.(list string) res2 ]
+  else (
+    let print_log log =
+      let log =
+        match log with
+        | [] -> [ "<none>" ]
+        | x -> x
+      in
+      List.iter log ~f:(fun s -> print ("    " ^ s))
+    in
+    if not ((calls1 : string list) = calls2)
+    then (
+      print "inconsistent laziness behavior:";
+      print "naive calls:";
+      print_log calls1;
+      print "[evaluate] calls:";
+      print_log calls2)
+    else (
+      print "calls:";
+      print_log calls1);
+    print "rules:";
+    print_log res1)
+;;
+
+let run m = Fiber.run (Memo.run m) ~iter:(fun () -> assert false)
+let print_rules scheme ~dir = run @@ print_rules scheme ~dir
+
+open Scheme
+
+let%expect_test _ =
+  let scheme = Scheme.Thunk (fun () -> Memo.return Scheme.Empty) in
+  print_rules scheme ~dir:(Path.of_string "foo/bar");
+  [%expect
+    {|
+calls:
+    thunk
+rules:
+    <none>
+|}]
+;;
+
+let scheme_all_but_foo_bar =
+  Scheme.Approximation
+    ( Dir_set.negate (Dir_set.subtree (Path.of_string "foo/bar"))
+    , Thunk (fun () -> Memo.return Empty) )
+;;
+
+let%expect_test _ =
+  print_rules scheme_all_but_foo_bar ~dir:(Path.of_string "unrelated/dir");
+  [%expect
+    {|
+calls:
+    t:thunk
+rules:
+    <none>
+|}]
+;;
+
+let%expect_test _ =
+  print_rules scheme_all_but_foo_bar ~dir:(Path.of_string "foo/bar");
+  [%expect
+    {|
+inconsistent laziness behavior:
+naive calls:
+    <none>
+[evaluate] calls:
+    t:thunk
+rules:
+    <none>
+|}]
+;;
+
+let%expect_test _ =
+  print_rules scheme_all_but_foo_bar ~dir:(Path.of_string "foo/bar/baz");
+  [%expect
+    {|
+inconsistent laziness behavior:
+naive calls:
+    <none>
+[evaluate] calls:
+    t:thunk
+rules:
+    <none>
+|}]
+;;

unikernel/duniverse/dune_/test/expect-tests/test_scheduler/dune

@@ -0,0 +1,3 @@
+(library
+ (name test_scheduler)
+ (libraries stdune fiber))

unikernel/duniverse/dune_/test/expect-tests/test_scheduler/test_scheduler.ml

@@ -0,0 +1,34 @@
+open Stdune
+
+type job = Job : (unit -> 'a) * 'a Fiber.Ivar.t -> job
+type t = job Queue.t
+
+let create () : t = Queue.create ()
+
+let yield t =
+  Fiber.of_thunk
+  @@ fun () ->
+  let ivar = Fiber.Ivar.create () in
+  Queue.push t (Job ((fun () -> ()), ivar));
+  Fiber.Ivar.read ivar
+;;
+
+let yield_gen (t : t) ~do_in_scheduler =
+  Fiber.of_thunk
+  @@ fun () ->
+  let ivar = Fiber.Ivar.create () in
+  Queue.push t (Job (do_in_scheduler, ivar));
+  Fiber.Ivar.read ivar
+;;
+
+exception Never
+
+let run (t : t) fiber =
+  Queue.clear t;
+  Fiber.run fiber ~iter:(fun () ->
+    match Queue.pop t with
+    | None -> raise Never
+    | Some (Job (job, ivar)) ->
+      let v = job () in
+      [ Fiber.Fill (ivar, v) ])
+;;

unikernel/duniverse/dune_/test/expect-tests/test_scheduler/test_scheduler.mli

@@ -0,0 +1,10 @@
+(** Dummy scheduler for tests using fibers *)
+
+type t
+
+exception Never
+
+val create : unit -> t
+val yield : t -> unit Fiber.t
+val yield_gen : t -> do_in_scheduler:(unit -> 'a) -> 'a Fiber.t
+val run : t -> 'a Fiber.t -> 'a

unikernel/duniverse/dune_/test/expect-tests/timer_tests.ml

@@ -0,0 +1,61 @@
+open Stdune
+open Fiber.O
+module Scheduler = Dune_engine.Scheduler
+
+let config =
+  Dune_engine.Clflags.display := Short;
+  { Scheduler.Config.concurrency = 1
+  ; stats = None
+  ; print_ctrl_c_warning = false
+  ; watch_exclusions = []
+  }
+;;
+
+let%expect_test "create and wait for timer" =
+  Scheduler.Run.go
+    ~on_event:(fun _ _ -> ())
+    config
+    (fun () ->
+       let now () = Unix.gettimeofday () in
+       let start = now () in
+       let duration = 0.2 in
+       let+ () = Scheduler.sleep ~seconds:duration in
+       assert (now () -. start >= duration);
+       print_endline "timer finished successfully");
+  [%expect {| timer finished successfully |}]
+;;
+
+let%expect_test "multiple timers" =
+  Scheduler.Run.go
+    ~on_event:(fun _ _ -> ())
+    config
+    (fun () ->
+       [ 0.3; 0.2; 0.1 ]
+       |> Fiber.parallel_iter ~f:(fun duration ->
+         let+ () = Scheduler.sleep ~seconds:duration in
+         printfn "finished %0.2f" duration));
+  [%expect
+    {|
+    finished 0.10
+    finished 0.20
+    finished 0.30 |}]
+;;
+
+let%expect_test "run process with timeout" =
+  Scheduler.Run.go
+    ~on_event:(fun _ _ -> ())
+    config
+    (fun () ->
+       let pid =
+         let prog =
+           let path = Env.get Env.initial "PATH" |> Option.value_exn |> Bin.parse_path in
+           Bin.which ~path "sleep" |> Option.value_exn |> Path.to_string
+         in
+         Spawn.spawn ~prog ~argv:[ prog; "100000" ] () |> Pid.of_int
+       in
+       let+ _ = Scheduler.wait_for_process ~timeout_seconds:0.1 pid in
+       print_endline "sleep timed out");
+  [%expect
+    {|
+    sleep timed out |}]
+;;

unikernel/duniverse/dune_/test/expect-tests/vcs/dune

@@ -0,0 +1,25 @@
+(library
+ (name vcs_tests)
+ (inline_tests
+  (deps
+   ;; TODO split this into two tests: one for git and one for hg. The hg test
+   ;; should live under a different alias
+   ;; %{bin:hg}
+   %{bin:git}))
+ (modules vcs_tests)
+ (libraries
+  dune_tests_common
+  stdune
+  dune_util
+  dune_vcs
+  dune_engine
+  fiber
+  memo
+  ;; This is because of the (implicit_transitive_deps false)
+  ;; in dune-project
+  ppx_expect.config
+  ppx_expect.config_types
+  base
+  ppx_inline_test.config)
+ (preprocess
+  (pps ppx_expect)))

unikernel/duniverse/dune_/test/expect-tests/vcs/vcs_tests.ml

@@ -0,0 +1,253 @@
+open Stdune
+open Fiber.O
+open Dune_vcs
+open! Dune_tests_common
+module Process = Dune_engine.Process
+module Scheduler = Dune_engine.Scheduler
+
+let () = init ()
+let printf = Printf.printf
+let temp_dir = lazy (Path.of_string "vcs-tests")
+let () = at_exit (fun () -> Path.rm_rf (Lazy.force temp_dir))
+
+(* When hg is not available, we test with git twice indeed. This is because many
+   people don't have hg installed. *)
+let has_hg =
+  match Lazy.force Vcs.hg with
+  | (_ : Path.t) -> true
+  | exception _ -> false
+;;
+
+let run (vcs : Vcs.t) args =
+  let prog, prog_str, real_args =
+    match vcs.kind with
+    | Git -> Vcs.git, "git", args
+    | Hg ->
+      if has_hg
+      then Vcs.hg, "hg", args
+      else
+        ( Vcs.git
+        , "hg"
+        , (match args with
+           | [ "tag"; s; "-u"; _ ] -> [ "tag"; "-a"; s; "-m"; s ]
+           | [ "commit"; "-m"; msg; "-u"; _ ] -> [ "commit"; "-m"; msg ]
+           | _ -> args) )
+  in
+  printf "$ %s\n" (String.quote_list_for_shell (prog_str :: args));
+  Process.run
+    Strict
+    (Lazy.force prog)
+    real_args
+    ~display:Quiet
+    ~env:
+      ((* One of the reasons to set GIT_DIR is to override any GIT_DIR set by
+          the environment, which helps for example during [git rebase
+          --exec]. *)
+       Env.add
+         Env.initial
+         ~var:"GIT_DIR"
+         ~value:(Filename.concat (Path.to_absolute_filename vcs.root) ".git"))
+    ~dir:vcs.root
+    ~stdout_to:(Process.Io.file Dev_null.path Process.Io.Out)
+;;
+
+type action =
+  | Init
+  | Add of string
+  | Write of string * string
+  | Commit
+  | Tag of string
+  | Describe of string
+
+let run_action (vcs : Vcs.t) action =
+  match action with
+  | Init ->
+    let* () = run vcs [ "init"; "-q" ] in
+    (match vcs.kind with
+     | Hg -> Fiber.return ()
+     | Git ->
+       let* () = run vcs [ "config"; "user.email"; "dune@dune.com" ] in
+       run vcs [ "config"; "user.name"; "Dune Dune" ])
+  | Add fn -> run vcs [ "add"; fn ]
+  | Commit ->
+    (match vcs.kind with
+     | Git -> run vcs [ "commit"; "-m"; "commit message" ]
+     | Hg -> run vcs [ "commit"; "-m"; "commit message"; "-u"; "toto" ])
+  | Write (fn, s) ->
+    printf "$ echo %S > %s\n" s fn;
+    Io.write_file (Path.relative (Lazy.force temp_dir) fn) s;
+    Fiber.return ()
+  | Describe expected ->
+    printf
+      "$ %s describe [...]\n"
+      (match vcs.kind with
+       | Git -> "git"
+       | Hg -> "hg");
+    Memo.reset (Memo.Invalidation.clear_caches ~reason:Test);
+    let vcs =
+      match vcs.kind with
+      | Hg when not has_hg -> { vcs with kind = Git }
+      | _ -> vcs
+    in
+    let+ s = Memo.run (Vcs.describe vcs) in
+    let s = Option.value s ~default:"n/a" in
+    let processed =
+      String.split s ~on:'-'
+      |> List.map ~f:(fun s ->
+        match s with
+        | "" | "dirty" -> s
+        | s
+          when String.length s = 1
+               && String.for_all s ~f:(function
+                 | '0' .. '9' -> true
+                 | _ -> false) -> s
+        | _
+          when String.for_all s ~f:(function
+                 | '0' .. '9' | 'a' .. 'z' -> true
+                 | _ -> false) -> "<commit-id>"
+        | _ -> s)
+      |> String.concat ~sep:"-"
+    in
+    printf "%s\n" processed;
+    if processed <> expected then printf "Expected: %s\nOriginal: %s\n" expected s;
+    printf "\n"
+  | Tag s ->
+    (match vcs.kind with
+     | Git -> run vcs [ "tag"; "-a"; s; "-m"; s ]
+     | Hg -> run vcs [ "tag"; s; "-u"; "toto" ])
+;;
+
+let run kind script =
+  let (lazy temp_dir) = temp_dir in
+  Path.rm_rf temp_dir;
+  Path.mkdir_p temp_dir;
+  let vcs = { Vcs.kind; root = temp_dir } in
+  Dune_engine.Clflags.display := Short;
+  let config =
+    { Scheduler.Config.concurrency = 1
+    ; stats = None
+    ; print_ctrl_c_warning = false
+    ; watch_exclusions = []
+    }
+  in
+  Scheduler.Run.go
+    ~on_event:(fun _ _ -> ())
+    config
+    (fun () -> Fiber.sequential_iter script ~f:(run_action vcs))
+;;
+
+let script =
+  [ Init
+  ; Write ("a", "-")
+  ; Add "a"
+  ; Commit
+  ; Describe "<commit-id>"
+  ; Write ("b", "-")
+  ; Add "b"
+  ; Describe "<commit-id>-dirty"
+  ; Commit
+  ; Describe "<commit-id>"
+  ; Tag "1.0"
+  ; Describe "1.0"
+  ; Write ("c", "-")
+  ; Add "c"
+  ; Describe "1.0-dirty"
+  ; Commit
+  ; Describe "1.0-1-<commit-id>"
+  ; Write ("d", "-")
+  ; Add "d"
+  ; Describe "1.0-1-<commit-id>-dirty"
+  ; Commit
+  ; Describe "1.0-2-<commit-id>"
+  ]
+;;
+
+let%expect_test _ =
+  run Git script;
+  [%expect
+    {|
+$ git init -q
+$ git config user.email dune@dune.com
+$ git config user.name 'Dune Dune'
+$ echo "-" > a
+$ git add a
+$ git commit -m 'commit message'
+$ git describe [...]
+<commit-id>
+
+$ echo "-" > b
+$ git add b
+$ git describe [...]
+<commit-id>-dirty
+
+$ git commit -m 'commit message'
+$ git describe [...]
+<commit-id>
+
+$ git tag -a 1.0 -m 1.0
+$ git describe [...]
+1.0
+
+$ echo "-" > c
+$ git add c
+$ git describe [...]
+1.0-dirty
+
+$ git commit -m 'commit message'
+$ git describe [...]
+1.0-1-<commit-id>
+
+$ echo "-" > d
+$ git add d
+$ git describe [...]
+1.0-1-<commit-id>-dirty
+
+$ git commit -m 'commit message'
+$ git describe [...]
+1.0-2-<commit-id>
+|}]
+;;
+
+let%expect_test _ =
+  run Hg script;
+  [%expect
+    {|
+$ hg init -q
+$ echo "-" > a
+$ hg add a
+$ hg commit -m 'commit message' -u toto
+$ hg describe [...]
+<commit-id>
+
+$ echo "-" > b
+$ hg add b
+$ hg describe [...]
+<commit-id>-dirty
+
+$ hg commit -m 'commit message' -u toto
+$ hg describe [...]
+<commit-id>
+
+$ hg tag 1.0 -u toto
+$ hg describe [...]
+1.0
+
+$ echo "-" > c
+$ hg add c
+$ hg describe [...]
+1.0-dirty
+
+$ hg commit -m 'commit message' -u toto
+$ hg describe [...]
+1.0-1-<commit-id>
+
+$ echo "-" > d
+$ hg add d
+$ hg describe [...]
+1.0-1-<commit-id>-dirty
+
+$ hg commit -m 'commit message' -u toto
+$ hg describe [...]
+1.0-2-<commit-id>
+|}]
+;;