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 |}]
+;;