unikernel/duniverse/lwt/test/unix/bytes_io_data

@@ -0,0 +1 @@
+abcdef

unikernel/duniverse/lwt/test/unix/dummy.ml

@@ -0,0 +1,31 @@
+(* This file is part of Lwt, released under the MIT license. See LICENSE.md for
+   details, or visit https://github.com/ocsigen/lwt/blob/master/LICENSE.md. *)
+
+
+
+let test_input_str = "the quick brown fox jumps over the lazy dog"
+let test_input = Bytes.of_string test_input_str
+let test_input_len = Bytes.length test_input
+
+let read () =
+  let buf = Bytes.create test_input_len in
+  let rec aux n =
+    let i = Unix.read Unix.stdin buf n (Bytes.length buf - n) in
+    if i = 0 || n + i = test_input_len then
+      Bytes.equal buf test_input
+    else aux (n + i)
+  in
+  if aux 0 then
+    (* make sure there's nothing more to read *)
+    0 = Unix.read Unix.stdin buf 0 1
+  else false
+
+let write fd =
+  assert (test_input_len = Unix.write fd test_input 0 test_input_len)
+
+let () =
+  match Sys.argv.(1) with
+  | "read" -> exit @@ if read () then 0 else 1
+  | "write" -> write Unix.stdout
+  | "errwrite" -> write Unix.stderr
+  | _ -> invalid_arg "Sys.argv"

unikernel/duniverse/lwt/test/unix/dune

@@ -0,0 +1,56 @@
+(library
+ (name tester)
+ (libraries lwt lwttester)
+ (modules
+  (:standard
+   \
+   main
+   dummy
+   ocaml_runtime_exc_1
+   ocaml_runtime_exc_2
+   ocaml_runtime_exc_3
+   ocaml_runtime_exc_4
+   ocaml_runtime_exc_5
+   ocaml_runtime_exc_6)))
+
+(executable
+ (name dummy)
+ (modules dummy)
+ (libraries unix))
+
+(test
+ (name main)
+ (package lwt)
+ (libraries lwttester tester)
+ (modules main)
+ (deps bytes_io_data %{exe:dummy.exe}))
+
+(test
+ (name ocaml_runtime_exc_1)
+ (libraries lwt lwt.unix)
+ (modules ocaml_runtime_exc_1))
+
+(test
+ (name ocaml_runtime_exc_2)
+ (libraries lwt lwt.unix)
+ (modules ocaml_runtime_exc_2))
+
+(test
+ (name ocaml_runtime_exc_3)
+ (libraries lwt lwt.unix)
+ (modules ocaml_runtime_exc_3))
+
+(test
+ (name ocaml_runtime_exc_4)
+ (libraries lwt lwt.unix)
+ (modules ocaml_runtime_exc_4))
+
+(test
+ (name ocaml_runtime_exc_5)
+ (libraries lwt lwt.unix)
+ (modules ocaml_runtime_exc_5))
+
+(test
+ (name ocaml_runtime_exc_6)
+ (libraries lwt lwt.unix)
+ (modules ocaml_runtime_exc_6))

unikernel/duniverse/lwt/test/unix/main.ml

@@ -0,0 +1,18 @@
+(* This file is part of Lwt, released under the MIT license. See LICENSE.md for
+   details, or visit https://github.com/ocsigen/lwt/blob/master/LICENSE.md. *)
+
+open Tester
+
+let () =
+  Test.concurrent "unix" [
+    Test_lwt_unix.suite;
+    Test_lwt_io.suite;
+    Test_lwt_io_non_block.suite;
+    Test_lwt_process.suite;
+    Test_lwt_engine.suite;
+    Test_mcast.suite;
+    Test_lwt_fmt.suite;
+    Test_lwt_timeout.suite;
+    Test_lwt_bytes.suite;
+    Test_sleep_and_timeout.suite;
+  ]

unikernel/duniverse/lwt/test/unix/ocaml_runtime_exc_1.ml

@@ -0,0 +1,29 @@
+(* This file is part of Lwt, released under the MIT license. See LICENSE.md for
+   details, or visit https://github.com/ocsigen/lwt/blob/master/LICENSE.md. *)
+
+(* set the exception filter being tested *)
+let () = Lwt.Exception_filter.(set handle_all_except_runtime)
+
+(* OCaml runtime exceptions (out-of-memory, stack-overflow) are fatal in a
+   different way than other exceptions and they leave the Lwt main loop in an
+   inconsistent state where it cannot be restarted. Indeed, attempting to call
+   [Lwt_main.run] again after it has crashed with a runtime exception causes a
+   "Nested calls to Lwt_main.run are not allowed" error.
+
+   For this reason, we run this test as its own executable rather than as part
+   of a larger suite. *)
+
+open Lwt.Syntax
+
+let test () =
+  try
+    let () = Lwt_main.run (
+      let* () = Lwt.pause () in
+      if true then raise Out_of_memory else Lwt.return_unit
+    ) in
+    Printf.eprintf "Test run+raise failure\n";
+    Stdlib.exit 1
+  with
+    | Out_of_memory -> ()
+
+let () = test ()

unikernel/duniverse/lwt/test/unix/ocaml_runtime_exc_2.ml

@@ -0,0 +1,30 @@
+(* This file is part of Lwt, released under the MIT license. See LICENSE.md for
+   details, or visit https://github.com/ocsigen/lwt/blob/master/LICENSE.md. *)
+
+(* set the exception filter being tested *)
+let () = Lwt.Exception_filter.(set handle_all_except_runtime)
+
+(* OCaml runtime exceptions (out-of-memory, stack-overflow) are fatal in a
+   different way than other exceptions and they leave the Lwt main loop in an
+   inconsistent state where it cannot be restarted. Indeed, attempting to call
+   [Lwt_main.run] again after it has crashed with a runtime exception causes a
+   "Nested calls to Lwt_main.run are not allowed" error.
+
+   For this reason, we run this test as its own executable rather than as part
+   of a larger suite. *)
+
+open Lwt.Syntax
+
+let test () =
+  try
+    let () = Lwt_main.run (
+      let* () = Lwt_unix.sleep 0.001 in
+      if true then raise Out_of_memory else Lwt.return_unit
+    ) in
+    Printf.eprintf "Test run+raise failure\n";
+    Stdlib.exit 1
+  with
+    | Out_of_memory -> ()
+
+let () = test ()
+

unikernel/duniverse/lwt/test/unix/ocaml_runtime_exc_3.ml

@@ -0,0 +1,34 @@
+(* This file is part of Lwt, released under the MIT license. See LICENSE.md for
+   details, or visit https://github.com/ocsigen/lwt/blob/master/LICENSE.md. *)
+
+(* set the exception filter being tested *)
+let () = Lwt.Exception_filter.(set handle_all_except_runtime)
+
+(* OCaml runtime exceptions (out-of-memory, stack-overflow) are fatal in a
+   different way than other exceptions and they leave the Lwt main loop in an
+   inconsistent state where it cannot be restarted. Indeed, attempting to call
+   [Lwt_main.run] again after it has crashed with a runtime exception causes a
+   "Nested calls to Lwt_main.run are not allowed" error.
+
+   For this reason, we run this test as its own executable rather than as part
+   of a larger suite. *)
+
+open Lwt.Syntax
+
+let test () =
+  try
+    let () = Lwt_main.run (
+      let* () = Lwt.pause () in
+      Lwt.choose [
+        (let* () = Lwt.pause () in raise Out_of_memory);
+        Lwt_unix.sleep 2.;
+      ]
+    ) in
+    Printf.eprintf "Test run+raise failure\n";
+    Stdlib.exit 1
+  with
+    | Out_of_memory -> ()
+
+let () = test ()
+
+

unikernel/duniverse/lwt/test/unix/ocaml_runtime_exc_4.ml

@@ -0,0 +1,33 @@
+(* This file is part of Lwt, released under the MIT license. See LICENSE.md for
+   details, or visit https://github.com/ocsigen/lwt/blob/master/LICENSE.md. *)
+
+(* set the exception filter being tested *)
+let () = Lwt.Exception_filter.(set handle_all_except_runtime)
+
+(* OCaml runtime exceptions (out-of-memory, stack-overflow) are fatal in a
+   different way than other exceptions and they leave the Lwt main loop in an
+   inconsistent state where it cannot be restarted. Indeed, attempting to call
+   [Lwt_main.run] again after it has crashed with a runtime exception causes a
+   "Nested calls to Lwt_main.run are not allowed" error.
+
+   For this reason, we run this test as its own executable rather than as part
+   of a larger suite. *)
+
+open Lwt.Syntax
+
+let test () =
+  try
+    let () = Lwt_main.run (
+      let* () = Lwt.pause () in
+      Lwt.catch
+        (fun () -> raise Out_of_memory)
+        (fun _ -> Lwt.return_unit)
+    ) in
+    Printf.eprintf "Test run+raise failure\n";
+    Stdlib.exit 1
+  with
+    | Out_of_memory -> ()
+
+let () = test ()
+
+

unikernel/duniverse/lwt/test/unix/ocaml_runtime_exc_5.ml

@@ -0,0 +1,35 @@
+(* This file is part of Lwt, released under the MIT license. See LICENSE.md for
+   details, or visit https://github.com/ocsigen/lwt/blob/master/LICENSE.md. *)
+
+(* set the exception filter being tested *)
+let () = Lwt.Exception_filter.(set handle_all_except_runtime)
+
+(* OCaml runtime exceptions (out-of-memory, stack-overflow) are fatal in a
+   different way than other exceptions and they leave the Lwt main loop in an
+   inconsistent state where it cannot be restarted. Indeed, attempting to call
+   [Lwt_main.run] again after it has crashed with a runtime exception causes a
+   "Nested calls to Lwt_main.run are not allowed" error.
+
+   For this reason, we run this test as its own executable rather than as part
+   of a larger suite. *)
+
+open Lwt.Syntax
+
+let test () =
+  try
+    let () = Lwt_main.run (
+      let* () = Lwt.pause () in
+      let _ =
+        Lwt.async
+          (fun () -> let* () = Lwt.pause () in raise Out_of_memory)
+      in
+      Lwt_unix.sleep 0.5
+    ) in
+    Printf.eprintf "Test run+raise failure\n";
+    Stdlib.exit 1
+  with
+    | Out_of_memory -> ()
+
+let () = test ()
+
+

unikernel/duniverse/lwt/test/unix/ocaml_runtime_exc_6.ml

@@ -0,0 +1,36 @@
+(* This file is part of Lwt, released under the MIT license. See LICENSE.md for
+   details, or visit https://github.com/ocsigen/lwt/blob/master/LICENSE.md. *)
+
+(* set the exception filter being tested *)
+let () = Lwt.Exception_filter.(set handle_all_except_runtime)
+
+(* OCaml runtime exceptions (out-of-memory, stack-overflow) are fatal in a
+   different way than other exceptions and they leave the Lwt main loop in an
+   inconsistent state where it cannot be restarted. Indeed, attempting to call
+   [Lwt_main.run] again after it has crashed with a runtime exception causes a
+   "Nested calls to Lwt_main.run are not allowed" error.
+
+   For this reason, we run this test as its own executable rather than as part
+   of a larger suite. *)
+
+open Lwt.Syntax
+
+let test () =
+  try
+    let () = Lwt_main.run (
+      let* () = Lwt.pause () in
+      let _ =
+        Lwt.dont_wait
+          (fun () -> let* () = Lwt.pause () in raise Out_of_memory)
+          (fun _ -> ())
+      in
+      Lwt_unix.sleep 0.5
+    ) in
+    Printf.eprintf "Test run+raise failure\n";
+    Stdlib.exit 1
+  with
+    | Out_of_memory -> ()
+
+let () = test ()
+
+

unikernel/duniverse/lwt/test/unix/test_lwt_bytes.ml

@@ -0,0 +1,845 @@
+(* This file is part of Lwt, released under the MIT license. See LICENSE.md for
+   details, or visit https://github.com/ocsigen/lwt/blob/master/LICENSE.md. *)
+
+open Lwt.Infix
+open Test
+
+let bytes_equal (b1:Bytes.t) (b2:Bytes.t) = b1 = b2
+
+let tcp_server_client_exchange server_logic client_logic =
+  let server_is_ready, notify_server_is_ready = Lwt.wait () in
+  let server () =
+    let sock = Lwt_unix.socket Lwt_unix.PF_INET Lwt_unix.SOCK_STREAM 0 in
+    let sockaddr = Lwt_unix.ADDR_INET (Unix.inet_addr_loopback, 0) in
+    Lwt_unix.bind sock sockaddr
+    >>= fun () ->
+    let server_address = Lwt_unix.getsockname sock in
+    let () = Lwt_unix.listen sock 5 in
+    Lwt.wakeup_later notify_server_is_ready server_address;
+    Lwt_unix.accept sock
+    >>= fun (fd_client, _) ->
+    server_logic fd_client
+    >>= fun _n -> Lwt_unix.close fd_client
+    >>= fun () -> Lwt_unix.close sock
+  in
+  let client () =
+    server_is_ready
+    >>= fun sockaddr ->
+    let sock = Lwt_unix.socket Lwt_unix.PF_INET Lwt_unix.SOCK_STREAM 0 in
+    Lwt_unix.connect sock sockaddr
+    >>= fun () ->
+    client_logic sock
+    >>= fun _n -> Lwt_unix.close sock
+  in
+  Lwt.join [client (); server ()]
+
+let udp_server_client_exchange server_logic client_logic =
+  let server_is_ready, notify_server_is_ready = Lwt.wait () in
+  let server () =
+    let sock = Lwt_unix.socket Lwt_unix.PF_INET Lwt_unix.SOCK_DGRAM 0 in
+    let sockaddr = Lwt_unix.ADDR_INET (Unix.inet_addr_loopback, 0) in
+    Lwt_unix.bind sock sockaddr
+    >>= fun () ->
+    let server_address = Lwt_unix.getsockname sock in
+    Lwt.wakeup_later notify_server_is_ready server_address;
+    server_logic sock
+    >>= fun (_n, _sockaddr) -> Lwt_unix.close sock
+  in
+  let client () =
+    server_is_ready
+    >>= fun sockaddr ->
+    let sock = Lwt_unix.socket Lwt_unix.PF_INET Lwt_unix.SOCK_DGRAM 0 in
+    client_logic sock sockaddr
+    >>= fun (_n) -> Lwt_unix.close sock
+  in
+  Lwt.join [client (); server ()]
+
+let gen_buf n =
+  let buf = Lwt_bytes.create n in
+  let () = Lwt_bytes.fill buf 0 n '\x00' in
+  buf
+
+(* The two following helpers only focus on the behavior of
+ * Lwt_bytes.mincore and Lwt_bytes.wait_mincore with different arguments that
+ * represents correct or bad bounds.
+ *
+ * The main purposes of those functions are not tested.
+ * *)
+
+let file_suffix =
+  let last_file_suffix = ref 0 in
+  fun () ->
+    incr last_file_suffix;
+    !last_file_suffix
+
+let test_mincore buff_len offset n_states =
+  let test_file = Printf.sprintf "bytes_mincore_write_%i" (file_suffix ()) in
+  Lwt_unix.openfile test_file [O_RDWR;O_TRUNC; O_CREAT] 0o666
+  >>= fun fd ->
+  let buf_write = gen_buf buff_len in
+  Lwt_bytes.write fd buf_write 0 buff_len
+  >>= fun _n ->
+  Lwt_unix.close fd
+  >>= fun () ->
+  let fd = Unix.openfile test_file [O_RDONLY] 0 in
+  let shared = false in
+  let size = buff_len in
+  let buffer = Lwt_bytes.map_file ~fd ~shared ~size () in
+  let states = Array.make n_states false in
+  let () = Lwt_bytes.mincore buffer offset states in
+  Lwt.return_unit
+
+let test_wait_mincore buff_len offset =
+  let test_file = Printf.sprintf "bytes_mincore_write_%i" (file_suffix ()) in
+  Lwt_unix.openfile test_file [O_RDWR;O_TRUNC; O_CREAT] 0o666
+  >>= fun fd ->
+  let buf_write = gen_buf buff_len in
+  Lwt_bytes.write fd buf_write 0 buff_len
+  >>= fun _n ->
+  Lwt_unix.close fd
+  >>= fun () ->
+  let fd = Unix.openfile test_file [O_RDONLY] 0 in
+  let shared = false in
+  let size = buff_len in
+  let buffer = Lwt_bytes.map_file ~fd ~shared ~size () in
+  Lwt_bytes.wait_mincore buffer offset
+
+let suite = suite "lwt_bytes" [
+    test "create" begin fun () ->
+      let len = 5 in
+      let buff = Lwt_bytes.create len in
+      let len' = Bigarray.Array1.dim buff in
+      Lwt.return (len = len')
+    end;
+
+    test "get/set" begin fun () ->
+      let buff = Lwt_bytes.create 4 in
+      let () = Lwt_bytes.set buff 0 'a' in
+      let () = Lwt_bytes.set buff 1 'b' in
+      let () = Lwt_bytes.set buff 2 'c' in
+      let check = Lwt_bytes.get buff 0 = 'a' &&
+                  Lwt_bytes.get buff 1 = 'b' &&
+                  Lwt_bytes.get buff 2 = 'c'
+      in Lwt.return check
+    end;
+
+    test "get out of bounds : lower limit" begin fun () ->
+      let buff = Lwt_bytes.create 3 in
+      match Lwt_bytes.get buff (-1) with
+      | exception Invalid_argument _ -> Lwt.return_true
+      | _ -> Lwt.return_false
+    end;
+
+    test "get out of bounds : upper limit" begin fun () ->
+      let buff = Lwt_bytes.create 3 in
+      match Lwt_bytes.get buff 3 with
+      | exception Invalid_argument _ -> Lwt.return_true
+      | _ -> Lwt.return_false
+    end;
+
+    test "set out of bounds : lower limit" begin fun () ->
+      let buff = Lwt_bytes.create 3 in
+      match Lwt_bytes.set buff (-1) 'a' with
+      | exception Invalid_argument _ -> Lwt.return_true
+      | () -> Lwt.return_false
+    end;
+
+    test "set out of bounds : upper limit" begin fun () ->
+      let buff = Lwt_bytes.create 3 in
+      match Lwt_bytes.set buff 3 'a' with
+      | exception Invalid_argument _ -> Lwt.return_true
+      | () -> Lwt.return_false
+    end;
+
+    test "unsafe_get/unsafe_set" begin fun () ->
+      let buff = Lwt_bytes.create 4 in
+      let () = Lwt_bytes.unsafe_set buff 0 'a' in
+      let () = Lwt_bytes.unsafe_set buff 1 'b' in
+      let () = Lwt_bytes.unsafe_set buff 2 'c' in
+      let check = Lwt_bytes.unsafe_get buff 0 = 'a' &&
+                  Lwt_bytes.unsafe_get buff 1 = 'b' &&
+                  Lwt_bytes.unsafe_get buff 2 = 'c'
+      in Lwt.return check
+    end;
+
+    test "of bytes" begin fun () ->
+      let bytes = Bytes.of_string "abc" in
+      let buff = Lwt_bytes.of_bytes bytes in
+      let check = Lwt_bytes.get buff 0 = Bytes.get bytes 0 &&
+                  Lwt_bytes.get buff 1 = Bytes.get bytes 1 &&
+                  Lwt_bytes.get buff 2 = Bytes.get bytes 2
+      in Lwt.return check
+    end;
+
+    test "of string" begin fun () ->
+      let buff = Lwt_bytes.of_string "abc" in
+      let check = Lwt_bytes.get buff 0 = 'a' &&
+                  Lwt_bytes.get buff 1 = 'b' &&
+                  Lwt_bytes.get buff 2 = 'c'
+      in Lwt.return check
+    end;
+
+    test "to bytes" begin fun () ->
+      let bytes = Bytes.of_string "abc" in
+      let buff = Lwt_bytes.of_bytes bytes in
+      let bytes' = Lwt_bytes.to_bytes buff in
+      let check = bytes_equal bytes bytes' in
+      Lwt.return check
+    end;
+
+    test "to string" begin fun () ->
+      let str = "abc" in
+      let buff = Lwt_bytes.of_string str in
+      let str' = Lwt_bytes.to_string buff in
+      let check = str = str' in
+      Lwt.return check
+    end;
+
+    test "blit" begin fun () ->
+      let str1 = "abc" in
+      let buf1 = Lwt_bytes.of_string str1 in
+      let str2 = "abcdef" in
+      let buf2 = Lwt_bytes.of_string str2 in
+      let () = Lwt_bytes.blit buf1 0 buf2 3 3 in
+      let check = "abcabc" = Lwt_bytes.to_string buf2 in
+      Lwt.return check
+    end;
+
+    test "blit source out of bounds: lower limit" begin fun () ->
+      let str1 = "abc" in
+      let buf1 = Lwt_bytes.of_string str1 in
+      let str2 = "abcdef" in
+      let buf2 = Lwt_bytes.of_string str2 in
+      match Lwt_bytes.blit buf1 (-1) buf2 3 3 with
+      | exception Invalid_argument _ -> Lwt.return_true
+      | () -> Lwt.return_false
+    end;
+
+    test "blit source out of bounds: upper limit" begin fun () ->
+      let str1 = "abc" in
+      let buf1 = Lwt_bytes.of_string str1 in
+      let str2 = "abcdef" in
+      let buf2 = Lwt_bytes.of_string str2 in
+      match Lwt_bytes.blit buf1 1 buf2 3 3 with
+      | exception Invalid_argument _ -> Lwt.return_true
+      | () -> Lwt.return_false
+    end;
+
+    test "blit destination out of bounds: lower limit" begin fun () ->
+      let str1 = "abc" in
+      let buf1 = Lwt_bytes.of_string str1 in
+      let str2 = "abcdef" in
+      let buf2 = Lwt_bytes.of_string str2 in
+      match Lwt_bytes.blit buf1 0 buf2 (-1) 3 with
+      | exception Invalid_argument _ -> Lwt.return_true
+      | () -> Lwt.return_false
+    end;
+
+    test "blit destination out of bounds: upper limit" begin fun () ->
+      let str1 = "abc" in
+      let buf1 = Lwt_bytes.of_string str1 in
+      let str2 = "abcdef" in
+      let buf2 = Lwt_bytes.of_string str2 in
+      match Lwt_bytes.blit buf1 0 buf2 4 3 with
+      | exception Invalid_argument _ -> Lwt.return_true
+      | () -> Lwt.return_false
+    end;
+
+    test "blit length out of bounds: lower limit" begin fun () ->
+      let str1 = "abc" in
+      let buf1 = Lwt_bytes.of_string str1 in
+      let str2 = "abcdef" in
+      let buf2 = Lwt_bytes.of_string str2 in
+      match Lwt_bytes.blit buf1 0 buf2 3 (-1) with
+      | exception Invalid_argument _ -> Lwt.return_true
+      | () -> Lwt.return_false
+    end;
+
+    test "blit from bytes" begin fun () ->
+      let bytes1 = Bytes.of_string "abc" in
+      let str2 = "abcdef" in
+      let buf2 = Lwt_bytes.of_string str2 in
+      let () = Lwt_bytes.blit_from_bytes bytes1 0 buf2 3 3 in
+      let check = "abcabc" = Lwt_bytes.to_string buf2 in
+      Lwt.return check
+    end;
+
+    test "blit from bytes source out of bounds: lower limit" begin fun () ->
+      let bytes1 = Bytes.of_string "abc" in
+      let str2 = "abcdef" in
+      let buf2 = Lwt_bytes.of_string str2 in
+      match Lwt_bytes.blit_from_bytes bytes1 (-1) buf2 3 3 with
+      | exception Invalid_argument _ -> Lwt.return_true
+      | () -> Lwt.return_false
+    end;
+
+    test "blit from bytes source out of bounds: upper limit" begin fun () ->
+      let bytes1 = Bytes.of_string "abc" in
+      let str2 = "abcdef" in
+      let buf2 = Lwt_bytes.of_string str2 in
+      match Lwt_bytes.blit_from_bytes bytes1 1 buf2 3 3 with
+      | exception Invalid_argument _ -> Lwt.return_true
+      | () -> Lwt.return_false
+    end;
+
+    test "blit from bytes destination out of bounds: lower limit" begin fun () ->
+      let bytes1 = Bytes.of_string "abc" in
+      let str2 = "abcdef" in
+      let buf2 = Lwt_bytes.of_string str2 in
+      match Lwt_bytes.blit_from_bytes bytes1 0 buf2 (-1) 3 with
+      | exception Invalid_argument _ -> Lwt.return_true
+      | () -> Lwt.return_false
+    end;
+
+    test "blit from bytes destination out of bounds: upper limit" begin fun () ->
+      let bytes1 = Bytes.of_string "abc" in
+      let str2 = "abcdef" in
+      let buf2 = Lwt_bytes.of_string str2 in
+      match Lwt_bytes.blit_from_bytes bytes1 0 buf2 4 3 with
+      | exception Invalid_argument _ -> Lwt.return_true
+      | () -> Lwt.return_false
+    end;
+
+    test "blit from bytes length out of bounds: lower limit" begin fun () ->
+      let bytes1 = Bytes.of_string "abc" in
+      let str2 = "abcdef" in
+      let buf2 = Lwt_bytes.of_string str2 in
+      match Lwt_bytes.blit_from_bytes bytes1 0 buf2 3 (-1) with
+      | exception Invalid_argument _ -> Lwt.return_true
+      | () -> Lwt.return_false
+      end;
+
+    test "blit from string" begin fun () ->
+      let string1 = "abc" in
+      let str2 = "abcdef" in
+      let buf2 = Lwt_bytes.of_string str2 in
+      let () = Lwt_bytes.blit_from_string string1 0 buf2 3 3 in
+      let check = "abcabc" = Lwt_bytes.to_string buf2 in
+      Lwt.return check
+    end;
+
+    test "blit from string source out of bounds: lower limit" begin fun () ->
+      let string1 = "abc" in
+      let str2 = "abcdef" in
+      let buf2 = Lwt_bytes.of_string str2 in
+      match Lwt_bytes.blit_from_string string1 (-1) buf2 3 3 with
+      | exception Invalid_argument _ -> Lwt.return_true
+      | () -> Lwt.return_false
+    end;
+
+    test "blit from string source out of bounds: upper limit" begin fun () ->
+      let string1 = "abc" in
+      let str2 = "abcdef" in
+      let buf2 = Lwt_bytes.of_string str2 in
+      match Lwt_bytes.blit_from_string string1 1 buf2 3 3 with
+      | exception Invalid_argument _ -> Lwt.return_true
+      | () -> Lwt.return_false
+    end;
+
+    test "blit from string destination out of bounds: lower limit" begin fun () ->
+      let string1 = "abc" in
+      let str2 = "abcdef" in
+      let buf2 = Lwt_bytes.of_string str2 in
+      match Lwt_bytes.blit_from_string string1 0 buf2 (-1) 3 with
+      | exception Invalid_argument _ -> Lwt.return_true
+      | () -> Lwt.return_false
+    end;
+
+    test "blit from string destination out of bounds: upper limit" begin fun () ->
+      let string1 = "abc" in
+      let str2 = "abcdef" in
+      let buf2 = Lwt_bytes.of_string str2 in
+      match Lwt_bytes.blit_from_string string1 0 buf2 4 3 with
+      | exception Invalid_argument _ -> Lwt.return_true
+      | () -> Lwt.return_false
+    end;
+
+    test "blit from string length out of bounds: lower limit" begin fun () ->
+      let string1 = "abc" in
+      let str2 = "abcdef" in
+      let buf2 = Lwt_bytes.of_string str2 in
+      match Lwt_bytes.blit_from_string string1 0 buf2 3 (-1) with
+      | exception Invalid_argument _ -> Lwt.return_true
+      | () -> Lwt.return_false
+    end;
+
+    test "blit from string length out of bounds: upper limit" begin fun () ->
+      let string1 = "abc" in
+      let str2 = "abcdef" in
+      let buf2 = Lwt_bytes.of_string str2 in
+      match Lwt_bytes.blit_from_string string1 0 buf2 3 10 with
+      | exception Invalid_argument _ -> Lwt.return_true
+      | () -> Lwt.return_false
+    end;
+
+    test "blit to bytes" begin fun () ->
+      let str1 = "abc" in
+      let buf1 = Lwt_bytes.of_string str1 in
+      let str2 = "abcdef" in
+      let bytes2 = Bytes.of_string str2 in
+      let () = Lwt_bytes.blit_to_bytes buf1 0 bytes2 3 3 in
+      let check = "abcabc" = Bytes.to_string bytes2 in
+      Lwt.return check
+    end;
+
+    test "blit to bytes source out of bounds: lower limit" begin fun () ->
+      let str1 = "abc" in
+      let buf1 = Lwt_bytes.of_string str1 in
+      let str2 = "abcdef" in
+      let bytes2 = Bytes.of_string str2 in
+      match Lwt_bytes.blit_to_bytes buf1 (-1) bytes2 3 3 with
+      | exception Invalid_argument _ -> Lwt.return_true
+      | () -> Lwt.return_false
+    end;
+
+    test "blit to bytes source out of bounds: upper limit" begin fun () ->
+      let str1 = "abc" in
+      let buf1 = Lwt_bytes.of_string str1 in
+      let str2 = "abcdef" in
+      let bytes2 = Bytes.of_string str2 in
+      match Lwt_bytes.blit_to_bytes buf1 1 bytes2 3 3 with
+      | exception Invalid_argument _ -> Lwt.return_true
+      | () -> Lwt.return_false
+    end;
+
+    test "blit to bytes destination out of bounds: lower limit" begin fun () ->
+      let str1 = "abc" in
+      let buf1 = Lwt_bytes.of_string str1 in
+      let str2 = "abcdef" in
+      let bytes2 = Bytes.of_string str2 in
+      match Lwt_bytes.blit_to_bytes buf1 0 bytes2 (-1) 3 with
+      | exception Invalid_argument _ -> Lwt.return_true
+      | () -> Lwt.return_false
+    end;
+
+    test "blit to bytes destination out of bounds: upper limit" begin fun () ->
+      let str1 = "abc" in
+      let buf1 = Lwt_bytes.of_string str1 in
+      let str2 = "abcdef" in
+      let bytes2 = Bytes.of_string str2 in
+      match Lwt_bytes.blit_to_bytes buf1 0 bytes2 4 3 with
+      | exception Invalid_argument _ -> Lwt.return_true
+      | () -> Lwt.return_false
+    end;
+
+    test "blit to bytes length out of bounds: lower limit" begin fun () ->
+      let str1 = "abc" in
+      let buf1 = Lwt_bytes.of_string str1 in
+      let str2 = "abcdef" in
+      let bytes2 = Bytes.of_string str2 in
+      match Lwt_bytes.blit_to_bytes buf1 0 bytes2 3 (-1) with
+      | exception Invalid_argument _ -> Lwt.return_true
+      | () -> Lwt.return_false
+    end;
+
+    test "unsafe blit" begin fun () ->
+      let str1 = "abc" in
+      let buf1 = Lwt_bytes.of_string str1 in
+      let str2 = "abcdef" in
+      let buf2 = Lwt_bytes.of_string str2 in
+      let () = Lwt_bytes.unsafe_blit buf1 0 buf2 3 3 in
+      let check = "abcabc" = Lwt_bytes.to_string buf2 in
+      Lwt.return check
+    end;
+
+    test "unsafe blit from bytes" begin fun () ->
+      let bytes1 = Bytes.of_string "abc" in
+      let str2 = "abcdef" in
+      let buf2 = Lwt_bytes.of_string str2 in
+      let () = Lwt_bytes.unsafe_blit_from_bytes bytes1 0 buf2 3 3 in
+      let check = "abcabc" = Lwt_bytes.to_string buf2 in
+      Lwt.return check
+    end;
+
+    test "unsafe blit from string" begin fun () ->
+      let string1 = "abc" in
+      let str2 = "abcdef" in
+      let buf2 = Lwt_bytes.of_string str2 in
+      let () = Lwt_bytes.unsafe_blit_from_string string1 0 buf2 3 3 in
+      let check = "abcabc" = Lwt_bytes.to_string buf2 in
+      Lwt.return check
+    end;
+
+    test "unsafe blit to bytes" begin fun () ->
+      let str1 = "abc" in
+      let buf1 = Lwt_bytes.of_string str1 in
+      let str2 = "abcdef" in
+      let bytes2 = Bytes.of_string str2 in
+      let () = Lwt_bytes.unsafe_blit_to_bytes buf1 0 bytes2 3 3 in
+      let check = "abcabc" = Bytes.to_string bytes2 in
+      Lwt.return check
+    end;
+
+    test "proxy" begin fun () ->
+      let str = "abcdef" in
+      let buf = Lwt_bytes.of_string str in
+      let buf' = Lwt_bytes.proxy buf 3 3 in
+      let check1 = "def" = Lwt_bytes.to_string buf' in
+      let () = Lwt_bytes.set buf 3 'a' in
+      let check2 = "aef" = Lwt_bytes.to_string buf' in
+      Lwt.return (check1 && check2)
+    end;
+
+    test "proxy offset out of bounds: lower limit" begin fun () ->
+      let str = "abcdef" in
+      let buf = Lwt_bytes.of_string str in
+      match Lwt_bytes.proxy buf (-1) 3 with
+      | exception Invalid_argument _ -> Lwt.return_true
+      | _ -> Lwt.return_false
+    end;
+
+    test "proxy offset out of bounds: upper limit" begin fun () ->
+      let str = "abcdef" in
+      let buf = Lwt_bytes.of_string str in
+      match Lwt_bytes.proxy buf 4 3 with
+      | exception Invalid_argument _ -> Lwt.return_true
+      | _ -> Lwt.return_false
+    end;
+
+    test "proxy length out of bounds: lower limit" begin fun () ->
+      let str = "abcdef" in
+      let buf = Lwt_bytes.of_string str in
+      match Lwt_bytes.proxy buf 3 (-1) with
+      | exception Invalid_argument _ -> Lwt.return_true
+      | _ -> Lwt.return_false
+    end;
+
+    test "extract" begin fun () ->
+      let str = "abcdef" in
+      let buf = Lwt_bytes.of_string str in
+      let buf' = Lwt_bytes.extract buf 3 3 in
+      let check = "def" = Lwt_bytes.to_string buf' in
+      Lwt.return check
+    end;
+
+    test "extract offset out of bounds: lower limit" begin fun () ->
+      let str = "abcdef" in
+      let buf = Lwt_bytes.of_string str in
+      match Lwt_bytes.extract buf (-1) 3 with
+      | exception Invalid_argument _ -> Lwt.return_true
+      | _ -> Lwt.return_false
+    end;
+
+    test "extract offset out of bounds: upper limit" begin fun () ->
+      let str = "abcdef" in
+      let buf = Lwt_bytes.of_string str in
+      match Lwt_bytes.extract buf 4 3 with
+      | exception Invalid_argument _ -> Lwt.return_true
+      | _ -> Lwt.return_false
+    end;
+
+    test "extract length out of bounds: lower limit" begin fun () ->
+      let str = "abcdef" in
+      let buf = Lwt_bytes.of_string str in
+      match Lwt_bytes.extract buf 3 (-1) with
+      | exception Invalid_argument _ -> Lwt.return_true
+      | _ -> Lwt.return_false
+    end;
+
+    test "copy" begin fun () ->
+      let str = "abc" in
+      let buf = Lwt_bytes.of_string str in
+      let buf' = Lwt_bytes.copy buf in
+      let check = str = Lwt_bytes.to_string buf' in
+      Lwt.return check
+    end;
+
+    test "fill" begin fun () ->
+      let str = "abcdef" in
+      let buf = Lwt_bytes.of_string str in
+      let () = Lwt_bytes.fill buf 3 3 'a' in
+      let check = "abcaaa" = Lwt_bytes.to_string buf in
+      Lwt.return check
+    end;
+
+    test "fill offset out of bounds: lower limit" begin fun () ->
+      let str = "abcdef" in
+      let buf = Lwt_bytes.of_string str in
+      match Lwt_bytes.fill buf (-1) 3 'a' with
+      | exception Invalid_argument _ -> Lwt.return_true
+      | () -> Lwt.return_false
+    end;
+
+    test "fill offset out of bounds: upper limit" begin fun () ->
+      let str = "abcdef" in
+      let buf = Lwt_bytes.of_string str in
+      match Lwt_bytes.fill buf 4 3 'a' with
+      | exception Invalid_argument _ -> Lwt.return_true
+      | () -> Lwt.return_false
+    end;
+
+    test "fill length out of bounds lower limit" begin fun () ->
+      let str = "abcdef" in
+      let buf = Lwt_bytes.of_string str in
+      match Lwt_bytes.fill buf 3 (-1) 'a' with
+      | exception Invalid_argument _ -> Lwt.return_true
+      | () -> Lwt.return_false
+    end;
+
+    test "unsafe fill" begin fun () ->
+      let str = "abcdef" in
+      let buf = Lwt_bytes.of_string str in
+      let () = Lwt_bytes.unsafe_fill buf 3 3 'a' in
+      let check = "abcaaa" = Lwt_bytes.to_string buf in
+      Lwt.return check
+    end;
+
+    test "bytes read" begin fun () ->
+      let test_file = "bytes_io_data" in
+      Lwt_unix.openfile test_file [O_RDONLY] 0
+      >>= fun fd ->
+      let buf = Lwt_bytes.create 6 in
+      Lwt_bytes.read fd buf 0 6
+      >>= fun _n ->
+      let check = "abcdef" = Lwt_bytes.to_string buf in
+      Lwt_unix.close fd
+      >>= fun () ->
+      Lwt.return check
+    end;
+
+    test "read: buffer retention" ~sequential:true begin fun () ->
+      let buffer = Lwt_bytes.create 3 in
+
+      let read_fd, write_fd = Lwt_unix.pipe ~cloexec:true () in
+      Lwt_unix.set_blocking read_fd true;
+
+      Lwt_unix.write_string write_fd "foo" 0 3 >>= fun _ ->
+
+      let retained = Lwt_unix.retained buffer in
+      Lwt_bytes.read read_fd buffer 0 3 >>= fun _ ->
+
+      Lwt_unix.close write_fd >>= fun () ->
+      Lwt_unix.close read_fd >|= fun () ->
+
+      !retained
+    end;
+
+    test "bytes write" begin fun () ->
+      let test_file = "bytes_io_data_write" in
+      Lwt_unix.openfile test_file [O_RDWR;O_TRUNC; O_CREAT] 0o666
+      >>= fun fd ->
+      let buf_write = Lwt_bytes.of_string "abc" in
+      Lwt_bytes.write fd buf_write 0 3
+      >>= fun _n ->
+      Lwt_unix.close fd
+      >>= fun () ->
+      Lwt_unix.openfile test_file [O_RDONLY] 0
+      >>= fun fd ->
+      let buf_read = Lwt_bytes.create 3 in
+      Lwt_bytes.read fd buf_read 0 3
+      >>= fun _n ->
+      let check = buf_write = buf_read in
+      Lwt_unix.close fd
+      >>= fun () ->
+      Lwt.return check
+    end;
+
+    test "write: buffer retention" ~sequential:true begin fun () ->
+      let buffer = Lwt_bytes.create 3 in
+
+      let read_fd, write_fd = Lwt_unix.pipe ~cloexec:true () in
+      Lwt_unix.set_blocking write_fd true;
+
+      let retained = Lwt_unix.retained buffer in
+      Lwt_bytes.write write_fd buffer 0 3 >>= fun _ ->
+
+      Lwt_unix.close write_fd >>= fun () ->
+      Lwt_unix.close read_fd >|= fun () ->
+
+      !retained
+    end;
+
+    test "bytes recv" ~only_if:(fun () -> not Sys.win32) begin fun () ->
+      let buf = gen_buf 6 in
+      let server_logic socket =
+        Lwt_unix.write_string socket "abcdefghij" 0 9
+      in
+      let client_logic socket =
+        Lwt_bytes.recv socket buf 0 6 []
+      in
+      tcp_server_client_exchange server_logic client_logic
+      >>= fun () ->
+      let check = "abcdef" = Lwt_bytes.to_string buf in
+      Lwt.return check
+    end;
+
+    test "bytes send" ~only_if:(fun () -> not Sys.win32) begin fun () ->
+      let buf = gen_buf 6 in
+      let server_logic socket =
+        Lwt_bytes.send socket (Lwt_bytes.of_string "abcdef") 0 6 []
+      in
+      let client_logic socket =
+        Lwt_bytes.recv socket buf 0 6 []
+      in
+      tcp_server_client_exchange server_logic client_logic
+      >>= fun () ->
+      let check = "abcdef" = Lwt_bytes.to_string buf in
+      Lwt.return check
+    end;
+
+    test "bytes recvfrom" ~only_if:(fun () -> not Sys.win32) begin fun () ->
+      let buf = gen_buf 6 in
+      let server_logic socket =
+        Lwt_bytes.recvfrom socket buf 0 6 []
+      in
+      let client_logic socket sockaddr =
+        Lwt_unix.sendto socket (Bytes.of_string "abcdefghij") 0 9 [] sockaddr
+      in
+      udp_server_client_exchange server_logic client_logic
+      >>= fun () ->
+      let check = "abcdef" = Lwt_bytes.to_string buf in
+      Lwt.return check
+    end;
+
+    test "bytes sendto" ~only_if:(fun () -> not Sys.win32) begin fun () ->
+      let buf = gen_buf 6 in
+      let server_logic socket =
+        Lwt_bytes.recvfrom socket buf 0 6 []
+      in
+      let client_logic socket sockaddr =
+        let message = Lwt_bytes.of_string "abcdefghij" in
+        Lwt_bytes.sendto socket message 0 9 [] sockaddr
+      in
+      udp_server_client_exchange server_logic client_logic
+      >>= fun () ->
+      let check = "abcdef" = Lwt_bytes.to_string buf in
+      Lwt.return check
+    end;
+
+    test "bytes recv_msg" ~only_if:(fun () -> not Sys.win32) begin fun () ->
+      let buffer = gen_buf 6 in
+      let offset = 0 in
+      let io_vectors = [Lwt_bytes.io_vector ~buffer ~offset ~length:6] in
+      let server_logic socket =
+        (Lwt_bytes.recv_msg [@ocaml.warning "-3"]) ~socket ~io_vectors
+      in
+      let client_logic socket sockaddr =
+        let message = Lwt_bytes.of_string "abcdefghij" in
+        Lwt_bytes.sendto socket message 0 9 [] sockaddr
+      in
+      udp_server_client_exchange server_logic client_logic
+      >>= fun () ->
+      let check = "abcdef" = Lwt_bytes.to_string buffer in
+      Lwt.return check
+    end;
+
+    test "bytes send_msg" ~only_if:(fun () -> not Sys.win32) begin fun () ->
+      let buffer = gen_buf 6 in
+      let offset = 0 in
+      let server_logic socket =
+        let io_vectors = [Lwt_bytes.io_vector ~buffer ~offset ~length:6] in
+        (Lwt_bytes.recv_msg [@ocaml.warning "-3"]) ~socket ~io_vectors
+      in
+      let client_logic socket sockaddr =
+        Lwt_unix.connect socket sockaddr
+        >>= fun () ->
+        let message = Lwt_bytes.of_string "abcdefghij" in
+        let io_vectors = [Lwt_bytes.io_vector ~buffer:message ~offset ~length:9] in
+        (Lwt_bytes.send_msg [@ocaml.warning "-3"]) ~socket ~io_vectors ~fds:[]
+      in
+      udp_server_client_exchange server_logic client_logic
+      >>= fun () ->
+      let check = "abcdef" = Lwt_bytes.to_string buffer in
+      Lwt.return check
+    end;
+
+    test "send_msgto" ~only_if:(fun () -> not Sys.win32) begin fun () ->
+      let buffer = gen_buf 6 in
+      let offset = 0 in
+      let server_logic socket =
+        let io_vectors = [Lwt_bytes.io_vector ~buffer ~offset ~length:6] in
+        (Lwt_bytes.recv_msg [@ocaml.warning "-3"]) ~socket ~io_vectors
+      in
+      let client_logic socket sockaddr =
+        let message = Lwt_bytes.of_string "abcdefghij" in
+        let io_vectors = Lwt_unix.IO_vectors.create () in
+        Lwt_unix.IO_vectors.append_bigarray io_vectors message offset 9;
+        Lwt_unix.send_msgto ~socket ~io_vectors ~fds:[] ~dest:sockaddr
+      in
+      udp_server_client_exchange server_logic client_logic
+      >>= fun () ->
+      let check = "abcdef" = Lwt_bytes.to_string buffer in
+      Lwt.return check
+    end;
+
+    test "map_file" begin fun () ->
+      let test_file = "bytes_io_data" in
+      let fd = Unix.openfile test_file [O_RDONLY] 0 in
+      let shared = false in
+      let size = 6 in
+      let buffer = Lwt_bytes.map_file ~fd ~shared ~size () in
+      let check = "abcdef" = Lwt_bytes.to_string buffer in
+      let () = Unix.close fd in
+      Lwt.return check
+    end;
+
+    test "page_size" begin fun () ->
+      let sizes = [4096; 16384; 65536] in
+      Lwt.return (List.mem Lwt_bytes.page_size sizes)
+    end;
+
+    test "mincore buffer length = page_size * 2, n_states = 1"
+      ~only_if:(fun () -> not Sys.win32) begin fun () ->
+      test_mincore (Lwt_bytes.page_size * 2) Lwt_bytes.page_size 1
+      >>= fun () -> Lwt.return_true
+    end;
+
+    test "mincore buffer length = page_size * 2, n_states = 2"
+      ~only_if:(fun () -> not Sys.win32) begin fun () ->
+      Lwt.catch
+        (fun () ->
+           test_mincore (Lwt_bytes.page_size * 2) Lwt_bytes.page_size 2
+           >>= fun () -> Lwt.return_false
+        )
+        (function
+          | Invalid_argument _message -> Lwt.return_true
+          | exn -> Lwt.reraise exn
+        )
+    end;
+
+    test "mincore buffer length = page_size * 2 + 1, n_states = 2"
+      ~only_if:(fun () -> not Sys.win32) begin fun () ->
+      test_mincore (Lwt_bytes.page_size * 2 + 1) Lwt_bytes.page_size 2
+      >>= fun () ->
+      Lwt.return_true
+    end;
+
+    test "mincore buffer length = page_size , n_states = 0"
+      ~only_if:(fun () -> not Sys.win32) begin fun () ->
+      test_mincore (Lwt_bytes.page_size * 2 + 1) Lwt_bytes.page_size 0
+      >>= fun () -> Lwt.return_true
+    end;
+
+    test "wait_mincore correct bounds"
+      ~only_if:(fun () -> not Sys.win32) begin fun () ->
+      test_wait_mincore (Lwt_bytes.page_size * 2 + 1) Lwt_bytes.page_size
+      >>= fun () -> Lwt.return_true
+    end;
+
+    test "wait_mincore offset < 0"
+      ~only_if:(fun () -> not Sys.win32) begin fun () ->
+      Lwt.catch
+        (fun () ->
+           test_wait_mincore (Lwt_bytes.page_size * 2 + 1) (-1)
+           >>= fun () -> Lwt.return_false
+        )
+        (function
+          | Invalid_argument _message -> Lwt.return_true
+          | exn -> Lwt.reraise exn
+        )
+    end;
+
+    test "wait_mincore offset > buffer length"
+      ~only_if:(fun () -> not Sys.win32) begin fun () ->
+      Lwt.catch
+        (fun () ->
+           let buff_len = Lwt_bytes.page_size * 2 + 1 in
+           test_wait_mincore buff_len (buff_len + 1)
+           >>= fun () -> Lwt.return_false
+        )
+        (function
+          | Invalid_argument _message -> Lwt.return_true
+          | exn -> Lwt.reraise exn
+        )
+    end;
+  ]

unikernel/duniverse/lwt/test/unix/test_lwt_engine.ml

@@ -0,0 +1,59 @@
+(* This file is part of Lwt, released under the MIT license. See LICENSE.md for
+   details, or visit https://github.com/ocsigen/lwt/blob/master/LICENSE.md. *)
+
+
+
+open Test
+open Lwt.Infix
+
+let timing_tests = [
+  test "libev: timer delays are not too short" begin fun () ->
+    let start = Unix.gettimeofday () in
+
+    Lwt.catch
+      (fun () ->
+        (* Block the entire process for one second. If using libev, libev's
+           notion of the current time is not updated during this period. *)
+        let () = Unix.sleep 1 in
+
+        (* At this point, libev thinks that the time is what it was about one
+           second ago. Now schedule exception Lwt_unix.Timeout to be raised in
+           0.5 seconds. If the implementation is incorrect, the exception will
+           be raised immediately, because the 0.5 seconds will be measured
+           relative to libev's "current" time of one second ago. *)
+        Lwt_unix.timeout 0.5)
+
+      (function
+      | Lwt_unix.Timeout ->
+        Lwt.return (Unix.gettimeofday ())
+      | exn ->
+        Lwt.reraise exn)
+
+    >>= fun stop ->
+
+    Lwt.return (stop -. start >= 1.5)
+  end;
+]
+
+let tests = timing_tests
+
+let run_tests = [
+  test "Lwt_main.run: nested call" ~sequential:true begin fun () ->
+    (* The test itself is already running under Lwt_main.run, so we just have to
+       call it once and make sure we get an exception. *)
+
+    (* Make sure we are running in a callback called by Lwt_main.run, not
+       synchronously when the testing executable is loaded. *)
+    Lwt.pause () >>= fun () ->
+
+    try
+      Lwt_main.run (Lwt.return_unit);
+      Lwt.return_false
+    with Failure _ ->
+      Lwt.return_true
+  end;
+]
+
+let tests = tests @ run_tests
+
+let suite = suite "lwt_engine" tests

unikernel/duniverse/lwt/test/unix/test_lwt_fmt.ml

@@ -0,0 +1,62 @@
+(* This file is part of Lwt, released under the MIT license. See LICENSE.md for
+   details, or visit https://github.com/ocsigen/lwt/blob/master/LICENSE.md. *)
+
+
+
+open Test
+open Lwt.Infix
+
+let testchan () =
+  let b = Buffer.create 6 in
+  let f buf ofs len =
+    let bytes = Bytes.create len in
+    Lwt_bytes.blit_to_bytes buf ofs bytes 0 len;
+    Buffer.add_bytes b bytes;
+    Lwt.return len
+  in
+  let oc = Lwt_io.make ~mode:Output f in
+  let fmt = Lwt_fmt.of_channel oc in
+  fmt, (fun () -> Buffer.contents b)
+
+let suite = suite "lwt_fmt" [
+    test "flushing" (fun () ->
+        let fmt, f = testchan () in
+        Lwt_fmt.fprintf fmt "%s%i%s%!" "bla" 3 "blo" >>= fun () ->
+        Lwt.return (f () = {|bla3blo|})
+      );
+    test "with combinator" (fun () ->
+        let fmt, f = testchan () in
+        Lwt_fmt.fprintf fmt "%a%!" Format.pp_print_int 3 >>= fun () ->
+        Lwt.return (f () = {|3|})
+      );
+    test "box" (fun () ->
+        let fmt, f = testchan () in
+        Lwt_fmt.fprintf fmt "@[<v2>%i@,%i@]%!" 1 2 >>= fun () ->
+        Lwt.return (f () = "1\n  2")
+      );
+    test "boxsplit" (fun () ->
+        let fmt, f = testchan () in
+        Lwt_fmt.fprintf fmt "@[<v2>%i" 1 >>= fun () ->
+        Lwt_fmt.fprintf fmt "@,%i@]" 2 >>= fun () ->
+        Lwt_fmt.flush fmt >>= fun () ->
+        Lwt.return (f () = "1\n  2")
+      );
+    test "box close with flush" (fun () ->
+        let fmt, f = testchan () in
+        Lwt_fmt.fprintf fmt "@[<v2>%i" 1 >>= fun () ->
+        Lwt_fmt.fprintf fmt "@,%i" 2 >>= fun () ->
+        Lwt_fmt.flush fmt >>= fun () ->
+        Lwt.return (f () = "1\n  2")
+      );
+
+    test "stream"  (fun () ->
+        let stream, fmt = Lwt_fmt.make_stream () in
+        Lwt_fmt.fprintf fmt "@[<v2>%i@,%i@]%!" 1 2 >>= fun () ->
+        Lwt.return (Lwt_stream.get_available stream = [
+            String ("1", 0, 1);
+            String ("\n", 0, 1);
+            String  ("                                                                                ", 0, 2);
+            String ("2", 0, 1);
+            Flush])
+      );
+  ]

unikernel/duniverse/lwt/test/unix/test_lwt_io.ml

@@ -0,0 +1,675 @@
+(* This file is part of Lwt, released under the MIT license. See LICENSE.md for
+   details, or visit https://github.com/ocsigen/lwt/blob/master/LICENSE.md. *)
+
+
+
+(* [Lwt_sequence] is deprecated – we don't want users outside Lwt using it.
+   However, it is still used internally by Lwt. So, briefly disable warning 3
+   ("deprecated"), and create a local, non-deprecated alias for
+   [Lwt_sequence] that can be referred to by the rest of the code in this
+   module without triggering any more warnings. *)
+module Lwt_sequence = Lwt_sequence
+
+open Test
+open Lwt.Infix
+
+exception Dummy_error
+
+let local =
+  let last_port = ref 4321 in
+  fun () ->
+    incr last_port;
+    Unix.ADDR_INET (Unix.inet_addr_loopback, !last_port)
+
+(* Helpers for [establish_server] tests. *)
+module Establish_server =
+struct
+  let with_client f =
+    let local = local () in
+
+    let handler_finished, notify_handler_finished = Lwt.wait () in
+
+    Lwt_io.establish_server_with_client_address
+      local
+      (fun _client_address channels ->
+        Lwt.finalize
+          (fun () -> f channels)
+          (fun () ->
+            Lwt.wakeup notify_handler_finished ();
+            Lwt.return_unit))
+
+    >>= fun server ->
+
+    let client_finished =
+      Lwt_io.with_connection
+        local
+        (fun (_, out_channel) ->
+          Lwt_io.write out_channel "hello world" >>= fun () ->
+          handler_finished)
+    in
+
+    client_finished >>= fun () ->
+    Lwt_io.shutdown_server server
+
+  (* Hacky is_closed functions that attempt to read from/write to the channels
+     to see if they are closed. *)
+  let is_closed_in channel =
+    Lwt.catch
+      (fun () -> Lwt_io.read_char channel >|= fun _ -> false)
+      (function
+      | Lwt_io.Channel_closed _ -> Lwt.return_true
+      | _ -> Lwt.return_false)
+
+  let is_closed_out channel =
+    Lwt.catch
+      (fun () -> Lwt_io.write_char channel 'a' >|= fun () -> false)
+      (function
+      | Lwt_io.Channel_closed _ -> Lwt.return_true
+      | _ -> Lwt.return_false)
+end
+
+let suite = suite "lwt_io" [
+  test "auto-flush" ~sequential:true
+    (fun () ->
+      let sent = ref [] in
+      let oc =
+        Lwt_io.make
+          ~mode:Lwt_io.output
+          (fun buf ofs len ->
+            let bytes = Bytes.create len in
+            Lwt_bytes.blit_to_bytes buf ofs bytes 0 len;
+            sent := bytes :: !sent;
+            Lwt.return len)
+      in
+      Lwt_io.write oc "foo" >>= fun () ->
+      Lwt_io.write oc "bar" >>= fun () ->
+      if !sent <> [] then begin
+        prerr_endline "auto-flush: !sent not empty";
+        Lwt.return_false
+      end
+      else
+        Lwt_unix.sleep 0.1 >>= fun () ->
+        let test_result = !sent = [Bytes.of_string "foobar"] in
+        if not test_result then
+          !sent
+          |> List.map Bytes.to_string
+          |> List.map (Printf.sprintf "'%s'")
+          |> String.concat ","
+          |> Printf.eprintf "auto-flush: !sent = %s";
+        Lwt.return test_result);
+
+  test "auto-flush in atomic" ~sequential:true
+    (fun () ->
+      let sent = ref [] in
+      let oc =
+        Lwt_io.make
+          ~mode:Lwt_io.output
+          (fun buf ofs len ->
+            let bytes = Bytes.create len in
+            Lwt_bytes.blit_to_bytes buf ofs bytes 0 len;
+            sent := bytes :: !sent;
+            Lwt.return len)
+      in
+      Lwt_io.atomic
+        (fun oc ->
+          Lwt_io.write oc "foo" >>= fun () ->
+          Lwt_io.write oc "bar" >>= fun () ->
+          if !sent <> [] then begin
+            prerr_endline "auto-flush atomic: !sent not empty";
+            Lwt.return_false
+          end
+          else
+            Lwt_unix.sleep 0.1 >>= fun () ->
+            let test_result = !sent = [Bytes.of_string "foobar"] in
+            if not test_result then
+              !sent
+              |> List.map Bytes.to_string
+              |> List.map (Printf.sprintf "'%s'")
+              |> String.concat ","
+              |> Printf.eprintf "auto-flush atomic: !sent = %s";
+            Lwt.return test_result)
+        oc);
+
+  (* Without the corresponding bugfix, which is to handle ENOTCONN from
+     Lwt_unix.shutdown, this test raises an exception from the handler's calls
+     to close. *)
+  test "establish_server_1: shutdown: client closes first"
+    ~only_if:(fun () ->
+      not (Lwt_config._HAVE_LIBEV && Lwt_config.libev_default))
+  (* Note: this test is currently flaky on Linux with libev enabled, so we skip
+     it in that case. *)
+    (fun () ->
+      let wait_for_client, client_finished = Lwt.wait () in
+
+      let handler_wait, run_handler = Lwt.wait () in
+      let handler =
+        handler_wait >>= fun (in_channel, out_channel) ->
+        wait_for_client >>= fun () ->
+        Lwt_io.close in_channel >>= fun () ->
+        Lwt_io.close out_channel >>= fun () ->
+        Lwt.return_true
+      in
+
+      let local = local () in
+
+      let server =
+        (Lwt_io.Versioned.establish_server_1 [@ocaml.warning "-3"])
+          local (fun channels -> Lwt.wakeup run_handler channels)
+      in
+
+      Lwt_io.with_connection local (fun _ -> Lwt.return_unit) >>= fun () ->
+      Lwt.wakeup client_finished ();
+      Lwt_io.shutdown_server server >>= fun () ->
+      handler);
+
+  (* Counterpart to establish_server: shutdown test. Confirms that shutdown is
+     implemented correctly in open_connection. *)
+  test "open_connection: shutdown: server closes first"
+    (fun () ->
+      let wait_for_server, server_finished = Lwt.wait () in
+
+      let local = local () in
+
+      let server =
+        (Lwt_io.Versioned.establish_server_1 [@ocaml.warning "-3"])
+          local (fun (in_channel, out_channel) ->
+            Lwt.async (fun () ->
+              Lwt_io.close in_channel >>= fun () ->
+              Lwt_io.close out_channel >|= fun () ->
+              Lwt.wakeup server_finished ()))
+      in
+
+      Lwt_io.with_connection local (fun _ ->
+        wait_for_server >>= fun () ->
+        Lwt.return_true)
+
+      >>= fun result ->
+
+      Lwt_io.shutdown_server server >|= fun () ->
+      result);
+
+  test "establish_server: implicit close"
+    (fun () ->
+      let open Establish_server in
+
+      let in_channel' = ref Lwt_io.stdin in
+      let out_channel' = ref Lwt_io.stdout in
+
+      let in_open_in_handler = ref false in
+      let out_open_in_handler = ref false in
+
+      let run =
+        Establish_server.with_client
+          (fun (in_channel, out_channel) ->
+            in_channel' := in_channel;
+            out_channel' := out_channel;
+
+            is_closed_out out_channel >>= fun yes ->
+            out_open_in_handler := not yes;
+
+            is_closed_in in_channel >|= fun yes ->
+            in_open_in_handler := not yes)
+      in
+
+      run >>= fun () ->
+      (* Give a little time for the close system calls on the connection sockets
+         to complete. The Lwt_io and Lwt_unix APIs do not currently allow
+         binding on the implicit closes of these sockets, so resorting to a
+         delay. *)
+      Lwt_unix.sleep 0.05 >>= fun () ->
+
+      is_closed_in !in_channel' >>= fun in_closed_after_handler ->
+      is_closed_out !out_channel' >|= fun out_closed_after_handler ->
+
+      !out_open_in_handler &&
+      !in_open_in_handler &&
+      in_closed_after_handler &&
+      out_closed_after_handler);
+
+  test ~sequential:true "establish_server: implicit close on exception"
+    (fun () ->
+      let open Establish_server in
+
+      let in_channel' = ref Lwt_io.stdin in
+      let out_channel' = ref Lwt_io.stdout in
+      let exit_raised = ref false in
+
+      let run () =
+        Establish_server.with_client
+          (fun (in_channel, out_channel) ->
+            in_channel' := in_channel;
+            out_channel' := out_channel;
+            raise Exit)
+      in
+
+      with_async_exception_hook
+        (function
+        | Exit -> exit_raised := true;
+        | _ -> ())
+        run
+
+      >>= fun () ->
+      (* See comment in other implicit close test. *)
+      Lwt_unix.sleep 0.05 >>= fun () ->
+
+      is_closed_in !in_channel' >>= fun in_closed_after_handler ->
+      is_closed_out !out_channel' >|= fun out_closed_after_handler ->
+
+      in_closed_after_handler && out_closed_after_handler);
+
+  (* This does a simple double close of the channels (second close is implicit).
+     If something breaks, the test will finish with an exception, or
+     Lwt.async_exception_hook will kill the process. *)
+  test "establish_server: explicit close"
+    (fun () ->
+      let open Establish_server in
+
+      let closed_explicitly = ref false in
+
+      let run =
+        Establish_server.with_client
+          (fun (in_channel, out_channel) ->
+            Lwt_io.close in_channel >>= fun () ->
+            Lwt_io.close out_channel >>= fun () ->
+            is_closed_in in_channel >>= fun in_closed_in_handler ->
+            is_closed_out out_channel >|= fun out_closed_in_handler ->
+            closed_explicitly := in_closed_in_handler && out_closed_in_handler)
+      in
+
+      run >|= fun () ->
+      !closed_explicitly);
+
+  test "with_connection"
+    (fun () ->
+      let open Establish_server in
+
+      let in_channel' = ref Lwt_io.stdin in
+      let out_channel' = ref Lwt_io.stdout in
+
+      let local = local () in
+
+      Lwt_io.establish_server_with_client_address local
+        (fun _client_address _channels -> Lwt.return_unit)
+      >>= fun server ->
+
+      Lwt_io.with_connection local (fun (in_channel, out_channel) ->
+        in_channel' := in_channel;
+        out_channel' := out_channel;
+        Lwt.return_unit)
+
+      >>= fun () ->
+      Lwt_io.shutdown_server server >>= fun () ->
+      is_closed_in !in_channel' >>= fun in_closed ->
+      is_closed_out !out_channel' >|= fun out_closed ->
+      in_closed && out_closed);
+
+  (* Makes the channel fail with EBADF on close. Tries to close the channel
+     manually, and handles the exception. When with_close_connection tries to
+     close the socket again implicitly, that should not raise the exception
+     again. *)
+  test "with_close_connection: no duplicate exceptions"
+    (fun () ->
+      let exceptions_observed = ref 0 in
+
+      let expecting_ebadf f =
+        Lwt.catch f
+          (function
+            | Unix.Unix_error (Unix.EBADF, _, _) ->
+              exceptions_observed := !exceptions_observed + 1;
+              Lwt.return_unit
+            | exn ->
+              Lwt.reraise exn)
+      in
+
+      let fd_r, fd_w = Lwt_unix.pipe () in
+      let in_channel = Lwt_io.of_fd ~mode:Lwt_io.input fd_r in
+      let out_channel = Lwt_io.of_fd ~mode:Lwt_io.output fd_w in
+
+      Lwt_unix.close fd_r >>= fun () ->
+      Lwt_unix.close fd_w >>= fun () ->
+
+      expecting_ebadf (fun () ->
+        Lwt_io.with_close_connection
+          (fun _ ->
+            expecting_ebadf (fun () -> Lwt_io.close in_channel) >>= fun () ->
+            expecting_ebadf (fun () -> Lwt_io.close out_channel))
+          (in_channel, out_channel))
+      >|= fun () ->
+      !exceptions_observed = 2);
+
+  test "open_temp_file"
+    (fun () ->
+       Lwt_io.open_temp_file () >>= fun (fname, out_chan) ->
+       Lwt_io.write out_chan "test file content" >>= fun () ->
+       Lwt_io.close out_chan >>= fun _ ->
+       Unix.unlink fname; Lwt.return_true
+    );
+
+  test "with_temp_filename"
+    (fun () ->
+       let prefix = "test_tempfile" in
+      let filename = ref "." in
+      let wrap f (filename', chan) = filename := filename'; f chan in
+      let write_data chan = Lwt_io.write chan "test file content" in
+      let write_data_fail _ = Lwt.fail Dummy_error in
+      Lwt_io.with_temp_file (wrap write_data) ~prefix >>= fun _ ->
+      let no_temps1 = not (Sys.file_exists !filename) in
+       Lwt.catch
+         (fun () -> Lwt_io.with_temp_file (wrap write_data_fail))
+         (fun exn ->
+            if exn = Dummy_error
+            then Lwt.return (not (Sys.file_exists !filename))
+            else Lwt.return_false
+         )
+       >>= fun no_temps2 ->
+       Lwt.return (no_temps1 && no_temps2)
+    );
+
+  (* Verify that no exceptions are thrown if the function passed to
+     with_temp_file closes the channel on its own. *)
+  test "with_temp_filename close handle"
+    (fun () ->
+       let f (_, chan) = Lwt_io.write chan "test file content" >>= fun _ ->
+         Lwt_io.close chan in
+       Lwt_io.with_temp_file f >>= fun _ -> Lwt.return_true;
+    );
+
+  test "create_temp_dir" begin fun () ->
+    let prefix = "temp_dir" in
+    let suffix = "_foo" in
+    Lwt_io.create_temp_dir ~parent:Filename.current_dir_name ~prefix ~suffix ()
+      >>= fun path ->
+
+    let name = Filename.basename path in
+    let prefix_matches = String.sub name 0 (String.length prefix) = prefix in
+    let actual_suffix =
+      String.sub
+        name (String.length name - String.length suffix) (String.length suffix)
+    in
+    let suffix_matches = actual_suffix = suffix in
+    let directory_exists = Sys.is_directory path in
+
+    Lwt_unix.rmdir path >>= fun () ->
+
+    Lwt.return (prefix_matches && suffix_matches && directory_exists)
+  end;
+
+  test "with_temp_dir" ~sequential:true begin fun () ->
+    Lwt_io.with_temp_dir ~parent:Filename.current_dir_name ~prefix:"temp_dir"
+        begin fun path ->
+
+      let directory_existed = Sys.is_directory path in
+
+      open_out (Filename.concat path "foo") |> close_out;
+      open_out (Filename.concat path "bar") |> close_out;
+      let had_files = Array.length (Sys.readdir path) = 2 in
+
+      Lwt.return (path, directory_existed, had_files)
+    end >>= fun (path, directory_existed, had_files) ->
+
+    let directory_removed = not (Sys.file_exists path) in
+
+    Lwt.return (directory_existed && had_files && directory_removed)
+  end;
+
+  test "file_length on directory" begin fun () ->
+    Lwt.catch
+      (fun () ->
+        Lwt_io.file_length "." >>= fun _ ->
+        Lwt.return_false)
+      (function
+      | Unix.Unix_error (Unix.EISDIR, "file_length", ".") ->
+        Lwt.return_true
+      | exn -> Lwt.reraise exn)
+  end;
+
+  test "input channel of_bytes initial position"
+    (fun () ->
+       let ichan = Lwt_io.of_bytes ~mode:Lwt_io.input @@ Lwt_bytes.of_string "abcd" in
+       Lwt.return (Lwt_io.position ichan = 0L)
+    );
+
+  test "input channel of_bytes position after read"
+    (fun () ->
+       let ichan = Lwt_io.of_bytes ~mode:Lwt_io.input @@ Lwt_bytes.of_string "abcd" in
+       Lwt_io.read_char ichan >|= fun _ ->
+       Lwt_io.position ichan = 1L
+    );
+
+  test "input channel of_bytes position after set_position"
+    (fun () ->
+       let ichan = Lwt_io.of_bytes ~mode:Lwt_io.input @@ Lwt_bytes.of_string "abcd" in
+       Lwt_io.set_position ichan 2L >|= fun () ->
+       Lwt_io.position ichan = 2L
+    );
+
+  test "output channel of_bytes initial position"
+    (fun () ->
+       let ochan = Lwt_io.of_bytes ~mode:Lwt_io.output @@ Lwt_bytes.create 4 in
+       Lwt.return (Lwt_io.position ochan = 0L)
+    );
+
+  test "output channel of_bytes position after read"
+    (fun () ->
+       let ochan = Lwt_io.of_bytes ~mode:Lwt_io.output @@ Lwt_bytes.create 4 in
+       Lwt_io.write_char ochan 'a' >|= fun _ ->
+       Lwt_io.position ochan = 1L
+    );
+
+  test "output channel of_bytes position after set_position"
+    (fun () ->
+       let ochan = Lwt_io.of_bytes ~mode:Lwt_io.output @@ Lwt_bytes.create 4 in
+       Lwt_io.set_position ochan 2L >|= fun _ ->
+       Lwt_io.position ochan = 2L
+    );
+
+  test "NumberIO.LE.read_int" begin fun () ->
+    Lwt_bytes.of_string "\x01\x02\x03\x04"
+    |> Lwt_io.(of_bytes ~mode:input)
+    |> Lwt_io.LE.read_int
+    >|= (=) 0x04030201
+  end;
+
+  test "NumberIO.BE.read_int" begin fun () ->
+    Lwt_bytes.of_string "\x01\x02\x03\x04"
+    |> Lwt_io.(of_bytes ~mode:input)
+    |> Lwt_io.BE.read_int
+    >|= (=) 0x01020304
+  end;
+
+  test "NumberIO.LE.read_int16" begin fun () ->
+    Lwt_bytes.of_string "\x01\x02"
+    |> Lwt_io.(of_bytes ~mode:input)
+    |> Lwt_io.LE.read_int16
+    >|= (=) 0x0201
+  end;
+
+  test "NumberIO.BE.read_int16" begin fun () ->
+    Lwt_bytes.of_string "\x01\x02"
+    |> Lwt_io.(of_bytes ~mode:input)
+    |> Lwt_io.BE.read_int16
+    >|= (=) 0x0102
+  end;
+
+  test "NumberIO.LE.read_int16, negative" begin fun () ->
+    Lwt_bytes.of_string "\xfe\xff"
+    |> Lwt_io.(of_bytes ~mode:input)
+    |> Lwt_io.LE.read_int16
+    >|= (=) (-2)
+  end;
+
+  test "NumberIO.BE.read_int16, negative" begin fun () ->
+    Lwt_bytes.of_string "\xff\xfe"
+    |> Lwt_io.(of_bytes ~mode:input)
+    |> Lwt_io.BE.read_int16
+    >|= (=) (-2)
+  end;
+
+  test "NumberIO.LE.read_int32" begin fun () ->
+    Lwt_bytes.of_string "\x01\x02\x03\x04"
+    |> Lwt_io.(of_bytes ~mode:input)
+    |> Lwt_io.LE.read_int32
+    >|= (=) 0x04030201l
+  end;
+
+  test "NumberIO.BE.read_int32" begin fun () ->
+    Lwt_bytes.of_string "\x01\x02\x03\x04"
+    |> Lwt_io.(of_bytes ~mode:input)
+    |> Lwt_io.BE.read_int32
+    >|= (=) 0x01020304l
+  end;
+
+  test "NumberIO.LE.read_int64" begin fun () ->
+    Lwt_bytes.of_string "\x01\x02\x03\x04\x05\x06\x07\x08"
+    |> Lwt_io.(of_bytes ~mode:input)
+    |> Lwt_io.LE.read_int64
+    >|= (=) 0x0807060504030201L
+  end;
+
+  test "NumberIO.BE.read_int64" begin fun () ->
+    Lwt_bytes.of_string "\x01\x02\x03\x04\x05\x06\x07\x08"
+    |> Lwt_io.(of_bytes ~mode:input)
+    |> Lwt_io.BE.read_int64
+    >|= (=) 0x0102030405060708L
+  end;
+
+  test "NumberIO.LE.read_float32" begin fun () ->
+    Lwt_bytes.of_string "\x80\x01\x81\x47"
+    |> Lwt_io.(of_bytes ~mode:input)
+    |> Lwt_io.LE.read_float32
+    >|= fun n -> instrument (n = 66051.) "NumberIO.LE.read_float32: %f" n
+  end;
+
+  test "NumberIO.BE.read_float32" begin fun () ->
+    Lwt_bytes.of_string "\x47\x81\x01\x80"
+    |> Lwt_io.(of_bytes ~mode:input)
+    |> Lwt_io.BE.read_float32
+    >|= fun n -> instrument (n = 66051.) "NumberIO.BE.read_float32: %f" n
+  end;
+
+  test "NumberIO.LE.read_float64" begin fun () ->
+    Lwt_bytes.of_string "\x70\x60\x50\x40\x30\x20\xf0\x42"
+    |> Lwt_io.(of_bytes ~mode:input)
+    |> Lwt_io.LE.read_float64
+    >|= Int64.bits_of_float
+    >|= (=) 0x42F0203040506070L
+  end;
+
+  test "NumberIO.BE.read_float64" begin fun () ->
+    Lwt_bytes.of_string "\x42\xf0\x20\x30\x40\x50\x60\x70"
+    |> Lwt_io.(of_bytes ~mode:input)
+    |> Lwt_io.BE.read_float64
+    >|= Int64.bits_of_float
+    >|= (=) 0x42F0203040506070L
+  end;
+
+  test "NumberIO.LE.write_int" begin fun () ->
+    let buffer = Lwt_bytes.create 4 in
+    Lwt_io.LE.write_int (Lwt_io.(of_bytes ~mode:output) buffer)
+      0x01020304 >>= fun () ->
+    Lwt.return (Lwt_bytes.to_string buffer = "\x04\x03\x02\x01")
+  end;
+
+  test "NumberIO.BE.write_int" begin fun () ->
+    let buffer = Lwt_bytes.create 4 in
+    Lwt_io.BE.write_int (Lwt_io.(of_bytes ~mode:output) buffer)
+      0x01020304 >>= fun () ->
+    Lwt.return (Lwt_bytes.to_string buffer = "\x01\x02\x03\x04")
+  end;
+
+  test "NumberIO.LE.write_int16" begin fun () ->
+    let buffer = Lwt_bytes.create 2 in
+    Lwt_io.LE.write_int16 (Lwt_io.(of_bytes ~mode:output) buffer)
+      0x0102 >>= fun () ->
+    Lwt.return (Lwt_bytes.to_string buffer = "\x02\x01")
+  end;
+
+  test "NumberIO.BE.write_int16" begin fun () ->
+    let buffer = Lwt_bytes.create 2 in
+    Lwt_io.BE.write_int16 (Lwt_io.(of_bytes ~mode:output) buffer)
+      0x0102 >>= fun () ->
+    Lwt.return (Lwt_bytes.to_string buffer = "\x01\x02")
+  end;
+
+  test "NumberIO.LE.write_int32" begin fun () ->
+    let buffer = Lwt_bytes.create 4 in
+    Lwt_io.LE.write_int32 (Lwt_io.(of_bytes ~mode:output) buffer)
+      0x01020304l >>= fun () ->
+    Lwt.return (Lwt_bytes.to_string buffer = "\x04\x03\x02\x01")
+  end;
+
+  test "NumberIO.BE.write_int32" begin fun () ->
+    let buffer = Lwt_bytes.create 4 in
+    Lwt_io.BE.write_int32 (Lwt_io.(of_bytes ~mode:output) buffer)
+      0x01020304l >>= fun () ->
+    Lwt.return (Lwt_bytes.to_string buffer = "\x01\x02\x03\x04")
+  end;
+
+  test "NumberIO.LE.write_int64" begin fun () ->
+    let buffer = Lwt_bytes.create 8 in
+    Lwt_io.LE.write_int64 (Lwt_io.(of_bytes ~mode:output) buffer)
+      0x0102030405060708L >>= fun () ->
+    Lwt.return (Lwt_bytes.to_string buffer = "\x08\x07\x06\x05\x04\x03\x02\x01")
+  end;
+
+  test "NumberIO.BE.write_int64" begin fun () ->
+    let buffer = Lwt_bytes.create 8 in
+    Lwt_io.BE.write_int64 (Lwt_io.(of_bytes ~mode:output) buffer)
+      0x0102030405060708L >>= fun () ->
+    Lwt.return (Lwt_bytes.to_string buffer = "\x01\x02\x03\x04\x05\x06\x07\x08")
+  end;
+
+  test "NumberIO.LE.write_float32" begin fun () ->
+    let buffer = Lwt_bytes.create 4 in
+    Lwt_io.LE.write_float32 (Lwt_io.(of_bytes ~mode:output) buffer)
+      66051. >|= fun () ->
+    instrument (Lwt_bytes.to_string buffer = "\x80\x01\x81\x47")
+      "NumberIO.LE.write_float32: %02X %02X %02X %02X"
+      (Char.code (Lwt_bytes.get buffer 0))
+      (Char.code (Lwt_bytes.get buffer 1))
+      (Char.code (Lwt_bytes.get buffer 2))
+      (Char.code (Lwt_bytes.get buffer 3))
+  end;
+
+  test "NumberIO.BE.write_float32" begin fun () ->
+    let buffer = Lwt_bytes.create 4 in
+    Lwt_io.BE.write_float32 (Lwt_io.(of_bytes ~mode:output) buffer)
+      66051. >|= fun () ->
+    instrument (Lwt_bytes.to_string buffer = "\x47\x81\x01\x80")
+      "NumberIO.BE.write_float32: %02X %02X %02X %02X"
+      (Char.code (Lwt_bytes.get buffer 0))
+      (Char.code (Lwt_bytes.get buffer 1))
+      (Char.code (Lwt_bytes.get buffer 2))
+      (Char.code (Lwt_bytes.get buffer 3))
+  end;
+
+  test "NumberIO.LE.write_float64" begin fun () ->
+    let buffer = Lwt_bytes.create 8 in
+    Lwt_io.LE.write_float64 (Lwt_io.(of_bytes ~mode:output) buffer)
+      (Int64.float_of_bits 0x42F0203040506070L) >>= fun () ->
+    Lwt.return (Lwt_bytes.to_string buffer = "\x70\x60\x50\x40\x30\x20\xf0\x42")
+  end;
+
+  test "NumberIO.BE.write_float64" begin fun () ->
+    let buffer = Lwt_bytes.create 8 in
+    Lwt_io.BE.write_float64 (Lwt_io.(of_bytes ~mode:output) buffer)
+      (Int64.float_of_bits 0x42F0203040506070L) >>= fun () ->
+    Lwt.return (Lwt_bytes.to_string buffer = "\x42\xf0\x20\x30\x40\x50\x60\x70")
+  end;
+
+  test "Write from Lwt_bytes" begin fun () ->
+    let bytes = Lwt_bytes.of_string "Hello World" in
+    let out = Lwt_bytes.create 11 in
+    Lwt_io.write_from_exactly_bigstring (Lwt_io.(of_bytes ~mode:output) out)
+      bytes 0 11 >>= fun () ->
+    Lwt.return (Lwt_bytes.to_string out = "Hello World")
+  end;
+
+  test "Read from Lwt_bytes" begin fun () ->
+    let bytes_in = Lwt_bytes.create 11 in
+    let bytes = Lwt_bytes.of_string "Hello World" in
+    Lwt_io.read_into_exactly_bigstring (Lwt_io.(of_bytes ~mode:input) bytes)
+      bytes_in 0 11 >>= fun () ->
+    Lwt.return (Lwt_bytes.to_string bytes_in = "Hello World")
+  end;
+]

unikernel/duniverse/lwt/test/unix/test_lwt_io_non_block.ml

@@ -0,0 +1,51 @@
+(* This file is part of Lwt, released under the MIT license. See LICENSE.md for
+   details, or visit https://github.com/ocsigen/lwt/blob/master/LICENSE.md. *)
+
+
+
+open Test
+open Lwt.Infix
+
+let test_file = "Lwt_io_test"
+let file_contents = "test file content"
+
+let suite = suite "lwt_io non blocking io" [
+  test ~sequential:true "file does not exist"
+    (fun () -> Lwt_unix.file_exists test_file >|= fun r -> not r);
+
+  test ~sequential:true "file does not exist (invalid path)"
+    (fun () -> Lwt_unix.file_exists (test_file ^ "/foo") >|= fun r -> not r);
+
+  test ~sequential:true "file does not exist (LargeFile)"
+    (fun () -> Lwt_unix.LargeFile.file_exists test_file >|= fun r -> not r);
+
+  test ~sequential:true "file does not exist (LargeFile, invalid path)"
+    (fun () -> Lwt_unix.LargeFile.file_exists (test_file ^ "/foo") >|= fun r -> not r);
+
+  test ~sequential:true "create file"
+    (fun () ->
+      Lwt_io.open_file ~mode:Lwt_io.output test_file >>= fun out_chan ->
+      Lwt_io.write out_chan file_contents >>= fun () ->
+      Lwt_io.close out_chan >>= fun () ->
+      Lwt.return_true);
+
+  test ~sequential:true "file exists"
+    (fun () -> Lwt_unix.file_exists test_file);
+
+  test ~sequential:true "file exists (LargeFile)"
+    (fun () -> Lwt_unix.LargeFile.file_exists test_file);
+
+
+  test ~sequential:true "read file"
+    (fun () ->
+      Lwt_io.open_file ~mode:Lwt_io.input test_file >>= fun in_chan ->
+      Lwt_io.read in_chan >>= fun s ->
+      Lwt_io.close in_chan >>= fun () ->
+      Lwt.return (s = file_contents));
+
+  test ~sequential:true "remove file"
+    (fun () ->
+      Unix.unlink test_file;
+      Lwt.return_true);
+
+]

unikernel/duniverse/lwt/test/unix/test_lwt_process.ml

@@ -0,0 +1,107 @@
+(* This file is part of Lwt, released under the MIT license. See LICENSE.md for
+   details, or visit https://github.com/ocsigen/lwt/blob/master/LICENSE.md. *)
+
+
+
+open Test
+open Lwt.Infix
+
+let expected_str = "the quick brown fox jumps over the lazy dog"
+let expected = Bytes.of_string expected_str
+let expected_len = Bytes.length expected
+
+let check_status ?(status=(=) 0) = function
+  | Unix.WEXITED n when status n -> Lwt.return_true
+  | Unix.WEXITED n ->
+    Printf.eprintf "exited with code %d" n;
+    Lwt.return_false
+  | Unix.WSIGNALED x ->
+    Printf.eprintf "failed with signal %d" x;
+    Lwt.return_false
+  | Unix.WSTOPPED x ->
+    Printf.eprintf "stopped with signal %d" x;
+    Lwt.return_false
+
+let pwrite ~stdin pout =
+  let args = [|"dummy.exe"; "read"|] in
+  let proc = Lwt_process.exec ~stdin ("./dummy.exe", args) in
+  let write = Lwt.finalize
+                (fun () -> Lwt_unix.write pout expected 0 expected_len)
+                (fun () -> Lwt_unix.close pout) in
+  proc >>= fun r ->
+  write >>= fun n ->
+  assert (n = expected_len);
+  check_status r
+
+let pread ?stdout ?stderr pin =
+  let buf = Bytes.create expected_len in
+  let proc = match stdout, stderr with
+    | Some stdout, None ->
+       let args = [|"dummy.exe"; "write"|] in
+       Lwt_process.exec ~stdout ("./dummy.exe", args)
+    | None, Some stderr ->
+       let args = [|"dummy.exe"; "errwrite"|] in
+       Lwt_process.exec ~stderr ("./dummy.exe", args)
+    | _ -> assert false
+  in
+  let read = Lwt_unix.read pin buf 0 expected_len in
+  proc >>= fun r ->
+  read >>= fun n ->
+  assert (n = expected_len);
+  assert (Bytes.equal buf expected);
+  Lwt_unix.read pin buf 0 1 >>= fun n ->
+  assert (n = 0);
+  check_status r
+
+let suite = suite "lwt_process" [
+  (* The sleep command is not available on Win32. *)
+  test "lazy_undefined" ~only_if:(fun () -> not Sys.win32)
+    (fun () ->
+      Lwt_process.with_process_in
+        ~timeout:1. ("sleep", [| "sleep"; "2" |])
+          (fun p ->
+            Lwt.catch
+              (fun () -> Lwt_io.read p#stdout)
+              (fun _ -> Lwt.return ""))
+        >>= fun _ -> Lwt.return_true);
+
+  test "subproc stdout can be redirected to null"
+    (fun () ->
+      let args = [|"dummy.exe"; "write"|] in
+      Lwt_process.exec ~stdout:`Dev_null ("./dummy.exe", args)
+      >>= check_status);
+
+  test "subproc stderr can be redirected to null"
+    (fun () ->
+      let args = [|"dummy.exe"; "errwrite"|] in
+      Lwt_process.exec ~stderr:`Dev_null ("./dummy.exe", args)
+      >>= check_status);
+
+  test "subproc cannot write on closed stdout"
+    (fun () ->
+      let args = [|"dummy.exe"; "write"|] in
+      let stderr = `Dev_null    (* mask subproc stderr *) in
+      Lwt_process.exec ~stdout:`Close ~stderr ("./dummy.exe", args)
+      >>= check_status ~status:((<>) 0));
+
+  test "subproc cannot write on closed stderr"
+    (fun () ->
+      let args = [|"dummy.exe"; "errwrite"|] in
+      Lwt_process.exec ~stderr:`Close ("./dummy.exe", args)
+      >>= check_status ~status:((<>) 0));
+
+  test "can write to subproc stdin"
+    (fun () ->
+      let pin, pout = Lwt_unix.pipe_out ~cloexec:true () in
+      pwrite ~stdin:(`FD_move pin) pout);
+
+  test "can read from subproc stdout"
+    (fun () ->
+      let pin, pout = Lwt_unix.pipe_in ~cloexec:true () in
+      pread ~stdout:(`FD_move pout) pin);
+
+  test "can read from subproc stderr"
+    (fun () ->
+      let pin, perr = Lwt_unix.pipe_in ~cloexec:true () in
+      pread ~stderr:(`FD_move perr) pin);
+]

unikernel/duniverse/lwt/test/unix/test_lwt_timeout.ml

@@ -0,0 +1,277 @@
+(* This file is part of Lwt, released under the MIT license. See LICENSE.md for
+   details, or visit https://github.com/ocsigen/lwt/blob/master/LICENSE.md. *)
+
+
+
+open Test
+open Lwt.Infix
+
+(* Note: due to the time delays in the tests of this suite, it could really
+   benefit from an option to run tests in parallel. *)
+
+let suite = suite "Lwt_timeout" [
+  test "basic" begin fun () ->
+    let p, r = Lwt.wait () in
+
+    let start_time = Unix.gettimeofday () in
+
+    let timeout =
+      Lwt_timeout.create 1 (fun () ->
+        let delta = Unix.gettimeofday () -. start_time in
+        Lwt.wakeup_later r delta)
+    in
+    Lwt_timeout.start timeout;
+
+    p >|= fun delta ->
+    instrument (delta >= 2. && delta < 3.)
+      "Lwt_timeout: basic: %f %f" start_time delta
+    (* The above is a bug of the current implementation: it always gives too
+       long a timeout. *)
+  end;
+
+  test "not started" begin fun () ->
+    let p, r = Lwt.wait () in
+
+    Lwt_timeout.create 1 (fun () ->
+      Lwt.wakeup_later r false)
+    |> ignore;
+
+    Lwt.async (fun () ->
+      Lwt_unix.sleep 3. >|= fun () ->
+      Lwt.wakeup_later r true);
+
+    p
+  end;
+
+  test "double start" begin fun () ->
+    let completions = ref 0 in
+
+    let timeout =
+      Lwt_timeout.create 1 (fun () ->
+        completions := !completions + 1)
+    in
+    Lwt_timeout.start timeout;
+    Lwt_timeout.start timeout;
+
+    Lwt_unix.sleep 3. >|= fun () ->
+    instrument (!completions = 1) "Lwt_timeout: double start: %i" !completions
+  end;
+
+  test "restart" begin fun () ->
+    let p, r = Lwt.wait () in
+
+    let completions = ref 0 in
+
+    (* A dummy timeout, just to set up the reference. *)
+    let timeout = ref (Lwt_timeout.create 1 ignore) in
+
+    timeout :=
+      Lwt_timeout.create 1 (fun () ->
+        completions := !completions + 1;
+        if !completions < 2 then
+          Lwt_timeout.start !timeout
+        else
+          Lwt.wakeup_later r true);
+    Lwt_timeout.start !timeout;
+
+    p
+  end;
+
+  test "stop" begin fun () ->
+    let p, r = Lwt.wait () in
+
+    let timeout =
+      Lwt_timeout.create 1 (fun () ->
+        Lwt.wakeup_later r false)
+    in
+    Lwt_timeout.start timeout;
+    Lwt_timeout.stop timeout;
+
+    Lwt.async (fun () ->
+      Lwt_unix.sleep 3. >|= fun () ->
+      Lwt.wakeup_later r true);
+
+    p
+  end;
+
+  test "stop when not stopped" begin fun () ->
+    Lwt_timeout.create 1 ignore
+    |> Lwt_timeout.stop;
+
+    Lwt.return_true
+  end;
+
+  test "invalid delay" begin fun () ->
+    try
+      ignore (Lwt_timeout.create 0 ignore);
+      Lwt.return_false
+    with Invalid_argument _ ->
+      Lwt.return_true
+  end;
+
+  test "change" begin fun () ->
+    let p, r = Lwt.wait () in
+
+    let start_time = Unix.gettimeofday () in
+
+    let timeout =
+      Lwt_timeout.create 5 (fun () ->
+        let delta = Unix.gettimeofday () -. start_time in
+        Lwt.wakeup_later r delta)
+    in
+    Lwt_timeout.change timeout 1;
+    Lwt_timeout.start timeout;
+
+    p >|= fun delta ->
+    instrument (delta >= 1.9 && delta < 3.1)
+      "Lwt_timeout: change: %f %f" start_time delta
+  end;
+
+  test "change does not start" begin fun () ->
+    let p, r = Lwt.wait () in
+
+    let timeout =
+      Lwt_timeout.create 1 (fun () ->
+        Lwt.wakeup_later r false)
+    in
+    Lwt_timeout.change timeout 1;
+
+    Lwt.async (fun () ->
+      Lwt_unix.sleep 3. >|= fun () ->
+      Lwt.wakeup_later r true);
+
+    p
+  end;
+
+  test "change after start" begin fun () ->
+    let p, r = Lwt.wait () in
+
+    let start_time = Unix.gettimeofday () in
+
+    let timeout =
+      Lwt_timeout.create 5 (fun () ->
+        let delta = Unix.gettimeofday () -. start_time in
+        Lwt.wakeup_later r delta)
+    in
+    Lwt_timeout.start timeout;
+    Lwt_timeout.change timeout 1;
+
+    p >|= fun delta ->
+    instrument (delta >= 1.9 && delta < 3.1)
+      "Lwt_timeout: change after start: %f %f" start_time delta
+  end;
+
+  test "change: invalid delay" begin fun () ->
+    let timeout = (Lwt_timeout.create 1 ignore) in
+    try
+      Lwt_timeout.change timeout 0;
+      Lwt.return_false
+    with Invalid_argument _ ->
+      Lwt.return_true
+  end;
+
+  test ~sequential:true "exception in action" begin fun () ->
+    let p, r = Lwt.wait () in
+
+    Test.with_async_exception_hook
+      (fun exn ->
+        match exn with
+        | Exit -> Lwt.wakeup_later r true
+        | _ -> raise exn)
+      (fun () ->
+        Lwt_timeout.create 1 (fun () -> raise Exit)
+        |> Lwt_timeout.start;
+
+        p)
+  end;
+
+  test "set_exn_handler" begin fun () ->
+    let p, r = Lwt.wait () in
+
+    Lwt_timeout.set_exn_handler (fun exn ->
+      match exn with
+      | Exit -> Lwt.wakeup_later r true
+      | _ -> raise exn);
+
+    Lwt_timeout.create 1 (fun () -> raise Exit)
+    |> Lwt_timeout.start;
+
+    p >|= fun result ->
+    Lwt_timeout.set_exn_handler (fun exn ->
+      !Lwt.async_exception_hook exn);
+    result
+  end;
+
+  test "two" begin fun () ->
+    let p1, r1 = Lwt.wait () in
+    let p2, r2 = Lwt.wait () in
+
+    let start_time = Unix.gettimeofday () in
+
+    Lwt_timeout.create 1 (fun () ->
+      let delta = Unix.gettimeofday () -. start_time in
+      Lwt.wakeup r1 delta)
+    |> Lwt_timeout.start;
+
+    Lwt_timeout.create 2 (fun () ->
+      let delta = Unix.gettimeofday () -. start_time in
+      Lwt.wakeup r2 delta)
+    |> Lwt_timeout.start;
+
+    p1 >>= fun delta1 ->
+    p2 >|= fun delta2 ->
+    instrument (delta1 >= 1.9 && delta1 < 3. && delta2 >= 2.9 && delta2 < 4.)
+      "Lwt_timeout: two: %f %f %f" start_time delta1 delta2
+  end;
+
+  test "simultaneous" begin fun () ->
+    let p1, r1 = Lwt.wait () in
+    let p2, r2 = Lwt.wait () in
+
+    let start_time = Unix.gettimeofday () in
+
+    Lwt_timeout.create 1 (fun () ->
+      let delta = Unix.gettimeofday () -. start_time in
+      Lwt.wakeup r1 delta)
+    |> Lwt_timeout.start;
+
+    Lwt_timeout.create 1 (fun () ->
+      let delta = Unix.gettimeofday () -. start_time in
+      Lwt.wakeup r2 delta)
+    |> Lwt_timeout.start;
+
+    p1 >>= fun delta1 ->
+    p2 >|= fun delta2 ->
+    instrument (delta1 >= 1. && delta1 < 2.6 && delta2 >= 1. && delta2 < 2.6)
+      "Lwt_timeout: simultaneous: %f %f %f" start_time delta1 delta2
+  end;
+
+  test "two, first stopped" begin fun () ->
+    let p1, r1 = Lwt.wait () in
+    let p2, r2 = Lwt.wait () in
+
+    let start_time = Unix.gettimeofday () in
+
+    let timeout1 =
+      Lwt_timeout.create 1 (fun () ->
+        Lwt.wakeup r1 false)
+    in
+    Lwt_timeout.start timeout1;
+
+    Lwt_timeout.create 2 (fun () ->
+      let delta = Unix.gettimeofday () -. start_time in
+      Lwt.wakeup r2 delta)
+    |> Lwt_timeout.start;
+
+    Lwt_timeout.stop timeout1;
+    Lwt.async (fun () ->
+      Lwt_unix.sleep 3. >|= fun () ->
+      Lwt.wakeup r1 true);
+
+    p1 >>= fun timeout1_not_fired ->
+    p2 >|= fun delta2 ->
+    instrument (timeout1_not_fired && delta2 >= 1.5 && delta2 < 3.5)
+      "Lwt_timeout: two, first stopped: %b %f %f"
+      timeout1_not_fired start_time delta2
+  end;
+]

unikernel/duniverse/lwt/test/unix/test_mcast.ml

@@ -0,0 +1,79 @@
+(* This file is part of Lwt, released under the MIT license. See LICENSE.md for
+   details, or visit https://github.com/ocsigen/lwt/blob/master/LICENSE.md. *)
+
+
+
+open Lwt.Infix
+open Test
+
+let debug = false
+let hello = Bytes.unsafe_of_string "Hello, World!"
+let mcast_addr =
+  let last_group = ref 0 in
+  fun () ->
+    incr last_group;
+    Printf.sprintf "225.0.0.%i" !last_group
+let mcast_port =
+  let last_port = ref 4421 in
+  fun () ->
+    incr last_port;
+    !last_port
+
+let child mcast_addr join fd =
+  if join then Lwt_unix.mcast_add_membership fd (Unix.inet_addr_of_string mcast_addr);
+  let buf = Bytes.create 50 in
+  Lwt_unix.with_timeout 1. (fun () -> Lwt_unix.read fd buf 0 (Bytes.length buf)) >>= fun n ->
+  if debug then
+    Printf.printf "\nReceived multicast message %S\n%!" (Bytes.unsafe_to_string (Bytes.sub buf 0 n));
+  if Bytes.sub buf 0 n <> hello then
+    raise (Failure "unexpected multicast message")
+  else
+    Lwt.return_unit
+
+let parent mcast_addr mcast_port set_loop fd =
+  Lwt_unix.mcast_set_loop fd set_loop;
+  let addr = Lwt_unix.ADDR_INET (Unix.inet_addr_of_string mcast_addr, mcast_port) in
+  Lwt_unix.sendto fd hello 0 (Bytes.length hello) [] addr >>= fun _ ->
+  if debug then
+    Printf.printf "\nSending multicast message %S to %s:%d\n%!" (Bytes.unsafe_to_string hello)
+      mcast_addr mcast_port;
+  Lwt.return_unit
+
+let test_mcast name join set_loop =
+  test name ~only_if:(fun () -> not Sys.win32) begin fun () ->
+    let mcast_addr = mcast_addr () in
+    let mcast_port = mcast_port () in
+    let should_timeout = not join || not set_loop in
+    let fd1 = Lwt_unix.(socket PF_INET SOCK_DGRAM 0) in
+    let fd2 = Lwt_unix.(socket PF_INET SOCK_DGRAM 0) in
+    let t () =
+      Lwt.catch
+        (fun () ->
+           Lwt_unix.(bind
+             fd1 (ADDR_INET (Unix.inet_addr_any, mcast_port))) >>= fun () ->
+           let t1 = child mcast_addr join fd1 in
+           let t2 = parent mcast_addr mcast_port set_loop fd2 in
+           Lwt.join [t1; t2] >>= fun () -> Lwt.return_true
+        )
+        (function
+          | Lwt_unix.Timeout ->
+            Lwt.return should_timeout
+          | Unix.Unix_error (Unix.EINVAL, "send", _)
+          | Unix.Unix_error (Unix.ENODEV, "setsockopt", _)
+          | Unix.Unix_error (Unix.ENETUNREACH, "send", _) ->
+            raise Skip
+          | e ->
+            Lwt.reraise e
+        )
+    in
+    Lwt.finalize t (fun () -> Lwt.join [Lwt_unix.close fd1; Lwt_unix.close fd2])
+  end
+
+let suite =
+  suite "unix_mcast"
+    [
+      test_mcast "mcast-join-loop" true true;
+      test_mcast "mcast-nojoin-loop" false true;
+      test_mcast "mcast-join-noloop" true false;
+      test_mcast "mcast-nojoin-noloop" false false;
+    ]

unikernel/duniverse/lwt/test/unix/test_sleep_and_timeout.ml

@@ -0,0 +1,96 @@
+(* This file is part of Lwt, released under the MIT license. See LICENSE.md for
+   details, or visit https://github.com/ocsigen/lwt/blob/master/LICENSE.md. *)
+
+open Test
+open Lwt.Infix
+
+(* None of the APIs make promises about how much larger the elapsed time will
+ * be, but they all promise that it won't be less than the expected time. *)
+let cmp_elapsed_time test_name start_time expected_time =
+  let elapsed_time = Unix.gettimeofday () -. start_time in
+  let diff = elapsed_time -. expected_time in
+  let result = diff >= 0. && diff <= 0.2 in
+  instrument result "Lwt_unix sleep and timeout: %s: %f %f %f %b"
+    test_name elapsed_time expected_time diff (Lwt_sys.have `libev)
+
+let suite = suite "Lwt_unix sleep and timeout" [
+    test "sleep" begin fun () ->
+      let start_time = Unix.gettimeofday () in
+      let duration = 1.0 in
+      Lwt_unix.sleep duration
+      >>= fun () ->
+      let check = cmp_elapsed_time "sleep" start_time duration in
+      Lwt.return check
+    end;
+
+    test "timeout" begin fun () ->
+      let start_time = Unix.gettimeofday () in
+      let duration = 1.0 in
+      Lwt.catch
+        (fun () ->
+           Lwt_unix.timeout duration
+           >>= fun () -> Lwt.return_false
+        )
+        (function
+          | Lwt_unix.Timeout ->
+            let check = cmp_elapsed_time "timeout" start_time duration in
+            Lwt.return check
+          | exn -> Lwt.reraise exn
+        )
+    end;
+
+    test "with_timeout : no timeout" begin fun () ->
+      let duration = 1.0 in
+      Lwt_unix.with_timeout duration Lwt.pause
+      >>= fun () -> Lwt.return_true
+    end;
+
+    test "with_timeout : timeout" begin fun () ->
+      let start_time = Unix.gettimeofday () in
+      let duration = 1.0 in
+      let f () = Lwt_unix.sleep 2.0 in
+      Lwt.catch
+        (fun () ->
+           Lwt_unix.with_timeout duration f
+           >>= fun () ->
+           Printf.eprintf "\nno timeout\n";
+           Lwt.return_false
+        )
+        (function
+          | Lwt_unix.Timeout ->
+            let check =
+              cmp_elapsed_time "with_timeout : timeout" start_time duration in
+            Lwt.return check
+          | exn -> Lwt.reraise exn
+        )
+    end;
+
+    test "pause" begin fun () ->
+      let bind_callback_ran = ref false in
+      Lwt.async (fun () -> Lwt.return_unit >|= fun () -> bind_callback_ran := true);
+      let bind_is_immediate = !bind_callback_ran in
+      let pause_callback_ran = ref false in
+      Lwt.async (fun () -> Lwt.pause () >|= fun () -> pause_callback_ran := true);
+      let pause_is_immediate = !pause_callback_ran in
+      Lwt.return (bind_is_immediate && not pause_is_immediate)
+    end;
+
+    test "auto_pause" begin fun () ->
+      let f = Lwt_unix.auto_pause 1.0 in
+      let run_auto_pause () =
+        let callback_ran = ref false in
+        Lwt.async (fun () -> f () >|= fun () -> callback_ran := true);
+        !callback_ran;
+      in
+      let check1 = run_auto_pause () in
+      let check2 = run_auto_pause () in
+      Lwt_unix.sleep 1.0
+      >|= fun () ->
+      let check3 = run_auto_pause () in
+      let check4 = run_auto_pause () in
+      let check5 = run_auto_pause () in
+      let check = check1 && check2 && not check3 && check4 && check5 in
+      instrument check "Lwt_unix sleep and timeout: auto_pause: %b %b %b %b %b"
+        check1 check2 check3 check4 check5
+    end;
+  ]