unikernel/duniverse/lwt/test/core/dune

@@ -0,0 +1,4 @@
+(test
+ (name main)
+ (package lwt)
+ (libraries lwttester))

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

@@ -0,0 +1,20 @@
+(* 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. *)
+
+
+
+Test.run "core"
+  (Test_lwt.suites @ [
+    Test_lwt_stream.suite;
+    Test_lwt_list.suite_primary;
+    Test_lwt_list.suite_intensive;
+    Test_lwt_switch.suite;
+    Test_lwt_mutex.suite;
+    Test_lwt_result.suite;
+    Test_lwt_mvar.suite;
+    Test_lwt_condition.suite;
+    Test_lwt_pool.suite;
+    Test_lwt_sequence.suite;
+    Test_lwt_seq.suite_base;
+    Test_lwt_seq.suite_fuzzing;
+  ])

unikernel/duniverse/lwt/test/core/test_lwt_condition.ml

@@ -0,0 +1,71 @@
+(* 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
+
+exception Dummy_error
+
+let suite = suite "lwt_condition" [
+
+  test "basic wait" begin fun () ->
+    let c = Lwt_condition.create () in
+    let w = Lwt_condition.wait c in
+    let () = Lwt_condition.signal c 1 in
+    Lwt.bind w (fun v -> Lwt.return (v = 1))
+  end;
+
+  test "mutex unlocked during wait" begin fun () ->
+    let c = Lwt_condition.create () in
+    let m = Lwt_mutex.create () in
+    let _ = Lwt_mutex.lock m in
+    let w = Lwt_condition.wait ~mutex:m c in
+    Lwt.return (Lwt.state w = Lwt.Sleep
+                && not (Lwt_mutex.is_locked m))
+  end;
+
+  test "mutex relocked after wait" begin fun () ->
+    let c = Lwt_condition.create () in
+    let m = Lwt_mutex.create () in
+    let _ = Lwt_mutex.lock m in
+    let w = Lwt_condition.wait ~mutex:m c in
+    let () = Lwt_condition.signal c 1 in
+    Lwt.bind w (fun v ->
+      Lwt.return (v = 1 && Lwt_mutex.is_locked m))
+  end;
+
+  test "signal is not sticky" begin fun () ->
+    let c = Lwt_condition.create () in
+    let () = Lwt_condition.signal c 1 in
+    let w = Lwt_condition.wait c in
+    Lwt.return (Lwt.state w = Lwt.Sleep)
+  end;
+
+  test "broadcast" begin fun () ->
+    let c = Lwt_condition.create () in
+    let w1 = Lwt_condition.wait c in
+    let w2 = Lwt_condition.wait c in
+    let () = Lwt_condition.broadcast c 1 in
+    Lwt.bind w1 (fun v1 ->
+    Lwt.bind w2 (fun v2 ->
+    Lwt.return (v1 = 1 && v2 = 1)))
+  end;
+
+  test "broadcast exception" begin fun () ->
+    let c = Lwt_condition.create () in
+    let w1 = Lwt_condition.wait c in
+    let w2 = Lwt_condition.wait c in
+    let () = Lwt_condition.broadcast_exn c Dummy_error in
+    Lwt.try_bind
+      (fun () -> w1)
+      (fun _ -> Lwt.return_false)
+      (fun exn1 ->
+        Lwt.try_bind
+          (fun () -> w2)
+          (fun _ -> Lwt.return_false)
+          (fun exn2 ->
+            Lwt.return (exn1 = Dummy_error && exn2 = Dummy_error)))
+  end;
+
+]

unikernel/duniverse/lwt/test/core/test_lwt_list.ml

@@ -0,0 +1,677 @@
+(* 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 (<=>) v v' =
+  assert (Lwt.state v = v')
+
+let test_iter f test_list =
+  let incr_ x = Lwt.return (incr x) in
+  let () =
+    let l = [ref 0; ref 0; ref 0] in
+    let t = f incr_ l in
+    t <=> Lwt.Return ();
+    List.iter2 (fun v r -> assert (v = !r)) [1; 1; 1] l
+  in
+  let () =
+    let l = [ref 0; ref 0; ref 0] in
+    let t, w = Lwt.wait () in
+    let r = ref [incr_; (fun x -> t >>= (fun () -> incr_ x)); incr_] in
+    let t' = f (fun x ->
+      let f = List.hd !r in
+      let t = f x in
+      r := List.tl !r;
+      t) l
+    in
+    t' <=> Sleep;
+    List.iter2 (fun v r -> assert (v = !r)) test_list l;
+    Lwt.wakeup w ();
+    List.iter2 (fun v r -> assert (v = !r)) [1; 1; 1] l;
+    t' <=> Lwt.Return ()
+  in
+  ()
+
+let test_exception list_combinator =
+  let exception Exception in
+
+  let number_of_callback_calls = ref 0 in
+
+  let callback _ =
+    incr number_of_callback_calls;
+    match !number_of_callback_calls with
+    | 2 -> raise Exception
+    | _ -> Lwt.return_unit
+  in
+
+  (* Even though the callback will raise immediately for one of the list
+     elements, we expect the final promise that represents the entire list
+     operation to be created (and rejected with the raised exception). The
+     raised exception should not be leaked up past the creation of the
+     promise. *)
+  let p =
+    try
+      list_combinator callback [(); (); ()]
+    with _exn ->
+      assert false
+  in
+
+  (* Check that the promise was rejected with the expected exception. *)
+  assert (Lwt.state p = Lwt.Fail Exception)
+
+let test_map f test_list =
+  let t, w = Lwt.wait () in
+  let t', _ = Lwt.task () in
+  let get =
+    let r = ref 0 in
+    let c = ref 0 in
+    fun () ->
+      let th =
+        incr c;
+        match !c with
+        | 5 -> t
+        | 8 -> t'
+        | _ -> Lwt.return_unit
+      in
+      th >>= (fun () ->
+        incr r;
+        Lwt.return (!r))
+  in
+  let () =
+    let l = [(); (); ()] in
+    let t1 = f get l in
+    t1 <=> Lwt.Return [1; 2; 3];
+    let t2 = f get l in
+    t2 <=> Lwt.Sleep;
+    let t3 = f get l in
+    t3 <=> Lwt.Sleep;
+    Lwt.cancel t';
+    t3 <=> Lwt.Fail Lwt.Canceled;
+    Lwt.wakeup w ();
+    t2 <=> Lwt.Return test_list;
+  in
+  ()
+
+let test_parallelism map =
+  let t, w = Lwt.wait () in
+  let g _ =
+    Lwt.wakeup_later w ();
+    Lwt.return_unit in
+  let f x =
+    if x = 0 then t >>= (fun _ -> Lwt.return_unit)
+    else g x
+  in
+  let p = map f [0; 1] in
+  p >>= (fun _ -> Lwt.return_true)
+
+let test_serialization ?(rev=false) map =
+  let other_ran = ref false in
+  let k = if rev then 1 else 0 in
+  let f x =
+    if x = k then
+      Lwt.pause () >>= fun () ->
+      assert(not !other_ran);
+      Lwt.return_unit
+    else begin
+      other_ran := true;
+      Lwt.return_unit
+    end
+  in
+  let p = map f [0; 1] in
+  p >>= (fun _ -> Lwt.return_true)
+
+let test_for_all_true f =
+  let l = [true; true] in
+  f (fun x -> Lwt.return (x = true)) l
+
+let test_for_all_false f =
+  let l = [true; true] in
+  f (fun x -> Lwt.return (x = false)) l >>= fun b ->
+  Lwt.return (not b)
+
+let test_exists_true f =
+  let l = [true; false] in
+  f (fun x -> Lwt.return (x = true)) l >>= fun b ->
+  Lwt.return b
+
+let test_exists_false f =
+  let l = [true; true] in
+  f (fun x -> Lwt.return (x = false)) l >>= fun b ->
+  Lwt.return (not b)
+
+let test_filter f =
+  let l = [1; 2; 3; 4] in
+  f (fun x -> Lwt.return (x mod 2 = 0)) l >>= fun after ->
+  Lwt.return (after = [2; 4])
+
+let test_partition f =
+  let l = [1; 2; 3; 4] in
+  f (fun x -> Lwt.return (x <= 2)) l >>= fun (a, b) ->
+  Lwt.return (a = [1; 2] && b = [3; 4])
+
+let test_filter_map f =
+  let l = [1; 2; 3; 4] in
+  let fn = (fun x ->
+    if x mod 2 = 0 then Lwt.return_some (x * 2) else Lwt.return_none) in
+  f fn l >>= fun after ->
+  Lwt.return (after = [4; 8])
+
+let test_iter_i f =
+  let count = ref 0 in
+  let l = [1; 2; 3] in
+  f (fun i n -> count := !count + i + n; Lwt.return_unit) l >>= fun () ->
+  Lwt.return (!count = 9)
+
+let test_map_i f =
+  let l = [0; 0; 0] in
+  f (fun i n -> Lwt.return (i + n)) l >>= fun after ->
+  Lwt.return (after = [0; 1; 2])
+
+let test_rev_map f =
+  let l = [1; 2; 3] in
+  f (fun n -> Lwt.return (n * 2)) l >>= fun after ->
+  Lwt.return (after = [6; 4; 2])
+
+let suite_primary = suite "lwt_list" [
+  test "iter_p" begin fun () ->
+    test_iter Lwt_list.iter_p [1; 0; 1];
+    test_exception Lwt_list.iter_p;
+    Lwt.return_true
+  end;
+
+  test "iter_s" begin fun () ->
+    test_iter Lwt_list.iter_s [1; 0; 0];
+    test_exception Lwt_list.iter_s;
+    Lwt.return_true
+  end;
+
+  test "map_p" begin fun () ->
+    test_map Lwt_list.map_p [4; 8; 5];
+    test_exception Lwt_list.map_p;
+    Lwt.return_true
+  end;
+
+  test "map_s" begin fun () ->
+    test_map Lwt_list.map_s [4; 7; 8];
+    test_exception Lwt_list.map_s;
+    Lwt.return_true
+  end;
+
+  test "fold_left_s" begin fun () ->
+    let l = [1; 2; 3] in
+    let f acc v = Lwt.return (v::acc) in
+    let t = Lwt_list.fold_left_s f [] l in
+    t <=> Lwt.Return (List.rev l);
+    Lwt.return_true
+  end;
+
+  test "for_all_s"
+    (fun () -> test_for_all_true Lwt_list.for_all_s);
+
+  test "for_all_p"
+    (fun () -> test_for_all_true Lwt_list.for_all_p);
+
+  test "exists_s true"
+    (fun () -> test_exists_true Lwt_list.exists_s);
+
+  test "exists_p true"
+    (fun () -> test_exists_true Lwt_list.exists_p);
+
+  test "exists_s false"
+    (fun () -> test_exists_false Lwt_list.exists_s);
+
+  test "exists_p false"
+    (fun () -> test_exists_false Lwt_list.exists_p);
+
+  test "filter_s"
+    (fun () -> test_filter Lwt_list.filter_s);
+
+  test "filter_p"
+    (fun () -> test_filter Lwt_list.filter_p);
+
+  test "partition_p"
+    (fun () -> test_partition Lwt_list.partition_p);
+
+  test "partition_s"
+    (fun () -> test_partition Lwt_list.partition_s);
+
+  test "filter_map_p"
+    (fun () -> test_filter_map Lwt_list.filter_map_p);
+
+  test "filter_map_s"
+    (fun () -> test_filter_map Lwt_list.filter_map_s);
+
+  test "iteri_p"
+    (fun () -> test_iter_i Lwt_list.iteri_p);
+
+  test "iteri_s"
+    (fun () -> test_iter_i Lwt_list.iteri_s);
+
+  test "mapi_p"
+    (fun () -> test_map_i Lwt_list.mapi_p);
+
+  test "mapi_s"
+    (fun () -> test_map_i Lwt_list.mapi_s);
+
+  test "find_s existing" begin fun () ->
+    let l = [1; 2; 3] in
+    Lwt_list.find_s (fun n -> Lwt.return ((n mod 2) = 0)) l >>= fun result ->
+    Lwt.return (result = 2)
+  end;
+
+  test "find_s missing" begin fun () ->
+    let l = [1; 3] in
+    Lwt.catch
+      (fun () ->
+        Lwt_list.find_s (fun n ->
+          Lwt.return ((n mod 2) = 0)) l >>= fun _result ->
+        Lwt.return_false)
+      (function
+        | Not_found -> Lwt.return_true
+        | _ -> Lwt.return_false)
+  end;
+
+  test "rev_map_p"
+    (fun () -> test_rev_map Lwt_list.rev_map_p);
+
+  test "rev_map_s"
+    (fun () -> test_rev_map Lwt_list.rev_map_s);
+
+  test "fold_right_s" begin fun () ->
+    let l = [1; 2; 3] in
+    Lwt_list.fold_right_s (fun a n -> Lwt.return (a + n)) l 0 >>= fun result ->
+    Lwt.return (result = 6)
+  end;
+
+  test "iteri_p exception" begin fun () ->
+    let i f = Lwt_list.iteri_p (fun _ x -> f x) in
+    test_exception i;
+    Lwt.return_true
+  end;
+
+  test "iteri_s exception" begin fun () ->
+    let i f = Lwt_list.iteri_s (fun _ x -> f x) in
+    test_exception i;
+    Lwt.return_true
+  end;
+
+  test "map_s exception" begin fun () ->
+    test_exception Lwt_list.map_s;
+    Lwt.return_true
+  end;
+
+  test "map_p exception" begin fun () ->
+    test_exception Lwt_list.map_p;
+    Lwt.return_true
+  end;
+
+  test "mapi_s exception" begin fun () ->
+    let m f = Lwt_list.mapi_s (fun _ x -> f x) in
+    test_exception m;
+    Lwt.return_true
+  end;
+
+  test "mapi_p exception" begin fun () ->
+    let m f = Lwt_list.mapi_p (fun _ x -> f x) in
+    test_exception m;
+    Lwt.return_true
+  end;
+
+  test "rev_map_s exception" begin fun () ->
+    test_exception Lwt_list.rev_map_s;
+    Lwt.return_true
+  end;
+
+  test "rev_map_p exception" begin fun () ->
+    test_exception Lwt_list.rev_map_p;
+    Lwt.return_true
+  end;
+
+  test "fold_left_s exception" begin fun () ->
+    let m f = Lwt_list.fold_left_s (fun _ x -> f x) () in
+    test_exception m;
+    Lwt.return_true
+  end;
+
+  test "fold_right_s exception" begin fun() ->
+    let m f l = Lwt_list.fold_right_s (fun x _ -> f x) l () in
+    test_exception m;
+    Lwt.return_true
+  end;
+
+  test "for_all_p exception" begin fun () ->
+    let m f =
+      Lwt_list.for_all_p (fun x -> f x >>= (fun _ -> Lwt.return_true)) in
+    test_exception m;
+    Lwt.return_true
+  end;
+
+  test "for_all_s exception" begin fun () ->
+    let m f =
+      Lwt_list.for_all_s (fun x -> f x >>= (fun _ -> Lwt.return_true)) in
+    test_exception m;
+    Lwt.return_true
+  end;
+
+  test "exists_p exception" begin fun () ->
+    let m f =
+      Lwt_list.exists_p (fun x -> f x >>= (fun _ -> Lwt.return_false)) in
+    test_exception m;
+    Lwt.return_true
+  end;
+
+  test "exists_s exception" begin fun () ->
+    let m f =
+      Lwt_list.exists_s (fun x -> f x >>= (fun _ -> Lwt.return_false)) in
+    test_exception m;
+    Lwt.return_true
+  end;
+
+  test "find_s exception" begin fun () ->
+    let m f = Lwt_list.find_s (fun x -> f x >>= (fun _ -> Lwt.return_false)) in
+    test_exception m;
+    Lwt.return_true
+  end;
+
+  test "filter_p exception" begin fun () ->
+    let m f =
+      Lwt_list.filter_p (fun x -> f x >>= (fun _ -> Lwt.return_false)) in
+    test_exception m;
+    Lwt.return_true;
+  end;
+
+  test "filter_s exception" begin fun () ->
+    let m f =
+      Lwt_list.filter_s (fun x -> f x >>= (fun _ -> Lwt.return_false)) in
+    test_exception m;
+    Lwt.return_true;
+  end;
+
+  test "filter_map_p exception" begin fun () ->
+    let m f =
+      Lwt_list.filter_map_p (fun x -> f x >>= (fun _ -> Lwt.return (Some ())))
+    in
+    test_exception m;
+    Lwt.return_true;
+  end;
+
+  test "filter_map_s exception" begin fun () ->
+    let m f =
+      Lwt_list.filter_map_s (fun x -> f x >>= (fun _ -> Lwt.return (Some ())))
+    in
+    test_exception m;
+    Lwt.return_true;
+  end;
+
+  test "partition_p exception" begin fun () ->
+    let m f =
+      Lwt_list.partition_p (fun x -> f x >>= (fun _ -> Lwt.return_false)) in
+    test_exception m;
+    Lwt.return_true;
+  end;
+
+  test "partition_s exception" begin fun () ->
+    let m f =
+      Lwt_list.partition_s (fun x -> f x >>= (fun _ -> Lwt.return_false)) in
+    test_exception m;
+    Lwt.return_true;
+  end;
+
+  test "iter_p parallelism" begin fun () ->
+    test_parallelism Lwt_list.iter_p
+  end;
+
+  test "iter_s serialization" begin fun () ->
+    test_serialization Lwt_list.iter_s
+  end;
+
+  test "iteri_p parallelism" begin fun () ->
+    let iter f = Lwt_list.iteri_p (fun _ x -> f x) in
+    test_parallelism iter
+  end;
+
+  test "iteri_s serialization" begin fun () ->
+    let iter f = Lwt_list.iteri_s (fun _ x -> f x) in
+    test_serialization iter
+  end;
+
+  test "map_p parallelism" begin fun () ->
+    test_parallelism Lwt_list.map_p
+  end;
+
+  test "map_s serialization" begin fun () ->
+    test_serialization Lwt_list.map_s
+  end;
+
+  test "mapi_p parallelism" begin fun () ->
+    let m f = Lwt_list.mapi_p (fun _ x -> f x) in
+    test_parallelism m
+  end;
+
+  test "mapi_s serialization" begin fun () ->
+    let m f = Lwt_list.mapi_s (fun _ x -> f x) in
+    test_serialization m
+  end;
+
+  test "rev_map_p parallelism" begin fun () ->
+    test_parallelism Lwt_list.rev_map_p
+  end;
+
+  test "rev_map_s serialization" begin fun () ->
+    test_serialization Lwt_list.rev_map_s
+  end;
+
+  test "fold_left_s serialization" begin fun () ->
+    let m f =
+      Lwt_list.fold_left_s (fun _ x -> f x >>= fun _ -> Lwt.return_unit) () in
+    test_serialization m
+  end;
+
+  test "fold_right_s serialization" begin fun () ->
+    let m f l =
+      Lwt_list.fold_right_s (fun x _ -> f x >>= fun _ -> Lwt.return_unit) l () in
+    test_serialization ~rev:true m
+  end;
+
+  test "filter_map_p parallelism" begin fun () ->
+    let m f =
+      Lwt_list.filter_map_p (fun x -> f x >>= fun u -> Lwt.return (Some u)) in
+    test_parallelism m
+  end;
+
+  test "filter_map_s serlialism" begin fun () ->
+    let m f =
+      Lwt_list.filter_map_s (fun x -> f x >>= fun u -> Lwt.return (Some u)) in
+    test_serialization m
+  end;
+
+  test "for_all_p parallelism" begin fun () ->
+    let m f = Lwt_list.for_all_p (fun x -> f x >>= fun _ -> Lwt.return_true) in
+    test_parallelism m
+  end;
+
+  test "for_all_s serialization" begin fun () ->
+    let m f = Lwt_list.for_all_s (fun x -> f x >>= fun _ -> Lwt.return_true) in
+    test_serialization m
+  end;
+
+  test "exists_p parallelism" begin fun () ->
+    let m f = Lwt_list.exists_p (fun x -> f x >>= fun _ -> Lwt.return_false) in
+    test_parallelism m
+  end;
+
+  test "exists_s serialization" begin fun () ->
+    let m f = Lwt_list.exists_s (fun x -> f x >>= fun _ -> Lwt.return_false) in
+    test_serialization m
+  end;
+
+  test "find_s serialization" begin fun () ->
+    let m f = Lwt_list.find_s (fun x -> f x >>= fun _ -> Lwt.return_false) in
+    let handler e =
+      if e = Not_found then Lwt.return_true
+      else Lwt.return_false
+    in
+    Lwt.catch (fun () -> test_serialization m) handler
+  end;
+
+  test "filter_p parallelism" begin fun () ->
+    let m f = Lwt_list.filter_p (fun x -> f x >>= fun _ -> Lwt.return_true) in
+    test_parallelism m
+  end;
+
+  test "filter_s serialization" begin fun () ->
+    let m f = Lwt_list.filter_s (fun x -> f x >>= fun _ -> Lwt.return_true) in
+    test_serialization m
+  end;
+
+
+  test "filter_map_s serialization" begin fun () ->
+    let m f =
+      Lwt_list.filter_map_s (fun x -> f x >>= fun u -> Lwt.return (Some u)) in
+    test_serialization m
+  end;
+
+  test "partition_p parallelism" begin fun () ->
+    let m f l =
+      Lwt_list.partition_p (fun x -> f x >>= fun _ -> Lwt.return_true) l in
+    test_parallelism m
+  end;
+
+  test "partition_s serialization" begin fun () ->
+    let m f l =
+      Lwt_list.partition_s (fun x -> f x >>= fun _ -> Lwt.return_true) l in
+    test_serialization m
+  end;
+]
+
+let test_big_list m =
+  let make_list n = Array.to_list @@ Array.init n (fun x -> x) in
+  let f _ = Lwt.return_unit in
+  m f (make_list 10_000_000) >>= (fun _ -> Lwt.return_true)
+
+let suite_intensive = suite "lwt_list big lists"
+    ~only_if:(fun () ->
+        try Sys.getenv "LWT_STRESS_TEST" = "true" with
+        | Not_found -> false) [
+  test "iter_p big list" begin fun () ->
+    test_big_list Lwt_list.iter_p
+  end;
+
+  test "iter_s big list" begin fun () ->
+    test_big_list Lwt_list.iter_s
+  end;
+
+  test "iteri_p big list" begin fun () ->
+    let iter f = Lwt_list.iteri_p (fun _ x -> f x) in
+    test_big_list iter
+  end;
+
+  test "iteri_s big list" begin fun () ->
+    let iter f = Lwt_list.iteri_s (fun _ x -> f x) in
+    test_serialization iter
+  end;
+
+  test "map_p big list" begin fun () ->
+    test_big_list Lwt_list.map_p
+  end;
+
+  test "map_s big list" begin fun () ->
+    test_serialization Lwt_list.map_s
+  end;
+
+  test "mapi_p big list" begin fun () ->
+    let m f = Lwt_list.mapi_p (fun _ x -> f x) in
+    test_big_list m
+  end;
+
+  test "mapi_s big list" begin fun () ->
+    let m f = Lwt_list.mapi_s (fun _ x -> f x) in
+    test_big_list m
+  end;
+
+  test "rev_map_p big list" begin fun () ->
+    test_big_list Lwt_list.rev_map_p
+  end;
+
+  test "rev_map_s big list" begin fun () ->
+    test_big_list Lwt_list.rev_map_s
+  end;
+
+  test "fold_left_s big list" begin fun () ->
+    let m f =
+      Lwt_list.fold_left_s (fun _ x -> f x >>= fun _ -> Lwt.return_unit) () in
+    test_big_list m
+  end;
+
+  test "fold_right_s big list" begin fun () ->
+    let m f l =
+      Lwt_list.fold_right_s (fun x _ -> f x >>= fun _ -> Lwt.return_unit) l () in
+    test_big_list m
+  end;
+
+  test "for_all_p big list" begin fun () ->
+    let m f = Lwt_list.for_all_p (fun x -> f x >>= fun _ -> Lwt.return_true) in
+    test_big_list m
+  end;
+
+  test "for_all_s big list" begin fun () ->
+    let m f = Lwt_list.for_all_s (fun x -> f x >>= fun _ -> Lwt.return_true) in
+    test_big_list m
+  end;
+
+  test "exists_p big list" begin fun () ->
+    let m f = Lwt_list.exists_p (fun x -> f x >>= fun _ -> Lwt.return_false) in
+    test_big_list m
+  end;
+
+  test "exists_s big list" begin fun () ->
+    let m f = Lwt_list.exists_s (fun x -> f x >>= fun _ -> Lwt.return_false) in
+    test_big_list m
+  end;
+
+  test "find_s big list" begin fun () ->
+    let m f = Lwt_list.find_s (fun x -> f x >>= fun _ -> Lwt.return_false) in
+    let handler e =
+      if e = Not_found then Lwt.return_true
+      else Lwt.return_false
+    in
+    Lwt.catch (fun () -> test_big_list m) handler
+  end;
+
+  test "filter_p big list" begin fun () ->
+    let m f = Lwt_list.filter_p (fun x -> f x >>= fun _ -> Lwt.return_true) in
+    test_big_list m
+  end;
+
+  test "filter_s big list" begin fun () ->
+    let m f = Lwt_list.filter_s (fun x -> f x >>= fun _ -> Lwt.return_true) in
+    test_big_list m
+  end;
+
+  test "filter_map_p big list" begin fun () ->
+    let m f =
+      Lwt_list.filter_map_p (fun x -> f x >>= fun u -> Lwt.return (Some u)) in
+    test_big_list m
+  end;
+
+  test "filter_map_s big list" begin fun () ->
+    let m f =
+      Lwt_list.filter_map_s (fun x -> f x >>= fun u -> Lwt.return (Some u)) in
+    test_big_list m
+  end;
+
+  test "partition_p big list" begin fun () ->
+    let m f l =
+      Lwt_list.partition_p (fun x -> f x >>= fun _ -> Lwt.return_true) l in
+    test_big_list m
+  end;
+
+  test "partition_s big list" begin fun () ->
+    let m f l =
+      Lwt_list.partition_s (fun x -> f x >>= fun _ -> Lwt.return_true) l in
+    test_big_list m
+  end;
+]

unikernel/duniverse/lwt/test/core/test_lwt_mutex.ml

@@ -0,0 +1,106 @@
+(* 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 suite = suite "lwt_mutex" [
+  (* See https://github.com/ocsigen/lwt/pull/202#issue-123451878. *)
+  test "cancel"
+    (fun () ->
+      let mutex = Lwt_mutex.create () in
+
+      (* Thread 1: take the mutex and wait. *)
+      let thread_1_wait, resume_thread_1 = Lwt.wait () in
+      let thread_1 = Lwt_mutex.with_lock mutex (fun () -> thread_1_wait) in
+
+      (* Thread 2: block on the mutex. *)
+      let thread_2_locked_mutex = ref false in
+      let thread_2 =
+        Lwt_mutex.lock mutex >|= fun () ->
+        thread_2_locked_mutex := true
+      in
+
+      (* Cancel thread 2, and make sure it is canceled. *)
+      Lwt.cancel thread_2;
+      Lwt.catch
+        (fun () -> thread_2 >>= fun () -> Lwt.return_false)
+        (function
+        | Lwt.Canceled -> Lwt.return_true
+        | _ -> Lwt.return_false)
+      >>= fun thread_2_canceled ->
+
+      (* Thread 1: release the mutex. *)
+      Lwt.wakeup resume_thread_1 ();
+      thread_1 >>= fun () ->
+
+      (* Thread 3: try to take the mutex. Thread 2 should not have it locked,
+         since thread 2 was canceled. *)
+      Lwt_mutex.lock mutex >|= fun () ->
+
+      not !thread_2_locked_mutex && thread_2_canceled);
+
+  (* See https://github.com/ocsigen/lwt/pull/202#issuecomment-227092595. *)
+  test "cancel while queued by unlock"
+    (fun () ->
+      let mutex = Lwt_mutex.create () in
+
+      (* Thread 1: take the mutex and wait. *)
+      let thread_1_wait, resume_thread_1 = Lwt.wait () in
+      let thread_1 = Lwt_mutex.with_lock mutex (fun () -> thread_1_wait) in
+
+      (* Thread 2: block on the mutex, then set a flag and release it. *)
+      let thread_2_waiter_executed = ref false in
+      let thread_2 =
+        Lwt_mutex.lock mutex >|= fun () ->
+        thread_2_waiter_executed := true;
+        Lwt_mutex.unlock mutex
+      in
+
+      (* Thread 3: wrap the wakeup of thread 2 in a wakeup of thread 3. *)
+      let top_level_waiter, wake_top_level_waiter = Lwt.wait () in
+      let while_waking =
+        top_level_waiter >>= fun () ->
+        (* Inside thread 3 wakeup. *)
+
+        (* Thread 1: release the mutex. This queues thread 2 using
+           wakeup_later inside Lwt_mutex.unlock. *)
+        Lwt.wakeup resume_thread_1 ();
+        thread_1 >>= fun () ->
+
+        (* Confirm the mutex is now considered locked by thread 2. *)
+        let mutex_passed = Lwt_mutex.is_locked mutex in
+        (* Confirm thread 2 hasn't executed its bind (well, map). It is
+           queued. *)
+        let thread_2_was_queued = not !thread_2_waiter_executed in
+
+        (* Try to cancel thread 2. *)
+        Lwt.cancel thread_2;
+
+        (* Complete thread 2 and check it has not been canceled. *)
+        Lwt.catch
+          (fun () -> thread_2 >>= fun () -> Lwt.return_false)
+          (function
+          | Lwt.Canceled -> Lwt.return_true
+          | _ -> Lwt.return_false)
+        >|= fun thread_2_canceled ->
+
+        (* Confirm that thread 2 ran, and released the mutex. *)
+        mutex_passed &&
+          thread_2_was_queued &&
+          not thread_2_canceled &&
+          !thread_2_waiter_executed &&
+          not (Lwt_mutex.is_locked mutex)
+      in
+
+      (* Run thread 3.
+       * Keep this as wakeup_later to test the issue on 2.3.2 reported in
+       * https://github.com/ocsigen/lwt/pull/202
+       * See also:
+       * https://github.com/ocsigen/lwt/pull/261
+       *)
+      Lwt.wakeup_later wake_top_level_waiter ();
+      while_waking);
+]

unikernel/duniverse/lwt/test/core/test_lwt_mvar.ml

@@ -0,0 +1,90 @@
+(* 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 state_is =
+  Lwt.debug_state_is
+
+
+
+let suite = suite "lwt_mvar" [
+  test "basic take" begin fun () ->
+    let x = Lwt_mvar.create 0 in
+    let y = Lwt_mvar.take x in
+    state_is (Lwt.Return 0) y
+  end;
+
+  test "take_available (full)" begin fun () ->
+    let x = Lwt_mvar.create 0 in
+    let y = Lwt_mvar.take_available x in
+    Lwt.return (y = Some 0)
+  end;
+
+  test "take_available (empty)" begin fun () ->
+    let x = Lwt_mvar.create_empty () in
+    let y = Lwt_mvar.take_available x in
+    Lwt.return (y = None)
+  end;
+
+  test "take_available (twice)" begin fun () ->
+    let x = Lwt_mvar.create 0 in
+    let (_ : int option) = Lwt_mvar.take_available x in
+    let y = Lwt_mvar.take_available x in
+    Lwt.return (y = None)
+  end;
+
+  test "is_empty (full)" begin fun () ->
+    let x = Lwt_mvar.create 0 in
+    let y = Lwt_mvar.is_empty x in
+    Lwt.return (not y)
+  end;
+
+  test "is_empty (empty)" begin fun () ->
+    let x = Lwt_mvar.create_empty () in
+    let y = Lwt_mvar.is_empty x in
+    Lwt.return y
+  end;
+
+  test "blocking put" begin fun () ->
+    let x = Lwt_mvar.create 0 in
+    let y = Lwt_mvar.put x 1 in
+    Lwt.return (Lwt.state y = Lwt.Sleep)
+  end;
+
+  test "put-take" begin fun () ->
+    let x = Lwt_mvar.create_empty () in
+    let _ = Lwt_mvar.put x 0 in
+    let y = Lwt_mvar.take x in
+    state_is (Lwt.Return 0) y
+  end;
+
+  test "take-put" begin fun () ->
+    let x = Lwt_mvar.create 0 in
+    let _ = Lwt_mvar.take x in
+    let y = Lwt_mvar.put x 1 in
+    state_is (Lwt.Return ()) y
+  end;
+
+  test "enqueued writer" begin fun () ->
+    let x = Lwt_mvar.create 1 in
+    let y = Lwt_mvar.put x 2 in
+    let z = Lwt_mvar.take x in
+    state_is (Lwt.Return ()) y >>= fun y_correct ->
+    state_is (Lwt.Return 1) z >>= fun z_correct ->
+    Lwt.return (y_correct && z_correct)
+  end;
+
+  test "writer cancellation" begin fun () ->
+    let y = Lwt_mvar.create 1 in
+    let r1 = Lwt_mvar.put y 2 in
+    Lwt.cancel r1;
+    Lwt.return ((Lwt.state (Lwt_mvar.take y) = Lwt.Return 1)
+                && (Lwt.state (Lwt_mvar.take y) = Lwt.Sleep))
+  end;
+  ]

unikernel/duniverse/lwt/test/core/test_lwt_pool.ml

@@ -0,0 +1,179 @@
+(* 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
+
+exception Dummy_error
+
+let suite = suite "lwt_pool" [
+
+  test "basic create-use" begin fun () ->
+    let gen = fun () -> Lwt.return_unit in
+    let p = Lwt_pool.create 1 gen in
+    Lwt.return (Lwt.state (Lwt_pool.use p Lwt.return) = Lwt.Return ())
+  end;
+
+  test "creator exception" begin fun () ->
+    let gen = fun () -> raise Dummy_error in
+    let p = Lwt_pool.create 1 gen in
+    let u = Lwt_pool.use p (fun _ -> Lwt.return 0) in
+    Lwt.return (Lwt.state u = Lwt.Fail Dummy_error)
+  end;
+
+  test "pool elements are reused" begin fun () ->
+    let gen = (fun () -> let n = ref 0 in Lwt.return n) in
+    let p = Lwt_pool.create 1 gen in
+    let _ = Lwt_pool.use p (fun n -> n := 1; Lwt.return !n) in
+    let u2 = Lwt_pool.use p (fun n -> Lwt.return !n) in
+    Lwt.return (Lwt.state u2 = Lwt.Return 1)
+  end;
+
+  test "pool elements are validated when returned" begin fun () ->
+    let gen = (fun () -> let n = ref 0 in Lwt.return n) in
+    let v l = Lwt.return (!l = 0) in
+    let p = Lwt_pool.create 1 ~validate:v gen in
+    let _ = Lwt_pool.use p (fun n -> n := 1; Lwt.return !n) in
+    let u2 = Lwt_pool.use p (fun n -> Lwt.return !n) in
+    Lwt.return (Lwt.state u2 = Lwt.Return 0)
+  end;
+
+  test "validation exceptions are propagated to users" begin fun () ->
+    let c = Lwt_condition.create () in
+    let gen = (fun () -> let l = ref 0 in Lwt.return l) in
+    let v l = if !l = 0 then Lwt.return_true else raise Dummy_error in
+    let p = Lwt_pool.create 1 ~validate:v gen in
+    let u1 = Lwt_pool.use p (fun l -> l := 1; Lwt_condition.wait c) in
+    let u2 = Lwt_pool.use p (fun l -> Lwt.return !l) in
+    let () = Lwt_condition.signal c "done" in
+    Lwt.bind u1 (fun v1 ->
+    Lwt.try_bind
+      (fun () -> u2)
+      (fun _ -> Lwt.return_false)
+      (fun exn2 ->
+        Lwt.return (v1 = "done" && exn2 = Dummy_error)))
+  end;
+
+  test "multiple creation" begin fun () ->
+    let gen = (fun () -> let n = ref 0 in Lwt.return n) in
+    let p = Lwt_pool.create 2 gen in
+    let _ = Lwt_pool.use p (fun n -> n := 1; Lwt.pause ()) in
+    let u2 = Lwt_pool.use p (fun n -> Lwt.return !n) in
+    Lwt.return (Lwt.state u2 = Lwt.Return 0)
+  end;
+
+  test "users of an empty pool will wait" begin fun () ->
+    let gen = (fun () -> Lwt.return 0) in
+    let p = Lwt_pool.create 1 gen in
+    let _ = Lwt_pool.use p (fun _ -> Lwt.pause ()) in
+    let u2 = Lwt_pool.use p Lwt.return in
+    Lwt.return (Lwt.state u2 = Lwt.Sleep)
+  end;
+
+  test "on check, good elements are retained" begin fun () ->
+    let gen = (fun () -> let n = ref 1 in Lwt.return n) in
+    let c = (fun x f -> f (!x > 0)) in
+    let p = Lwt_pool.create 1 ~check: c gen in
+    let _ = Lwt_pool.use p (fun n -> n := 2; Lwt.fail Dummy_error) in
+    let u2 = Lwt_pool.use p (fun n -> Lwt.return !n) in
+    Lwt.return (Lwt.state u2 = Lwt.Return 2)
+  end;
+
+  test "on check, bad elements are disposed of and replaced" begin fun () ->
+    let gen = (fun () -> let n = ref 1 in Lwt.return n) in
+    let check = (fun n f -> f (!n > 0)) in
+    let disposed = ref false in
+    let dispose _ = disposed := true; Lwt.return_unit in
+    let p = Lwt_pool.create 1 ~check ~dispose gen in
+    let task = (fun n -> incr n; Lwt.return !n) in
+    let _ = Lwt_pool.use p (fun n -> n := 0; Lwt.fail Dummy_error) in
+    let u2 = Lwt_pool.use p task in
+    Lwt.return (Lwt.state u2 = Lwt.Return 2 && !disposed)
+  end;
+
+  test "clear disposes of all elements" begin fun () ->
+    let gen = (fun () -> let n = ref 1 in Lwt.return n) in
+    let count = ref 0 in
+    let dispose _ = incr count; Lwt.return_unit in
+    let p = Lwt_pool.create 2 ~dispose gen in
+    let u = Lwt_pool.use p (fun _ -> Lwt.pause ()) in
+    let _ = Lwt_pool.use p (fun _ -> Lwt.return_unit) in
+    let _ = Lwt_pool.clear p in
+    Lwt.bind u (fun () -> Lwt.return (!count = 2))
+  end;
+
+  test "waiter are notified on replacement" begin fun () ->
+    let c = Lwt_condition.create () in
+    let gen = (fun () -> let l = ref 0 in Lwt.return l) in
+    let v l = if !l = 0 then Lwt.return_true else raise Dummy_error in
+    let p = Lwt_pool.create 1 ~validate:v gen in
+    let u1 = Lwt_pool.use p (fun l -> l := 1; Lwt_condition.wait c) in
+    let u2 = Lwt_pool.use p (fun l -> Lwt.return !l) in
+    let u3 = Lwt_pool.use p (fun l -> Lwt.return !l) in
+    let () = Lwt_condition.signal c "done" in
+    Lwt.bind u1 (fun v1 ->
+    Lwt.bind u3 (fun v3 ->
+    Lwt.try_bind
+      (fun () -> u2)
+      (fun _ -> Lwt.return_false)
+      (fun exn2 ->
+        Lwt.return (v1 = "done" && exn2 = Dummy_error && v3 = 0))))
+  end;
+
+  test "waiter are notified on replacement exception" begin fun () ->
+    let c = Lwt_condition.create () in
+    let k = ref true in
+    let gen = fun () ->
+      if !k then
+        let l = ref 0 in Lwt.return l
+      else
+        raise Dummy_error
+    in
+    let v l = if !l = 0 then Lwt.return_true else raise Dummy_error in
+    let p = Lwt_pool.create 1 ~validate:v gen in
+    let u1 = Lwt_pool.use p (fun l -> l := 1; k:= false; Lwt_condition.wait c) in
+    let u2 = Lwt_pool.use p (fun l -> Lwt.return !l) in
+    let u3 = Lwt_pool.use p (fun l -> Lwt.return !l) in
+    let () = Lwt_condition.signal c "done" in
+    Lwt.bind u1 (fun v1 ->
+    Lwt.try_bind
+      (fun () -> u2)
+      (fun _ -> Lwt.return_false)
+      (fun exn2 ->
+        Lwt.try_bind
+          (fun () -> u3)
+          (fun _ -> Lwt.return_false)
+          (fun exn3 ->
+            Lwt.return
+              (v1 = "done" && exn2 = Dummy_error && exn3 = Dummy_error))))
+  end;
+
+  test "check and validate can be used together" begin fun () ->
+    let gen = (fun () -> let l = ref 0 in Lwt.return l) in
+    let v l = Lwt.return (!l > 0) in
+    let c l f = f (!l > 1) in
+    let cond = Lwt_condition.create() in
+    let p = Lwt_pool.create 1 ~validate:v ~check:c gen in
+    let _ = Lwt_pool.use p (fun l -> l := 1; Lwt_condition.wait cond) in
+    let _ = Lwt_pool.use p (fun l -> l := 2; raise Dummy_error) in
+    let u3 = Lwt_pool.use p (fun l -> Lwt.return !l) in
+    let () = Lwt_condition.signal cond "done" in
+    Lwt.bind u3 (fun v ->
+    Lwt.return (v = 2))
+  end;
+
+  test "verify default check behavior" begin fun () ->
+    let gen = (fun () -> let l = ref 0 in Lwt.return l) in
+    let cond = Lwt_condition.create() in
+    let p = Lwt_pool.create 1 gen in
+    let _ = Lwt_pool.use p (fun l ->
+      Lwt.bind (Lwt_condition.wait cond)
+        (fun _ -> l:= 1; raise Dummy_error)) in
+    let u2 = Lwt_pool.use p (fun l -> Lwt.return !l) in
+    let () = Lwt_condition.signal cond "done" in
+    Lwt.bind u2 (fun v ->
+    Lwt.return (v = 1))
+  end;
+
+  ]

unikernel/duniverse/lwt/test/core/test_lwt_result.ml

@@ -0,0 +1,300 @@
+(* 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
+
+exception Dummy_error
+
+let state_is =
+  Lwt.debug_state_is
+
+let suite =
+  suite "lwt_result" [
+    test "maps"
+      (fun () ->
+         let x = Lwt_result.return 0 in
+         let correct = Lwt_result.return 1 in
+         Lwt.return (Lwt_result.map ((+) 1) x = correct)
+      );
+
+    test ">|= is a variant of map"
+      (fun () ->
+         let x = Lwt_result.return 0 in
+         let correct = Lwt_result.return 1 in
+         Lwt.return (Lwt_result.(>|=) x ((+) 1) = correct)
+      );
+
+    test "map, error case"
+      (fun () ->
+         let x = Lwt_result.fail 0 in
+         Lwt.return (Lwt_result.map ((+) 1) x = x)
+      );
+
+    test "map_error"
+      (fun () ->
+         let x = Lwt_result.return 0 in
+         Lwt.return (Lwt_result.map_error ((+) 1) x = x)
+      );
+
+    test "map_error, error case"
+      (fun () ->
+         let x = Lwt_result.fail 0 in
+         let correct = Lwt_result.fail 1 in
+         Lwt.return (Lwt_result.map_error ((+) 1) x = correct)
+      );
+
+    test "bind"
+      (fun () ->
+         let x = Lwt_result.return 0 in
+         let correct = Lwt_result.return 1 in
+         let actual = Lwt_result.bind x (fun y -> Lwt_result.return (y + 1)) in
+         Lwt.return (actual = correct)
+      );
+
+    test "bind, error case"
+      (fun () ->
+         let x = Lwt_result.fail 0 in
+         let actual = Lwt_result.bind x (fun y -> Lwt_result.return (y + 1)) in
+         Lwt.return (actual = x)
+      );
+      
+    test "bind_error"
+      (fun () ->
+         let x = Lwt_result.return 0 in
+         let actual = Lwt_result.bind_error x (fun y -> Lwt_result.return (y + 1)) in
+         Lwt.return (actual = x)
+      );
+
+    test "bind_error, error case"
+      (fun () ->
+         let x = Lwt_result.fail 0 in
+         let correct = Lwt_result.return 1 in
+         let actual = Lwt_result.bind_error x (fun y -> Lwt_result.return (y + 1)) in
+         Lwt.return (actual = correct)
+      );
+      
+    test "ok"
+      (fun () ->
+         let x = Lwt.return 0 in
+         Lwt.return (Lwt_result.ok x = Lwt_result.return 0)
+      );
+
+    test "error"
+      (fun () ->
+        let x = Lwt.return 0 in
+        Lwt.return (Lwt_result.error x = Lwt_result.fail 0)
+      );
+
+    test "catch"
+      (fun () ->
+         let x () = Lwt.return 0 in
+         Lwt.return (Lwt_result.catch x = Lwt_result.return 0)
+      );
+
+    test "catch, error case"
+      (fun () ->
+         let x () = raise Dummy_error in
+         Lwt.return (Lwt_result.catch x = Lwt_result.fail Dummy_error)
+      );
+
+    test "catch, bound raise"
+      (fun () ->
+         let x () = Lwt.bind Lwt.return_unit (fun () -> raise Dummy_error) in
+         Lwt.return (Lwt_result.catch x = Lwt_result.fail Dummy_error)
+      );
+
+    test "catch, immediate raise"
+      (fun () ->
+         let x () = raise Dummy_error in
+         Lwt.return (Lwt_result.catch x = Lwt_result.fail Dummy_error)
+      );
+
+    test "get_exn"
+      (fun () ->
+         let x = Lwt_result.return 0 in
+         Lwt.return (Lwt_result.get_exn x = Lwt.return 0)
+      );
+
+    test "get_exn, error case"
+      (fun () ->
+         let x = Lwt_result.fail Dummy_error in
+         Lwt.return (Lwt_result.get_exn x = Lwt.fail Dummy_error)
+      );
+
+    test "bind_lwt"
+      (fun () ->
+         let x = Lwt_result.return 0 in
+         let f y = Lwt.return (y + 1) in
+         Lwt.return (Lwt_result.bind_lwt x f = Lwt_result.return 1)
+      );
+
+    test "bind_lwt, error case"
+      (fun () ->
+         let x = Lwt_result.fail 0 in
+         let f y = Lwt.return (y + 1) in
+         Lwt.return (Lwt_result.bind_lwt x f = Lwt_result.fail 0)
+      );
+
+    test "bind_lwt_error"
+      (fun () ->
+         let x = Lwt_result.return 0 in
+         let f y = Lwt.return (y + 1) in
+         Lwt.return (Lwt_result.bind_lwt_error x f = Lwt_result.return 0)
+      );
+
+    test "bind_lwt_error, error case"
+      (fun () ->
+         let x = Lwt_result.fail 0 in
+         let f y = Lwt.return (y + 1) in
+         Lwt.return (Lwt_result.bind_lwt_error x f = Lwt_result.fail 1)
+      );
+
+    test "bind_result"
+      (fun () ->
+         let x = Lwt_result.return 0 in
+         let f y = Result.Ok (y + 1) in
+         Lwt.return (Lwt_result.bind_result x f = Lwt_result.return 1)
+      );
+
+    test "bind_result, error case"
+      (fun () ->
+         let x = Lwt_result.fail 0 in
+         let f y = Result.Ok (y + 1) in
+         Lwt.return (Lwt_result.bind_result x f = Lwt_result.fail 0)
+      );
+
+    test "both ok"
+      (fun () ->
+         let p =
+           Lwt_result.both
+             (Lwt_result.return 0)
+             (Lwt_result.return 1)
+         in
+         state_is (Lwt.Return (Result.Ok (0,1))) p
+      );
+
+    test "both only fst error"
+      (fun () ->
+         let p =
+           Lwt_result.both
+             (Lwt_result.fail 0)
+             (Lwt_result.return 1)
+         in
+         state_is (Lwt.Return (Result.Error 0)) p
+      );
+
+    test "both only snd error"
+      (fun () ->
+         let p =
+           Lwt_result.both
+             (Lwt_result.return 0)
+             (Lwt_result.fail 1)
+         in
+         state_is (Lwt.Return (Result.Error 1)) p
+      );
+
+    test "both error, fst"
+      (fun () ->
+         let p2, r2 = Lwt.wait () in
+         let p =
+           Lwt_result.both
+             (Lwt_result.fail 0)
+             p2
+         in
+         Lwt.wakeup_later r2 (Result.Error 1);
+         Lwt.bind p (fun x -> Lwt.return (x = Result.Error 0))
+      );
+
+    test "both error, snd"
+      (fun () ->
+         let p1, r1 = Lwt.wait () in
+         let p =
+           Lwt_result.both
+             p1
+             (Lwt_result.fail 1)
+         in
+         Lwt.wakeup_later r1 (Result.Error 0);
+         Lwt.bind p (fun x -> Lwt.return (x = Result.Error 1))
+      );
+
+    test "iter"
+      (fun () ->
+        let x = Lwt_result.return 1 in
+        let actual = ref 0 in
+        Lwt.bind
+          (Lwt_result.iter (fun y -> actual := y + 1; Lwt.return_unit) x)
+          (fun () -> Lwt.return (!actual = 2))
+      );
+
+    test "iter, error case"
+      (fun () ->
+        let x = Lwt_result.fail 1 in
+        let actual = ref 0 in
+        Lwt.bind
+          (Lwt_result.iter (fun y -> actual := y + 1; Lwt.return_unit) x)
+          (fun () -> Lwt.return (!actual <> 2))
+      );
+
+    test "iter_error"
+      (fun () ->
+        let x = Lwt_result.fail 1 in
+        let actual = ref 0 in
+        Lwt.bind
+          (Lwt_result.iter_error (fun y -> actual := y + 1; Lwt.return_unit) x)
+          (fun () -> Lwt.return (!actual = 2))
+      );
+
+    test "iter_error, success case"
+      (fun () ->
+        let x = Lwt_result.return 1 in
+        let actual = ref 0 in
+        Lwt.bind
+          (Lwt_result.iter_error (fun y -> actual := y + 1; Lwt.return_unit) x)
+          (fun () -> Lwt.return (!actual <> 2))
+      );
+
+    test "let*"
+      (fun () ->
+        let p1, r1 = Lwt.wait () in
+        let p2, r2 = Lwt.wait () in
+        let p' =
+          let open Lwt_result.Syntax in
+          let* s1 = p1 in
+          let* s2 = p2 in
+          Lwt.return (Result.Ok (s1 ^ s2))
+        in
+        Lwt.wakeup r1 (Result.Ok "foo");
+        Lwt.wakeup r2 (Result.Ok "bar");
+        state_is (Lwt.Return (Result.Ok "foobar")) p'
+      );
+
+    test "and*"
+      (fun () ->
+        let p1, r1 = Lwt.wait () in
+        let p2, r2 = Lwt.wait () in
+        let p' =
+          let open Lwt_result.Syntax in
+          let* s1 = p1
+          and* s2 = p2 in
+          Lwt.return (Result.Ok (s1 ^ s2))
+        in
+        Lwt.wakeup r1 (Result.Ok "foo");
+        Lwt.wakeup r2 (Result.Ok "bar");
+        state_is (Lwt.Return (Result.Ok "foobar")) p'
+      );
+
+    test "let+/and+"
+      (fun () ->
+        let p1, r1 = Lwt.wait () in
+        let p2, r2 = Lwt.wait () in
+        let p' =
+          let open Lwt_result.Syntax in
+          let+ s1 = p1
+          and+ s2 = p2 in
+          s1 ^ s2
+        in
+        Lwt.wakeup r1 (Result.Ok "foo");
+        Lwt.wakeup r2 (Result.Ok "bar");
+        state_is (Lwt.Return (Result.Ok "foobar")) p'
+      );
+  ]

unikernel/duniverse/lwt/test/core/test_lwt_seq.ml

@@ -0,0 +1,379 @@
+(* 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.Syntax
+
+open Test
+
+let l =  [1; 2; 3; 4; 5]
+let a = Lwt_seq.of_list l
+let rec pause n =
+   if n <= 0 then
+      Lwt.return_unit
+   else
+      let* () = Lwt.pause () in
+      pause (n - 1)
+let pause n = pause (n mod 5)
+let b =
+   Lwt_seq.unfold_lwt
+     (function
+      | [] -> let+ () = pause 2 in None
+      | x::xs -> let+ () = pause (x+2) in Some (x, xs))
+     l
+
+let suite_base = suite "lwt_seq" [
+  test "fold_left" begin fun () ->
+    let n = ref 1 in
+    Lwt_seq.fold_left (fun acc x ->
+      let r = x = !n && acc in
+      incr n; r) true a
+  end;
+  test "fold_left_s" begin fun () ->
+    let n = ref 1 in
+    Lwt_seq.fold_left_s (fun acc x ->
+      let r = x = !n && acc in
+      incr n; Lwt.return r) true a
+  end;
+
+  test "map" begin fun () ->
+    let v = Lwt_seq.map (fun x -> (x * 2)) a in
+    let+ l' = Lwt_seq.to_list v in
+    l' = [2; 4; 6; 8; 10]
+  end;
+  test "map_s" begin fun () ->
+    let v = Lwt_seq.map_s (fun x -> Lwt.return (x * 2)) a in
+    let+ l' = Lwt_seq.to_list v in
+    l' = [2; 4; 6; 8; 10]
+  end;
+
+  test "filter" begin fun () ->
+    let v = Lwt_seq.filter (fun x -> (x mod 2 = 0)) a in
+    let+ l' = Lwt_seq.to_list v in
+    l' = [2; 4]
+  end;
+  test "filter_s" begin fun () ->
+    let v = Lwt_seq.filter_s (fun x -> Lwt.return (x mod 2 = 0)) a in
+    let+ l' = Lwt_seq.to_list v in
+    l' = [2; 4]
+  end;
+
+  test "iter_n(1)" begin fun () ->
+    let max_concurrency = 1 in
+    let running = ref 0 in
+    let sum = ref 0 in
+    let f x =
+       incr running;
+       assert (!running <= max_concurrency);
+       let* () = pause x in
+       sum := !sum + x;
+       decr running;
+       Lwt.return_unit
+    in
+    let* () = Lwt_seq.iter_n ~max_concurrency f a in
+    assert (!sum = List.fold_left (+) 0 l);
+    sum := 0;
+    let* () = Lwt_seq.iter_n ~max_concurrency f b in
+    assert (!sum = List.fold_left (+) 0 l);
+    Lwt.return_true
+  end;
+  test "iter_n(2)" begin fun () ->
+    let max_concurrency = 2 in
+    let running = ref 0 in
+    let sum = ref 0 in
+    let f x =
+       incr running;
+       assert (!running <= max_concurrency);
+       let* () = pause x in
+       sum := !sum + x;
+       decr running;
+       Lwt.return_unit
+    in
+    let* () = Lwt_seq.iter_n ~max_concurrency f a in
+    assert (!sum = List.fold_left (+) 0 l);
+    sum := 0;
+    let* () = Lwt_seq.iter_n ~max_concurrency f b in
+    assert (!sum = List.fold_left (+) 0 l);
+    Lwt.return_true
+  end;
+  test "iter_n(100)" begin fun () ->
+    let max_concurrency = 100 in
+    let running = ref 0 in
+    let sum = ref 0 in
+    let f x =
+       incr running;
+       assert (!running <= max_concurrency);
+       let* () = pause x in
+       sum := !sum + x;
+       decr running;
+       Lwt.return_unit
+    in
+    let* () = Lwt_seq.iter_n ~max_concurrency f a in
+    assert (!sum = List.fold_left (+) 0 l);
+    sum := 0;
+    let* () = Lwt_seq.iter_n ~max_concurrency f b in
+    assert (!sum = List.fold_left (+) 0 l);
+    Lwt.return_true
+  end;
+
+  test "filter_map" begin fun () ->
+    let v = Lwt_seq.filter_map (fun x ->
+      if x mod 2 = 0 then Some (x * 2) else None) a
+    in
+    let+ l' = Lwt_seq.to_list v in
+    l' = [4; 8]
+  end;
+  test "filter_map_s" begin fun () ->
+    let v = Lwt_seq.filter_map_s (fun x ->
+      Lwt.return (if x mod 2 = 0 then Some (x * 2) else None)) a
+    in
+    let+ l' = Lwt_seq.to_list v in
+    l' = [4; 8]
+  end;
+
+  test "unfold" begin fun () ->
+    let range first last =
+      let step i = if i > last then None else Some (i, succ i) in
+      Lwt_seq.unfold step first
+    in
+    let* a = Lwt_seq.to_list (range 1 3) in
+    let+ b = Lwt_seq.to_list (range 1 0) in
+      ([1;2;3] = a) &&
+      ([] = b)
+  end;
+
+  test "unfold_lwt" begin fun () ->
+    let range first last =
+      let step i =
+         if i > last then Lwt.return_none else Lwt.return_some (i, succ i)
+      in
+      Lwt_seq.unfold_lwt step first
+    in
+    let* a = Lwt_seq.to_list (range 1 3) in
+    let+ b = Lwt_seq.to_list (range 1 0) in
+      ([1;2;3] = a) &&
+      ([] = b)
+  end;
+
+
+  test "fold-into-exception-from-of-seq" begin fun () ->
+    let fail = fun () -> failwith "XXX" in
+    let seq = fun () -> Seq.Cons (1, (fun () -> Seq.Cons (2, fail))) in
+    let a = Lwt_seq.of_seq seq in
+    let+ n =
+      Lwt.catch
+        (fun () -> Lwt_seq.fold_left (+) 0 a)
+        (function
+          | Failure x when x = "XXX" -> Lwt.return (-1)
+          | exc -> raise exc)
+    in
+    n = (-1)
+  end;
+
+  test "fold-into-immediate-exception-from-of-seq" begin fun () ->
+    let fail = fun () -> failwith "XXX" in
+    let seq = fail in
+    let a = Lwt_seq.of_seq seq in
+    let+ n =
+      Lwt.catch
+        (fun () -> Lwt_seq.fold_left (+) 0 a)
+        (function
+          | Failure x when x = "XXX" -> Lwt.return (-1)
+          | exc -> raise exc)
+    in
+    n = (-1)
+  end;
+
+  test "fold-into-exception-from-of-seq-lwt" begin fun () ->
+    let fail = fun () -> failwith "XXX" in
+    let seq: int Lwt.t Seq.t = fun () ->
+      Seq.Cons (Lwt.return 1,
+        fun () ->
+          Seq.Cons (Lwt.return 2, fail)) in
+    let a = Lwt_seq.of_seq_lwt seq in
+    let+ n =
+      Lwt.catch
+        (fun () -> Lwt_seq.fold_left (+) 0 a)
+        (function
+          | Failure x when x = "XXX" -> Lwt.return (-1)
+          | exc -> raise exc)
+    in
+    n = (-1)
+  end;
+
+  test "fold-into-immediate-exception-from-of-seq-lwt" begin fun () ->
+    let fail = fun () -> failwith "XXX" in
+    let seq: int Lwt.t Seq.t = fail in
+    let a = Lwt_seq.of_seq_lwt seq in
+    let+ n =
+      Lwt.catch
+        (fun () -> Lwt_seq.fold_left (+) 0 a)
+        (function
+          | Failure x when x = "XXX" -> Lwt.return (-1)
+          | exc -> raise exc)
+    in
+    n = (-1)
+  end;
+]
+
+let fs = [(+); (-); (fun x _ -> x); min; max]
+let ls = [
+   [];
+   l;
+   l@l@l;
+   List.rev l;
+   [0;0;0];
+   [max_int;0;min_int];
+   [max_int;max_int];
+]
+let cs = [0;1;max_int;min_int;44;5]
+let with_flc test =
+   Lwt_list.for_all_s
+     (fun f ->
+        Lwt_list.for_all_s
+          (fun l ->
+             Lwt_list.for_all_s
+               (fun c -> test f l c)
+               cs)
+          ls)
+     fs
+let equals l1 seq2 =
+   let* l2 = Lwt_seq.to_list seq2 in
+   Lwt.return (l1 = l2)
+let commutes lf sf l =
+   equals (lf l) (sf (Lwt_seq.of_list l))
+
+
+let suite_fuzzing = suite "lwt_seq(pseudo-fuzzing)" [
+
+  test "map" begin fun () ->
+     with_flc (fun f l c ->
+        let lf = List.map (fun x -> f x c) in
+        let sf = Lwt_seq.map (fun x -> f x c) in
+        commutes lf sf l
+     )
+  end;
+
+  test "map_s" begin fun () ->
+     with_flc (fun f l c ->
+        let lf = List.map (fun x -> f x c) in
+        let sf = Lwt_seq.map_s (fun x -> Lwt.return (f x c)) in
+        commutes lf sf l
+     )
+  end;
+
+  test "iter" begin fun () ->
+     with_flc (fun f l c ->
+        let lf l =
+           let r = ref c in
+           List.iter (fun x -> r := f !r x) l;
+           [!r] in
+        let sf s =
+           let r = ref c in
+           fun () ->
+             let* () = Lwt_seq.iter (fun x -> r := f !r x) s in
+             Lwt.return (Lwt_seq.Cons (!r, Lwt_seq.empty)) in
+        commutes lf sf l
+     )
+  end;
+
+  test "iter_s" begin fun () ->
+     with_flc (fun f l c ->
+        let lf l =
+           let r = ref c in
+           List.iter (fun x -> r := f !r x) l;
+           [!r] in
+        let sf s =
+           let r = ref c in
+           fun () ->
+             let* () = Lwt_seq.iter_s (fun x -> r := f !r x; Lwt.return_unit) s in
+             Lwt.return (Lwt_seq.Cons (!r, Lwt_seq.empty)) in
+        commutes lf sf l
+     )
+  end;
+
+  (* the [f]s commute sufficiently for parallel execution *)
+  test "iter_p" begin fun () ->
+     with_flc (fun f l c ->
+        let lf l =
+           let r = ref c in
+           List.iter (fun x -> r := f !r x) l;
+           [!r]
+        in
+        let sf s =
+           Lwt_seq.return_lwt @@
+           let r = ref c in
+           let+ () = Lwt_seq.iter_p (fun x -> r := f !r x; Lwt.return_unit) s in
+           !r
+        in
+        commutes lf sf l
+     )
+  end;
+
+  test "iter_p (pause)" begin fun () ->
+     with_flc (fun f l c ->
+        let lf l =
+           let r = ref c in
+           List.iter (fun x -> r := f !r x) l;
+           [!r]
+        in
+        let sf s =
+           Lwt_seq.return_lwt @@
+           let r = ref c in
+           let+ () =
+              Lwt_seq.iter_p
+                (fun x ->
+                   let* () = pause x in
+                   r := f !r x;
+                   pause x)
+                s
+           in
+           !r
+        in
+        commutes lf sf l
+     )
+  end;
+
+  test "iter_n" begin fun () ->
+     l |> Lwt_list.for_all_s @@ fun max_concurrency ->
+     with_flc (fun f l c ->
+        let lf l =
+           let r = ref c in
+           List.iter (fun x -> r := f !r x) l;
+           [!r] in
+        let sf s =
+           Lwt_seq.return_lwt @@
+           let r = ref c in
+           let+ () = Lwt_seq.iter_n ~max_concurrency (fun x -> r := f !r x; Lwt.return_unit) s in
+           !r
+        in
+        commutes lf sf l
+     )
+  end;
+
+  test "iter_n (pause)" begin fun () ->
+     l |> Lwt_list.for_all_s @@ fun max_concurrency ->
+     with_flc (fun f l c ->
+        let lf l =
+           let r = ref c in
+           List.iter (fun x -> r := f !r x) l;
+           [!r] in
+        let sf s =
+           Lwt_seq.return_lwt @@
+           let r = ref c in
+           let+ () =
+              Lwt_seq.iter_n ~max_concurrency
+                 (fun x ->
+                    let* () = pause x in
+                    r := f !r x;
+                    pause x)
+                 s
+           in
+           !r
+        in
+        commutes lf sf l
+     )
+  end;
+
+]

unikernel/duniverse/lwt/test/core/test_lwt_sequence.ml

@@ -0,0 +1,421 @@
+(* 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
+
+module Lwt_sequence = Lwt_sequence
+
+let filled_sequence () =
+  let s = Lwt_sequence.create () in
+  let _ = Lwt_sequence.add_r 1 s in
+  let _ = Lwt_sequence.add_r 2 s in
+  let _ = Lwt_sequence.add_r 3 s in
+  let _ = Lwt_sequence.add_r 4 s in
+  let _ = Lwt_sequence.add_r 5 s in
+  let _ = Lwt_sequence.add_r 6 s in
+  s
+
+let filled_length = 6
+
+let leftmost_value = 1
+
+let rightmost_value = 6
+
+let transfer_sequence () =
+  let s = Lwt_sequence.create () in
+  let _ = Lwt_sequence.add_r 7 s in
+  let _ = Lwt_sequence.add_r 8 s in
+  s
+
+let transfer_length = 2
+
+let empty_array = [||]
+
+let l_filled_array = [|1; 2; 3; 4; 5; 6|]
+
+let r_filled_array = [|6; 5; 4; 3; 2; 1|]
+
+let factorial_sequence = 720
+
+let test_iter iter_f array_values seq =
+  let index = ref 0 in
+  Lwt.catch
+   (fun () ->
+    iter_f (fun v ->
+              assert (v = array_values.(!index));
+              index := (!index + 1)) seq;
+    Lwt.return_true)
+   (function _ -> Lwt.return_false)
+
+let test_iter_node iter_f array_values seq =
+  let index = ref 0 in
+  Lwt.catch
+   (fun () ->
+    iter_f (fun n ->
+              assert ((Lwt_sequence.get n) = array_values.(!index));
+              index := (!index + 1)) seq;
+    Lwt.return_true)
+   (function _ -> Lwt.return_false)
+
+let test_iter_rem iter_f array_values seq =
+  let index = ref 0 in
+  Lwt.catch
+   (fun () ->
+    iter_f (fun n ->
+              assert ((Lwt_sequence.get n) = array_values.(!index));
+              Lwt_sequence.remove n;
+              index := (!index + 1)) seq;
+    Lwt.return_true)
+   (function _ -> Lwt.return_false)
+
+let suite = suite "lwt_sequence" [
+
+  test "create" begin fun () ->
+    let s = Lwt_sequence.create () in
+    let _ = assert (Lwt_sequence.is_empty s) in
+    let len = Lwt_sequence.length s in
+    Lwt.return (len = 0)
+  end;
+
+  test "add_l" begin fun () ->
+    let s = Lwt_sequence.create () in
+    let n = Lwt_sequence.add_l 1 s in
+    let _ = assert ((Lwt_sequence.get n) = 1) in
+    let len = Lwt_sequence.length s in
+    Lwt.return (len = 1)
+  end;
+
+  test "add_r" begin fun () ->
+    let s = Lwt_sequence.create () in
+    let n = Lwt_sequence.add_r 1 s in
+    let _ = assert ((Lwt_sequence.get n) = 1) in
+    let len = Lwt_sequence.length s in
+    Lwt.return (len = 1)
+  end;
+
+  test "take_l Empty" begin fun () ->
+    let s = Lwt_sequence.create () in
+    Lwt.catch
+      (fun () ->
+        let _ = Lwt_sequence.take_l s in
+        Lwt.return_false)
+      (function
+        | Lwt_sequence.Empty -> Lwt.return_true
+        | _ -> Lwt.return_false)
+  end;
+
+  test "take_l" begin fun () ->
+    let s = filled_sequence () in
+    Lwt.catch
+      (fun () ->
+        let v = Lwt_sequence.take_l s in
+        Lwt.return (leftmost_value = v))
+      (function _ -> Lwt.return_false)
+  end;
+
+  test "take_r Empty" begin fun () ->
+    let s = Lwt_sequence.create () in
+    Lwt.catch
+      (fun () ->
+        let _ = Lwt_sequence.take_r s in Lwt.return_false)
+      (function
+        | Lwt_sequence.Empty -> Lwt.return_true
+        | _ -> Lwt.return_false)
+  end;
+
+  test "take_r" begin fun () ->
+    let s = filled_sequence () in
+    Lwt.catch
+      (fun () ->
+        let v = Lwt_sequence.take_r s in Lwt.return (rightmost_value = v))
+      (function _ -> Lwt.return_false)
+  end;
+
+  test "take_opt_l Empty" begin fun () ->
+    let s = Lwt_sequence.create () in
+    match Lwt_sequence.take_opt_l s with
+    | None -> Lwt.return_true
+    | _ -> Lwt.return_false
+  end;
+
+  test "take_opt_l" begin fun () ->
+    let s = filled_sequence () in
+    match Lwt_sequence.take_opt_l s with
+    | None -> Lwt.return_false
+    | Some v -> Lwt.return (leftmost_value = v)
+  end;
+
+  test "take_opt_r Empty" begin fun () ->
+    let s = Lwt_sequence.create () in
+    match Lwt_sequence.take_opt_r s with
+    | None -> Lwt.return_true
+    | _ -> Lwt.return_false
+  end;
+
+  test "take_opt_r" begin fun () ->
+    let s = filled_sequence () in
+    match Lwt_sequence.take_opt_r s with
+    | None -> Lwt.return_false
+    | Some v -> Lwt.return (rightmost_value = v)
+  end;
+
+  test "transfer_l Empty" begin fun () ->
+    let s = filled_sequence () in
+    let ts = Lwt_sequence.create () in
+    let _ = Lwt_sequence.transfer_l ts s in
+    let len = Lwt_sequence.length s in
+    Lwt.return (filled_length = len)
+  end;
+
+  test "transfer_l " begin fun () ->
+    let s = filled_sequence () in
+    let ts = transfer_sequence () in
+    let _ = Lwt_sequence.transfer_l ts s in
+    let len = Lwt_sequence.length s in
+    let _ = assert ((filled_length + transfer_length) = len) in
+    match Lwt_sequence.take_opt_l s with
+    | None -> Lwt.return_false
+    | Some v -> Lwt.return (7 = v)
+  end;
+
+  test "transfer_r Empty" begin fun () ->
+    let s = filled_sequence () in
+    let ts = Lwt_sequence.create () in
+    let _ = Lwt_sequence.transfer_r ts s in
+    let len = Lwt_sequence.length s in
+    Lwt.return (filled_length = len)
+  end;
+
+  test "transfer_r " begin fun () ->
+    let s = filled_sequence () in
+    let ts = transfer_sequence () in
+    let _ = Lwt_sequence.transfer_r ts s in
+    let len = Lwt_sequence.length s in
+    let _ = assert ((filled_length + transfer_length) = len) in
+    match Lwt_sequence.take_opt_r s with
+    | None -> Lwt.return_false
+    | Some v -> Lwt.return (8 = v)
+  end;
+
+  test "iter_l Empty" begin fun () ->
+    test_iter Lwt_sequence.iter_l empty_array (Lwt_sequence.create ())
+  end;
+
+  test "iter_l" begin fun () ->
+    test_iter Lwt_sequence.iter_l l_filled_array (filled_sequence ())
+  end;
+
+  test "iter_r Empty" begin fun () ->
+    test_iter Lwt_sequence.iter_r empty_array (Lwt_sequence.create ())
+  end;
+
+  test "iter_r" begin fun () ->
+    test_iter Lwt_sequence.iter_r r_filled_array (filled_sequence ())
+  end;
+
+  test "iter_node_l Empty" begin fun () ->
+    test_iter_node Lwt_sequence.iter_node_l empty_array (Lwt_sequence.create ())
+  end;
+
+  test "iter_node_l" begin fun () ->
+    test_iter_node Lwt_sequence.iter_node_l l_filled_array (filled_sequence ())
+  end;
+
+  test "iter_node_r Empty" begin fun () ->
+    test_iter_node Lwt_sequence.iter_node_r empty_array (Lwt_sequence.create ())
+  end;
+
+  test "iter_node_r" begin fun () ->
+    test_iter_node Lwt_sequence.iter_node_r r_filled_array (filled_sequence ())
+  end;
+
+  test "iter_node_l with removal" begin fun () ->
+    test_iter_rem Lwt_sequence.iter_node_l l_filled_array (filled_sequence ())
+  end;
+
+  test "iter_node_r with removal" begin fun () ->
+    test_iter_rem Lwt_sequence.iter_node_r r_filled_array (filled_sequence ())
+  end;
+
+  test "fold_l" begin fun () ->
+    let acc = Lwt_sequence.fold_l (fun v e -> v * e) (filled_sequence ()) 1 in
+    Lwt.return (factorial_sequence = acc)
+  end;
+
+  test "fold_l Empty" begin fun () ->
+    let acc = Lwt_sequence.fold_l (fun v e -> v * e) (Lwt_sequence.create ()) 1 in
+    Lwt.return (acc = 1)
+  end;
+
+  test "fold_r" begin fun () ->
+    let acc = Lwt_sequence.fold_r (fun v e -> v * e) (filled_sequence ()) 1 in
+    Lwt.return (factorial_sequence = acc)
+  end;
+
+  test "fold_r Empty" begin fun () ->
+    let acc = Lwt_sequence.fold_r (fun v e -> v * e) (Lwt_sequence.create ()) 1 in
+    Lwt.return (acc = 1)
+  end;
+
+  test "find_node_opt_l Empty" begin fun () ->
+    let s = Lwt_sequence.create () in
+    match Lwt_sequence.find_node_opt_l (fun v -> v = 1) s with
+    | None -> Lwt.return_true
+    | _ -> Lwt.return_false
+  end;
+
+  test "find_node_opt_l not found " begin fun () ->
+    let s = transfer_sequence () in
+    match Lwt_sequence.find_node_opt_l (fun v -> v = 1) s with
+    | None -> Lwt.return_true
+    | _ -> Lwt.return_false
+  end;
+
+  test "find_node_opt_l" begin fun () ->
+    let s = filled_sequence () in
+    match Lwt_sequence.find_node_opt_l (fun v -> v = 1) s with
+    | None -> Lwt.return_false
+    | Some n -> if ((Lwt_sequence.get n) = 1) then Lwt.return_true
+      else Lwt.return_false
+  end;
+
+  test "find_node_opt_r Empty" begin fun () ->
+    let s = Lwt_sequence.create () in
+    match Lwt_sequence.find_node_opt_r (fun v -> v = 1) s with
+    | None -> Lwt.return_true
+    | _ -> Lwt.return_false
+  end;
+
+  test "find_node_opt_r not found " begin fun () ->
+    let s = transfer_sequence () in
+    match Lwt_sequence.find_node_opt_r (fun v -> v = 1) s with
+    | None -> Lwt.return_true
+    | _ -> Lwt.return_false
+  end;
+
+  test "find_node_opt_r" begin fun () ->
+    let s = filled_sequence () in
+    match Lwt_sequence.find_node_opt_r (fun v -> v = 1) s with
+    | None -> Lwt.return_false
+    | Some n -> if ((Lwt_sequence.get n) = 1) then Lwt.return_true
+      else Lwt.return_false
+  end;
+
+  test "find_node_l Empty" begin fun () ->
+    let s = Lwt_sequence.create () in
+    Lwt.catch
+    (fun () -> let n = Lwt_sequence.find_node_l (fun v -> v = 1) s in
+       if ((Lwt_sequence.get n) = 1) then Lwt.return_false
+       else Lwt.return_false)
+    (function
+      | Not_found -> Lwt.return_true
+      | _ -> Lwt.return_false)
+  end;
+
+  test "find_node_l" begin fun () ->
+    let s = filled_sequence () in
+    Lwt.catch
+    (fun () -> let n = Lwt_sequence.find_node_l (fun v -> v = 1) s in
+       if ((Lwt_sequence.get n) = 1) then Lwt.return_true
+       else Lwt.return_false)
+    (function _ -> Lwt.return_false)
+  end;
+
+  test "find_node_r Empty" begin fun () ->
+    let s = Lwt_sequence.create () in
+    Lwt.catch
+    (fun () -> let n = Lwt_sequence.find_node_r (fun v -> v = 1) s in
+       if ((Lwt_sequence.get n) = 1) then Lwt.return_false
+       else Lwt.return_false)
+    (function
+      | Not_found -> Lwt.return_true
+      | _ -> Lwt.return_false)
+  end;
+
+  test "find_node_r" begin fun () ->
+    let s = filled_sequence () in
+    Lwt.catch
+    (fun () -> let n = Lwt_sequence.find_node_r (fun v -> v = 1) s in
+       if ((Lwt_sequence.get n) = 1) then Lwt.return_true
+       else Lwt.return_false)
+    (function _ -> Lwt.return_false)
+  end;
+
+  test "set" begin fun () ->
+    let s = filled_sequence () in
+    match Lwt_sequence.find_node_opt_l (fun v -> v = 4) s with
+    | None -> Lwt.return_false
+    | Some n -> let _ = Lwt_sequence.set n 10 in
+      let data = [|1; 2; 3; 10; 5; 6|] in
+      test_iter Lwt_sequence.iter_l data s
+  end;
+
+  test "fold_r with multiple removal" begin fun () ->
+    let s = filled_sequence () in
+    let n_three = Lwt_sequence.find_node_r (fun v' -> v' = 3) s in
+    let n_two = Lwt_sequence.find_node_r (fun v' -> v' = 2) s in
+    let n_four = Lwt_sequence.find_node_r (fun v' -> v' = 4) s in
+    let acc = Lwt_sequence.fold_r begin fun v e ->
+      if v = 3 then begin
+         let _ = Lwt_sequence.remove n_three in
+         let _ = Lwt_sequence.remove n_two in
+         ignore(Lwt_sequence.remove n_four)
+      end;
+      v * e
+    end s 1 in
+    Lwt.return (acc = (factorial_sequence / 2))
+  end;
+
+  test "fold_l multiple removal" begin fun () ->
+   let s = filled_sequence () in
+   let n_four = Lwt_sequence.find_node_r (fun v' -> v' = 4) s in
+   let n_five = Lwt_sequence.find_node_r (fun v' -> v' = 5) s in
+   let n_three = Lwt_sequence.find_node_r (fun v' -> v' = 3) s in
+   let acc = Lwt_sequence.fold_l begin fun v e ->
+      if v = 4 then begin
+         let _ = Lwt_sequence.remove n_four in
+         let _ = Lwt_sequence.remove n_five in
+         ignore(Lwt_sequence.remove n_three)
+      end;
+      v * e
+   end s 1 in
+    Lwt.return (acc = (factorial_sequence / 5))
+  end;
+
+  test "find_node_r with multiple removal" begin fun () ->
+    let s = filled_sequence () in
+    let n_three = Lwt_sequence.find_node_r (fun v' -> v' = 3) s in
+    let n_two = Lwt_sequence.find_node_r (fun v' -> v' = 2) s in
+    Lwt.catch
+    begin fun () ->
+      let n = Lwt_sequence.find_node_r begin fun v ->
+        if v = 3 then (
+          let _ = Lwt_sequence.remove n_three in
+          ignore(Lwt_sequence.remove n_two));
+        v = 1
+       end s in
+      let v = Lwt_sequence.get n in
+      Lwt.return (v = 1)
+    end
+    (function _ -> Lwt.return_false)
+  end;
+
+  test "find_node_l with multiple removal" begin fun () ->
+    let s = filled_sequence () in
+    let n_three = Lwt_sequence.find_node_r (fun v' -> v' = 3) s in
+    let n_four = Lwt_sequence.find_node_r (fun v' -> v' = 4) s in
+    Lwt.catch
+    begin fun () ->
+      let n = Lwt_sequence.find_node_l begin fun v ->
+        if v = 3 then (
+          let _ = Lwt_sequence.remove n_three in
+          ignore(Lwt_sequence.remove n_four));
+        v = 6 end s in
+      let v = Lwt_sequence.get n in
+      Lwt.return (v = 6)
+    end
+    (function _ -> Lwt.return_false)
+  end;
+]

unikernel/duniverse/lwt/test/core/test_lwt_stream.ml

@@ -0,0 +1,517 @@
+(* 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
+open Test
+
+let expect_exit f =
+  Lwt.catch
+    (fun () ->
+      f () >>= fun _ ->
+      Lwt.return_false)
+    (function
+      | Exit -> Lwt.return_true
+      | e -> Lwt.reraise e)
+
+let suite = suite "lwt_stream" [
+  test "from"
+    (fun () ->
+       let mvar = Lwt_mvar.create_empty () in
+       let stream = Lwt_stream.from (fun () ->
+                                       Lwt_mvar.take mvar >>= fun x ->
+                                       return (Some x)) in
+       let t1 = Lwt_stream.next stream in
+       let t2 = Lwt_stream.next stream in
+       let t3 = Lwt_stream.next stream in
+       Lwt_mvar.put mvar 1 >>= fun () ->
+       t1 >>= fun x1 ->
+       t2 >>= fun x2 ->
+       t3 >>= fun x3 ->
+       return ([x1; x2; x3] = [1; 1; 1]));
+
+  test "return"
+    (fun () ->
+       let stream = Lwt_stream.return 123 in
+       if Lwt_stream.is_closed stream then
+         Lwt_stream.next stream >>= fun x -> return (x = 123)
+       else
+         Lwt.return_false);
+
+  test "return_lwt"
+    (fun () ->
+       let lwt = Lwt.return 123 in
+       let stream = Lwt_stream.return_lwt lwt in
+       Lwt_stream.next stream >>= fun x ->
+       return (x = 123 && Lwt_stream.is_closed stream));
+
+  test "return_lwt_with_pause"
+    (fun () ->
+       let lwt = Lwt.pause () >>= fun () -> Lwt.return 123 in
+       let stream = Lwt_stream.return_lwt lwt in
+       Lwt_stream.next stream >>= fun x ->
+       return (x = 123 && Lwt_stream.is_closed stream));
+
+  test "return_lwt_with_fail"
+    (fun () ->
+       let lwt = Lwt.pause () >>= fun () -> raise (Failure "not today no") in
+       let stream = Lwt_stream.return_lwt lwt in
+       Lwt.catch
+         (fun () ->
+           Lwt_stream.next stream >>= fun _ ->
+           Lwt.return_false)
+         (function
+           | Lwt_stream.Empty -> Lwt.return_true
+           | exc -> raise exc));
+
+  test "of_seq"
+    (fun () ->
+       let x = ref false in
+       let nil = fun () -> x := not !x; Seq.Nil in
+       let seq = fun () -> Seq.Cons (1, nil) in
+       let stream = Lwt_stream.of_seq seq in
+       let x_before = !x in
+       let closed_before = Lwt_stream.is_closed stream in
+       Lwt_stream.get stream >>= fun x1 ->
+       let x_middle = !x in
+       Lwt_stream.get stream >>= fun x2 ->
+       let x_after = !x in
+       let closed_after = Lwt_stream.is_closed stream in
+       return ([closed_before; closed_after] = [false; true]
+               && [x_before; x_middle; x_after] = [false; false; true]
+               && [x1; x2] = [Some 1; None]));
+
+  test "of_lwt_seq"
+    (fun () ->
+       let x = ref false in
+       let nil = fun () -> Lwt.pause () >|= fun () -> x := not !x; Lwt_seq.Nil in
+       let seq = fun () -> Lwt.pause () >|= fun () -> Lwt_seq.Cons (1, nil) in
+       let stream = Lwt_stream.of_lwt_seq seq in
+       let x_before = !x in
+       let closed_before = Lwt_stream.is_closed stream in
+       Lwt_stream.get stream >>= fun x1 ->
+       let x_middle = !x in
+       Lwt_stream.get stream >>= fun x2 ->
+       let x_after = !x in
+       let closed_after = Lwt_stream.is_closed stream in
+       return ([closed_before; closed_after] = [false; true]
+               && [x_before; x_middle; x_after] = [false; false; true]
+               && [x1; x2] = [Some 1; None]));
+
+  test "of_list"
+    (fun () ->
+       let stream = Lwt_stream.of_list [1; 2; 3] in
+       Lwt_stream.next stream >>= fun x1 ->
+       Lwt_stream.next stream >>= fun x2 ->
+       Lwt_stream.next stream >>= fun x3 ->
+       return ([x1; x2; x3] = [1; 2; 3]));
+
+  test "clone"
+    (fun () ->
+       let stream1 = Lwt_stream.of_list [1; 2; 3] in
+       let stream2 = Lwt_stream.clone stream1 in
+       Lwt_stream.next stream1 >>= fun x1_1 ->
+       Lwt_stream.next stream2 >>= fun x2_1 ->
+       Lwt_stream.next stream1 >>= fun x1_2 ->
+       Lwt_stream.next stream1 >>= fun x1_3 ->
+       Lwt_stream.next stream2 >>= fun x2_2 ->
+       Lwt_stream.next stream2 >>= fun x2_3 ->
+       return ([x1_1; x1_2; x1_3] = [1; 2; 3] && [x2_1; x2_2; x2_3] = [1; 2; 3]));
+
+  test "clone 2"
+    (fun () ->
+       let stream1, push = Lwt_stream.create () in
+       push (Some 1);
+       let stream2 = Lwt_stream.clone stream1 in
+       let x1_1 = poll (Lwt_stream.next stream1) in
+       let x1_2 = poll (Lwt_stream.next stream1) in
+       let x2_1 = poll (Lwt_stream.next stream2) in
+       let x2_2 = poll (Lwt_stream.next stream2) in
+       return ([x1_1;x1_2;x2_1;x2_2] = [Some 1;None;Some 1;None]));
+
+  test "create"
+    (fun () ->
+       let stream, push = Lwt_stream.create () in
+       push (Some 1);
+       push (Some 2);
+       push (Some 3);
+       push None;
+       Lwt_stream.to_list stream >>= fun l ->
+       return (l = [1; 2; 3]));
+
+  test "create 2"
+    (fun () ->
+       let stream, push = Lwt_stream.create () in
+       push None;
+       let t = Lwt_stream.next stream in
+       return (Lwt.state t = Fail Lwt_stream.Empty));
+
+  test "create_bounded"
+    (fun () ->
+       let stream, push = Lwt_stream.create_bounded 3 in
+       let acc = true in
+       let acc = acc && state (push#push 1) = Return () in
+       let acc = acc && state (push#push 2) = Return () in
+       let acc = acc && state (push#push 3) = Return () in
+       let t = push#push 4 in
+       let acc = acc && state t = Sleep in
+       let acc = acc && state (push#push 5) = Fail Lwt_stream.Full in
+       let acc = acc && state (push#push 6) = Fail Lwt_stream.Full in
+       let acc = acc && state (Lwt_stream.get stream) = Return (Some 1) in
+       (* Lwt_stream uses wakeup_later so we have to wait a bit. *)
+       Lwt.pause () >>= fun () ->
+       let acc = acc && state t = Return () in
+       let acc = acc && state (Lwt_stream.get stream) = Return (Some 2) in
+       let acc = acc && state (push#push 7) = Return () in
+       push#close;
+       let acc = acc && state (push#push 8) = Fail Lwt_stream.Closed in
+       let acc = acc && state (Lwt_stream.to_list stream) = Return [3; 4; 7] in
+       return acc);
+
+  test "create_bounded close"
+    (fun () ->
+       let stream, push = Lwt_stream.create_bounded 1 in
+       let acc = true in
+       let acc = acc && state (push#push 1) = Return () in
+       let iter_delayed = Lwt_stream.to_list stream in
+       Lwt.pause () >>= fun () ->
+       push#close;
+       Lwt.pause () >>= fun () ->
+       let acc = acc && state iter_delayed = Return [1] in
+       return acc
+    );
+
+  test "get_while"
+    (fun () ->
+       let stream = Lwt_stream.of_list [1; 2; 3; 4; 5] in
+       Lwt_stream.get_while (fun x -> x < 3) stream >>= fun l1 ->
+       Lwt_stream.to_list stream >>= fun l2 ->
+       return (l1 = [1; 2] && l2 = [3; 4; 5]));
+
+  test "peek"
+    (fun () ->
+       let stream = Lwt_stream.of_list [1; 2; 3; 4; 5] in
+       Lwt_stream.peek stream >>= fun x ->
+       Lwt_stream.peek stream >>= fun y ->
+       Lwt_stream.to_list stream >>= fun l ->
+       return (x = Some 1 && y = Some 1 && l = [1; 2; 3; 4; 5]));
+
+  test "npeek"
+    (fun () ->
+       let stream = Lwt_stream.of_list [1; 2; 3; 4; 5] in
+       Lwt_stream.npeek 3 stream >>= fun x ->
+       Lwt_stream.npeek 1 stream >>= fun y ->
+       Lwt_stream.to_list stream >>= fun l ->
+       return (x = [1; 2; 3] && y = [1] && l = [1; 2; 3; 4; 5]));
+
+  test "get_available"
+    (fun () ->
+       let stream, push = Lwt_stream.create () in
+       push (Some 1);
+       push (Some 2);
+       push (Some 3);
+       let l = Lwt_stream.get_available stream in
+       push (Some 4);
+       Lwt_stream.get stream >>= fun x ->
+       return (l = [1; 2; 3] && x = Some 4));
+
+  test "get_available_up_to"
+    (fun () ->
+       let stream, push = Lwt_stream.create () in
+       push (Some 1);
+       push (Some 2);
+       push (Some 3);
+       push (Some 4);
+       let l = Lwt_stream.get_available_up_to 2 stream in
+       Lwt_stream.get stream >>= fun x ->
+       return (l = [1; 2] && x = Some 3));
+
+  test "filter"
+    (fun () ->
+       let stream, push = Lwt_stream.create () in
+       push (Some 1);
+       push (Some 2);
+       push (Some 3);
+       push (Some 4);
+       let filtered = Lwt_stream.filter ((=) 3) stream in
+       Lwt_stream.get filtered >>= fun x ->
+       let l = Lwt_stream.get_available filtered in
+       return (x = Some 3 && l = []));
+
+  test "filter_map"
+    (fun () ->
+       let stream, push = Lwt_stream.create () in
+       push (Some 1);
+       push (Some 2);
+       push (Some 3);
+       push (Some 4);
+       let filtered = Lwt_stream.filter_map (function 3 ->  Some "3" | _ -> None ) stream in
+       Lwt_stream.get filtered >>= fun x ->
+       let l = Lwt_stream.get_available filtered in
+       return (x = Some "3" && l = []));
+
+  test "last_new"
+    (fun () ->
+       let stream, push = Lwt_stream.create () in
+       push (Some 1);
+       push (Some 2);
+       push (Some 3);
+       Lwt_stream.last_new stream >>= fun x ->
+       return (x = 3));
+
+  test_direct "junk_available"
+    (fun () ->
+      let s, push = Lwt_stream.create () in
+      let b0 = Lwt_stream.get_available s = [] in
+      let () = Lwt_stream.junk_available s in
+      let b1 = Lwt_stream.get_available s = [] in
+      let () = push (Some 1); push (Some 2); push (Some 4) in
+      let () = Lwt_stream.junk_available s in
+      let b2 = Lwt_stream.get_available s = [] in
+      let () = push (Some 66); push (Some 77); push (Some 99) in
+      let () = Lwt_stream.junk_available s in
+      let b3 = Lwt_stream.get_available s = [] in
+      b0 && b1 && b2 && b3);
+
+  test "junk_old"
+    (fun () ->
+      let open Lwt.Syntax in
+      let s, push = Lwt_stream.create () in
+      let b0 = Lwt_stream.get_available s = [] in
+      let* () = Lwt_stream.junk_old s in
+      let b1 = Lwt_stream.get_available s = [] in
+      let () = push (Some 1); push (Some 2); push (Some 4) in
+      let* () = Lwt_stream.junk_old s in
+      let b2 = Lwt_stream.get_available s = [] in
+      let () = push (Some 66); push (Some 77); push (Some 99) in
+      let* () = Lwt_stream.junk_old s in
+      let b3 = Lwt_stream.get_available s = [] in
+      Lwt.return (b0 && b1 && b2 && b3))
+      [@ocaml.alert "-deprecated"];
+
+  test "cancel push stream 1"
+    (fun () ->
+       let stream, _ = Lwt_stream.create () in
+       let t = Lwt_stream.next stream in
+       cancel t;
+       return (state t = Fail Canceled));
+
+  test "cancel push stream 2"
+    (fun () ->
+       let stream, push = Lwt_stream.create () in
+       let t = Lwt_stream.next stream in
+       cancel t;
+       push (Some 1);
+       let t' = Lwt_stream.next stream in
+       return (state t' = Return 1));
+
+  test "cancel push stream 3"
+    (fun () ->
+       let stream, push = Lwt_stream.create () in
+       let t1 = Lwt_stream.next stream in
+       let t2 = Lwt_stream.next stream in
+       cancel t1;
+       push (Some 1);
+       t2 >>= fun t2_value ->
+       return (state t1 = Fail Canceled && t2_value = 1));
+
+  (* check if the push function keeps references to the elements in
+     the stream *)
+  test "push and GC"
+    (fun () ->
+       let w = Weak.create 5 in
+       (* Count the number of reachable elements in the stream. *)
+       let count () =
+         let rec loop acc idx =
+           if idx = Weak.length w then
+             acc
+           else
+             match Weak.get w idx with
+               | None -> loop acc (idx + 1)
+               | Some _ -> loop (acc + 1) (idx + 1)
+         in
+         loop 0 0
+       in
+       (* Run some test and return the push function of the stream. *)
+       let test () =
+         let stream, push = Lwt_stream.create () in
+         assert (count () = 0);
+         let r1 = Some(ref 1) in
+         push r1;
+         Weak.set w 1 r1;
+         let r2 = Some(ref 2) in
+         push r2;
+         Weak.set w 2 r2;
+         let r3 = Some(ref 3) in
+         push r3;
+         Weak.set w 3 r3;
+         assert (count () = 3);
+         assert (state (Lwt_stream.next stream) = Return {contents = 1});
+         Gc.full_major ();
+         (* Ocaml can consider that stream is unreachable before the
+            next line, hence freeing the whole data. *)
+         assert (count () <= 3);
+         push
+       in
+       let push = test () in
+       Gc.full_major ();
+       (* At this point [stream] is unreachable. *)
+       assert (count () = 0);
+       (* We have that to force caml to keep a reference on [push]. *)
+       push (Some(ref 4));
+       return true);
+
+  test "map_exn"
+    (fun () ->
+       let l =
+         [Result.Ok 1;
+          Result.Error Exit;
+          Result.Error (Failure "plop");
+          Result.Ok 42;
+          Result.Error End_of_file]
+       in
+       let q = ref l in
+       let stream =
+         Lwt_stream.from
+           (fun () ->
+              match !q with
+                | [] ->
+                    return None
+                | (Result.Ok x)::l ->
+                    q := l;
+                    return (Some x)
+                | (Result.Error e)::l ->
+                    q := l;
+                    raise e)
+       in
+       Lwt_stream.to_list (Lwt_stream.wrap_exn stream) >>= fun l' ->
+       return (l = l'));
+
+  test "is_closed"
+    (fun () ->
+      let b1 = Lwt_stream.(is_closed (of_list [])) in
+      let b2 = Lwt_stream.(is_closed (of_list [1;2;3])) in
+      let b3 = Lwt_stream.(is_closed (of_array [||])) in
+      let b4 = Lwt_stream.(is_closed (of_array [|1;2;3;|])) in
+      let b5 = Lwt_stream.(is_closed (of_string "")) in
+      let b6 = Lwt_stream.(is_closed (of_string "123")) in
+      let b7 = Lwt_stream.(is_closed (from_direct (fun () -> Some 1))) in
+      let st = Lwt_stream.from_direct (fun () -> None) in
+      let b8 = Lwt_stream.is_closed st in
+      ignore (Lwt_stream.junk st);
+      let b9 = Lwt_stream.is_closed st in
+      return (b1 && b2 && b3 && b4 && b5 && b6 && not b7 && not b8 && b9));
+
+  test "closed(bind)"
+    (fun () ->
+      let st = Lwt_stream.from_direct (
+        let value = ref (Some 1) in
+        fun () -> let r = !value in value := None; r)
+      in
+      let b = ref false in
+      Lwt.async (fun () ->
+        Lwt_stream.closed st >|= fun () -> b := Lwt_stream.is_closed st);
+      ignore (Lwt_stream.peek st);
+      let b1 = !b = false in
+      ignore (Lwt_stream.junk st);
+      ignore (Lwt_stream.peek st);
+      let b2 = !b = true in
+      return (b1 && b2));
+
+  test "closed(on_termination)"
+    (fun () ->
+      let st = Lwt_stream.from_direct (
+        let value = ref (Some 1) in
+        fun () -> let r = !value in value := None; r)
+      in
+      let b = ref false in
+      (Lwt.on_termination (Lwt_stream.closed st) (fun () -> b := true));
+      ignore (Lwt_stream.peek st);
+      let b1 = !b = false in
+      ignore (Lwt_stream.junk st);
+      ignore (Lwt_stream.peek st);
+      let b2 = !b = true in
+      let b3 = Lwt_stream.is_closed st in
+      Lwt.return (b1 && b2 && b3));
+
+  test "closed when closed"
+    (fun () ->
+      let st = Lwt_stream.of_list [] in
+      let b = ref false in
+      let b1 = Lwt_stream.is_closed st in
+      (Lwt.on_termination (Lwt_stream.closed st) (fun () -> b := true));
+      Lwt.return (b1 && !b));
+
+  test "choose_exhausted"
+    (fun () ->
+      let open! Lwt_stream in
+      to_list (choose [of_list []]) >|= fun _ -> true);
+
+  test "exception passing: basic, from"
+    (fun () ->
+      let stream = Lwt_stream.from (fun () -> raise Exit) in
+      expect_exit (fun () -> Lwt_stream.get stream));
+
+  test "exception passing: basic, from_direct"
+    (fun () ->
+      let stream = Lwt_stream.from_direct (fun () -> raise Exit) in
+      expect_exit (fun () -> Lwt_stream.get stream));
+
+  test "exception passing: to_list"
+    (fun () ->
+      let stream = Lwt_stream.from (fun () -> raise Exit) in
+      expect_exit (fun () -> Lwt_stream.to_list stream));
+
+  test "exception passing: mapped"
+    (fun () ->
+      let stream = Lwt_stream.from (fun () -> raise Exit) in
+      let stream = Lwt_stream.map (fun v -> v) stream in
+      expect_exit (fun () -> Lwt_stream.get stream));
+
+  test "exception passing: resume, not closed, from"
+    (fun () ->
+      let to_feed = ref (Lwt.fail Exit) in
+      let stream = Lwt_stream.from (fun () -> !to_feed) in
+
+      expect_exit (fun () -> Lwt_stream.get stream) >>= fun got_exit ->
+      let closed_after_exit = Lwt_stream.is_closed stream in
+
+      to_feed := Lwt.return (Some 0);
+      Lwt_stream.get stream >>= fun v ->
+      let got_zero = (v = Some 0) in
+
+      to_feed := Lwt.return_none;
+      Lwt_stream.get stream >>= fun v ->
+      let got_none = (v = None) in
+      let closed_at_end = Lwt_stream.is_closed stream in
+
+      Lwt.return
+        (got_exit &&
+         not closed_after_exit &&
+         got_zero &&
+         got_none &&
+         closed_at_end));
+
+  test "exception passing: resume, not closed, from_direct"
+    (fun () ->
+      let to_feed = ref (fun () -> raise Exit) in
+      let stream = Lwt_stream.from_direct (fun () -> !to_feed ()) in
+
+      expect_exit (fun () -> Lwt_stream.get stream) >>= fun got_exit ->
+      let closed_after_exit = Lwt_stream.is_closed stream in
+
+      to_feed := (fun () -> Some 0);
+      Lwt_stream.get stream >>= fun v ->
+      let got_zero = (v = Some 0) in
+
+      to_feed := (fun () -> None);
+      Lwt_stream.get stream >>= fun v ->
+      let got_none = (v = None) in
+      let closed_at_end = Lwt_stream.is_closed stream in
+
+      Lwt.return
+        (got_exit &&
+         not closed_after_exit &&
+         got_zero &&
+         got_none &&
+         closed_at_end));
+]

unikernel/duniverse/lwt/test/core/test_lwt_switch.ml

@@ -0,0 +1,180 @@
+(* 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 suite = suite "lwt_switch" [
+  test "turn_off, add_hook"
+    (fun () ->
+      let hook_1_calls = ref 0 in
+      let hook_2_calls = ref 0 in
+
+      let hook call_counter () =
+        call_counter := !call_counter + 1;
+        Lwt.return_unit
+      in
+
+      let switch = Lwt_switch.create () in
+      Lwt_switch.add_hook (Some switch) (hook hook_1_calls);
+      Lwt_switch.add_hook (Some switch) (hook hook_2_calls);
+
+      let check_1 = !hook_1_calls = 0 in
+      let check_2 = !hook_2_calls = 0 in
+
+      Lwt_switch.turn_off switch >>= fun () ->
+
+      let check_3 = !hook_1_calls = 1 in
+      let check_4 = !hook_2_calls = 1 in
+
+      Lwt_switch.turn_off switch >|= fun () ->
+
+      let check_5 = !hook_1_calls = 1 in
+      let check_6 = !hook_2_calls = 1 in
+
+      let check_7 =
+        try
+          Lwt_switch.add_hook (Some switch) (fun () -> Lwt.return_unit);
+          false
+        with Lwt_switch.Off ->
+          true
+      in
+
+      check_1 && check_2 && check_3 && check_4 && check_5 && check_6 &&
+        check_7);
+
+  test "turn_off: hook exception"
+    (fun () ->
+      let hook () = raise Exit in
+
+      let switch = Lwt_switch.create () in
+      Lwt_switch.add_hook (Some switch) hook;
+
+      Lwt.catch
+        (fun () -> Lwt_switch.turn_off switch >|= fun () -> false)
+        (function
+        | Exit -> Lwt.return_true
+        | _ -> Lwt.return_false));
+
+  test "with_switch: regular exit"
+    (fun () ->
+      let hook_called = ref false in
+
+      Lwt_switch.with_switch (fun switch ->
+        Lwt_switch.add_hook (Some switch) (fun () ->
+          hook_called := true;
+          Lwt.return_unit);
+
+        Lwt.return_unit)
+
+      >|= fun () -> !hook_called);
+
+  test "with_switch: exception"
+    (fun () ->
+      let hook_called = ref false in
+      let exception_caught = ref false in
+
+      Lwt.catch
+        (fun () ->
+          Lwt_switch.with_switch (fun switch ->
+            Lwt_switch.add_hook (Some switch) (fun () ->
+              hook_called := true;
+              Lwt.return_unit);
+
+            raise Exit))
+        (function
+        | Exit ->
+          exception_caught := true;
+          Lwt.return_unit
+        | _ ->
+          Lwt.return_unit)
+
+      >|= fun () -> !hook_called && !exception_caught);
+
+  test "check"
+    (fun () ->
+      Lwt_switch.check None;
+
+      let switch = Lwt_switch.create () in
+      Lwt_switch.check (Some switch);
+
+      Lwt_switch.turn_off switch >|= fun () ->
+      try Lwt_switch.check (Some switch); false
+      with Lwt_switch.Off -> true);
+
+  test "is_on"
+    (fun () ->
+      let switch = Lwt_switch.create () in
+      let check_1 = Lwt_switch.is_on switch in
+      Lwt_switch.turn_off switch >|= fun () ->
+      let check_2 = not (Lwt_switch.is_on switch) in
+      check_1 && check_2);
+
+  test "add_hook_or_exec"
+    (fun () ->
+      let hook_calls = ref 0 in
+
+      let hook () =
+        hook_calls := !hook_calls + 1;
+        Lwt.return_unit
+      in
+
+      Lwt_switch.add_hook_or_exec None hook >>= fun () ->
+      let check_1 = !hook_calls = 0 in
+
+      let switch = Lwt_switch.create () in
+      Lwt_switch.add_hook_or_exec (Some switch) hook >>= fun () ->
+      let check_2 = !hook_calls = 0 in
+
+      Lwt_switch.turn_off switch >>= fun () ->
+      let check_3 = !hook_calls = 1 in
+
+      Lwt_switch.add_hook_or_exec (Some switch) hook >|= fun () ->
+      let check_4 = !hook_calls = 2 in
+
+      check_1 && check_2 && check_3 && check_4);
+
+  test "turn_off waits for hooks: regular exit"
+    (fun () ->
+      let hooks_finished = ref 0 in
+
+      let hook () =
+        Lwt.pause () >>= fun () ->
+        hooks_finished := !hooks_finished + 1;
+        Lwt.return_unit
+      in
+
+      let switch = Lwt_switch.create () in
+      Lwt_switch.add_hook (Some switch) hook;
+      Lwt_switch.add_hook (Some switch) hook;
+
+      Lwt_switch.turn_off switch >|= fun () ->
+      !hooks_finished = 2);
+
+  test "turn_off waits for hooks: hook exception"
+    (fun () ->
+      let hooks_finished = ref 0 in
+
+      let successful_hook () =
+        Lwt.pause () >>= fun () ->
+        hooks_finished := !hooks_finished + 1;
+        Lwt.return_unit
+      in
+
+      let failing_hook () =
+        hooks_finished := !hooks_finished + 1;
+        raise Exit
+      in
+
+      let switch = Lwt_switch.create () in
+      Lwt_switch.add_hook (Some switch) successful_hook;
+      Lwt_switch.add_hook (Some switch) failing_hook;
+      Lwt_switch.add_hook (Some switch) successful_hook;
+
+      Lwt.catch
+        (fun () -> Lwt_switch.turn_off switch)
+        (fun _ -> Lwt.return_unit) >|= fun () ->
+      !hooks_finished = 3);
+]

unikernel/duniverse/lwt/test/dune

@@ -0,0 +1,4 @@
+(library
+ (name lwttester)
+ (wrapped false)
+ (libraries lwt unix lwt.unix))

unikernel/duniverse/lwt/test/ppx/dune

@@ -0,0 +1,6 @@
+(test
+ (name main)
+ (package lwt_ppx)
+ (libraries lwttester)
+ (preprocess
+  (pps lwt_ppx)))

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

@@ -0,0 +1,167 @@
+open Test
+open Lwt
+
+(* Used for the "structure let" test, below. This is wrapped up by the PPX in a
+   call to Lwt_main.run, which is executed at module load time. We can't use a
+   local module inside the tester function, because that function is run inside
+   an outer call to Lwt_main.run, and nested calls to Lwt_main.run are not
+   allowed. *)
+[@@@ocaml.warning "-22"]
+let%lwt structure_let_result = Lwt.return_true
+[@@@ocaml.warning "+22"]
+
+let suite = suite "ppx" [
+  test "let"
+    (fun () ->
+       let%lwt x = return 3 in
+       return (x + 1 = 4)
+    ) ;
+
+  test "nested let"
+    (fun () ->
+       let%lwt x = return 3 in
+       let%lwt y = return 4 in
+       return (x + y = 7)
+    ) ;
+
+  test "and let"
+    (fun () ->
+       let%lwt x = return 3
+       and y = return 4 in
+       return (x + y = 7)
+    ) ;
+
+  test "match"
+    (fun () ->
+       let x = Lwt.return (Some 3) in
+       match%lwt x with
+       | Some x -> return (x + 1 = 4)
+       | None -> return false
+    ) ;
+
+  test "match-exn"
+    (fun () ->
+       let x = Lwt.return (Some 3) in
+       let x' = Lwt.fail Not_found in
+       let%lwt a =
+         match%lwt x with
+         | exception Not_found -> return false
+         | Some x -> return (x = 3)
+         | None -> return false
+       and b =
+         match%lwt x' with
+         | exception Not_found -> return true
+         | _ -> return false
+       in
+       Lwt.return (a && b)
+    ) ;
+
+  test "if"
+    (fun () ->
+       let x = Lwt.return_true in
+       let%lwt a =
+         if%lwt x then Lwt.return_true else Lwt.return_false
+       in
+       let%lwt b =
+         if%lwt x>|= not then Lwt.return_false else Lwt.return_true
+       in
+       (if%lwt x >|= not then Lwt.return_unit) >>= fun () ->
+       Lwt.return (a && b)
+    ) ;
+
+  test "for" (* Test for proper sequencing *)
+    (fun () ->
+       let r = ref [] in
+       let f x =
+         let%lwt () = Lwt_unix.sleep 0.2 in Lwt.return (r := x :: !r)
+       in
+       let%lwt () =
+         for%lwt x = 3 to 5 do f x done
+       in return (!r = [5 ; 4 ; 3])
+    ) ;
+
+  test "while" (* Test for proper sequencing *)
+    (fun () ->
+       let r = ref [] in
+       let f x =
+         let%lwt () = Lwt_unix.sleep 0.2 in Lwt.return (r := x :: !r)
+       in
+       let%lwt () =
+         let c = ref 2 in
+         while%lwt !c < 5 do incr c ; f !c done
+       in return (!r = [5 ; 4 ; 3])
+    ) ;
+
+  test "assert"
+    (fun () ->
+       let%lwt () = assert%lwt true
+       in return true
+    ) ;
+
+  test "try"
+    (fun () ->
+       try%lwt
+         Lwt.fail Not_found
+       with _ -> return true
+    ) [@warning("@8@11")] ;
+
+  test "try raise"
+    (fun () ->
+       try%lwt
+         raise Not_found
+       with _ -> return true
+    ) [@warning("@8@11")] ;
+
+  test "try fallback"
+    (fun () ->
+       try%lwt
+         try%lwt
+           Lwt.fail Not_found
+         with Failure _ -> return false
+       with Not_found -> return true
+    ) [@warning("@8@11")] ;
+
+  test "finally body"
+    (fun () ->
+       let x = ref false in
+       begin
+         (try%lwt
+           return_unit
+         with
+         | _ -> return_unit
+         ) [%finally x := true; return_unit]
+       end >>= fun () ->
+       return !x
+    ) ;
+
+  test "finally exn"
+    (fun () ->
+       let x = ref false in
+       begin
+         (try%lwt
+           raise Not_found
+         with
+         | _ -> return_unit
+         ) [%finally x := true; return_unit]
+       end >>= fun () ->
+       return !x
+    ) ;
+
+  test "finally exn default"
+    (fun () ->
+       let x = ref false in
+       try%lwt
+         ( raise Not_found )[%finally x := true; return_unit]
+         >>= fun () ->
+         return false
+       with Not_found ->
+         return !x
+    ) ;
+
+  test "structure let"
+    (fun () ->
+       Lwt.return structure_let_result
+    ) ;
+]
+
+let _ = Test.run "ppx" [ suite ]

unikernel/duniverse/lwt/test/ppx_let/dune

@@ -0,0 +1,7 @@
+(test
+ (name test)
+ (package lwt_ppx__ppx_let_tests)
+ (build_if %{lib-available:ppx_let})
+ (preprocess
+  (pps ppx_let))
+ (libraries lwt lwt.unix))

unikernel/duniverse/lwt/test/ppx_let/test.ml

@@ -0,0 +1,27 @@
+let () =
+  let p1 =
+    let open Lwt.Let_syntax in
+    let%bind x = Lwt.return 1 in
+    let%map y = Lwt.return (x + 1) in
+    y + 1
+  in
+
+  let p2 =
+    let open Lwt_result.Let_syntax in
+    let%bind x = Lwt_result.return 2 in
+    let%map y = Lwt_result.return (x + 3) in
+    x + y
+  in
+
+  let p =
+    let%bind.Lwt p1 = p1 in
+    let%map.Lwt_result p2 = p2 in
+    p1 + p2
+  in
+
+  let x = Lwt_main.run p in
+
+  if x = Ok 10 then
+    exit 0
+  else
+    exit 1

unikernel/duniverse/lwt/test/react/dune

@@ -0,0 +1,4 @@
+(test
+ (name main)
+ (package lwt_react)
+ (libraries lwt_react lwttester))

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

@@ -0,0 +1,9 @@
+(* 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. *)
+
+
+
+Test.run "react" [
+  Test_lwt_event.suite;
+  Test_lwt_signal.suite;
+]

unikernel/duniverse/lwt/test/react/test_lwt_event.ml

@@ -0,0 +1,125 @@
+(* 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
+
+let suite = suite "lwt_event" [
+  test "to_stream"
+    (fun () ->
+       let event, push = React.E.create () in
+       let stream = Lwt_react.E.to_stream event in
+       let t =  Lwt_stream.next stream in
+       assert (state t = Sleep);
+       push 42;
+       return (state t = Return 42));
+
+  test "to_stream 2"
+    (fun () ->
+       let event, push = React.E.create () in
+       let stream = Lwt_react.E.to_stream event in
+       push 1;
+       push 2;
+       push 3;
+       Lwt.bind (Lwt_stream.nget 3 stream) (fun l ->
+       return (l = [1; 2; 3])));
+
+  test "map_s"
+    (fun () ->
+       let l = ref [] in
+       let event, push = React.E.create () in
+       let event' = Lwt_react.E.map_s (fun x -> l := x :: !l; return ()) event in
+       ignore event';
+       push 1;
+       return (!l = [1]));
+
+  test "map_p"
+    (fun () ->
+       let l = ref [] in
+       let event, push = React.E.create () in
+       let event' = Lwt_react.E.map_p (fun x -> l := x :: !l; return ()) event in
+       ignore event';
+       push 1;
+       return (!l = [1]));
+
+  test "limit_race"
+    (fun () ->
+       let l = ref [] in
+       let event, push = Lwt_react.E.create() in
+       let prepend n = l := n :: !l
+       in
+       let event' =
+        event
+        |> Lwt_react.E.limit (fun () ->
+            let p = Lwt_unix.sleep 1. in
+            Lwt.async (fun () ->
+                Lwt_unix.sleep 0.1 >|= fun () ->
+                Lwt.on_success p (fun () -> push 2)); p)
+        |> React.E.map prepend
+       in
+       push 0;
+       push 1;
+
+       Lwt_unix.sleep 2.5 >>= fun () ->
+       let result = !l = [2; 2; 0] in
+       if not result then begin
+        List.iter (Printf.eprintf "%i ") !l;
+        prerr_newline ()
+       end;
+       ignore (Sys.opaque_identity event');
+       return result);
+
+  test "of_stream"
+    (fun () ->
+       let stream, push = Lwt_stream.create () in
+       let l = ref [] in
+       let event = React.E.map (fun x -> l := x :: !l) (Lwt_react.E.of_stream stream) in
+       ignore event;
+       push (Some 1);
+       push (Some 2);
+       push (Some 3);
+       Lwt.wakeup_paused ();
+       return (!l = [3; 2; 1]));
+
+  test "limit"
+    (fun () ->
+       let event, push = React.E.create () in
+       let cond        = Lwt_condition.create () in
+       let event'      = Lwt_react.E.limit (fun () -> Lwt_condition.wait cond) event in
+       let l           = ref [] in
+       let event''     = React.E.map (fun x -> l := x :: !l) event' in
+         ignore event';
+         ignore event'';
+         push 1;
+         push 0;
+         push 2; (* overwrites previous 0 *)
+         Lwt_condition.signal cond ();
+         Lwt.pause () >>= fun () ->
+         push 3;
+         Lwt_condition.signal cond ();
+         Lwt.pause () >>= fun () ->
+         push 4;
+         Lwt_condition.signal cond ();
+         Lwt.pause () >>= fun () ->
+         return (!l = [4; 3; 2; 1]));
+
+  test "with_finaliser lifetime" begin fun () ->
+    let e, push = React.E.create () in
+    let finalizer_ran = ref false in
+    let e' = Lwt_react.E.with_finaliser (fun () -> finalizer_ran := true) e in
+
+    Gc.full_major ();
+    let check1 = !finalizer_ran = false in
+
+    let p = Lwt_react.E.next e' in
+    push ();
+    p >>= fun () ->
+
+    Gc.full_major ();
+    let check2 = !finalizer_ran = true in
+
+    Lwt.return (check1 && check2)
+  end;
+]

unikernel/duniverse/lwt/test/react/test_lwt_signal.ml

@@ -0,0 +1,73 @@
+(* 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
+
+let suite = suite "lwt_signal" [
+  test "limit"
+    (fun () ->
+       let s, push = React.S.create 0 in
+       let cond    = Lwt_condition.create () in
+       let s'      = Lwt_react.S.limit (fun () -> Lwt_condition.wait cond) s in
+       let l       = ref [] in
+       let e       = React.E.map (fun x -> l := x :: !l) (React.S.changes s') in
+         ignore e;
+         Lwt_condition.signal cond ();
+         Lwt.pause () >>= fun () ->
+         push 1;
+         push 0;
+         push 2; (* overwrites previous 0 *)
+         Lwt_condition.signal cond ();
+         Lwt.pause () >>= fun () ->
+         push 3;
+         Lwt_condition.signal cond ();
+         Lwt.pause () >>= fun () ->
+         push 4;
+         Lwt_condition.signal cond ();
+         Lwt.pause () >>= fun () ->
+         return (!l = [4; 3; 2; 1]));
+
+  test "limit race condition" begin fun () ->
+    let change_count = ref 0 in
+
+    let underlying_signal, set = React.S.create 0 in
+
+    underlying_signal
+    |> Lwt_react.S.limit (fun () ->
+      let p = Lwt_unix.sleep 1. in
+      Lwt.async (fun () ->
+        Lwt_unix.sleep 0.1 >|= fun () ->
+        Lwt.on_success p (fun () ->
+        set 2));
+      p)
+    |> React.S.changes
+    |> React.E.map (fun _ -> incr change_count)
+    |> ignore;
+
+    set 1;
+
+    Lwt_unix.sleep 2. >|= fun () ->
+    !change_count = 1
+  end;
+
+  test "with_finaliser lifetime" begin fun () ->
+    let s, set = React.S.create 0 in
+    let finalizer_ran = ref false in
+    let s' = Lwt_react.S.with_finaliser (fun () -> finalizer_ran := true) s in
+
+    Gc.full_major ();
+    let check1 = !finalizer_ran = false in
+
+    let p = Lwt_react.E.next (React.S.changes s') in
+    set 1;
+    p >>= fun _ ->
+
+    Gc.full_major ();
+    let check2 = !finalizer_ran = true in
+
+    Lwt.return (check1 && check2)
+  end;
+]

unikernel/duniverse/lwt/test/retry/dune

@@ -0,0 +1,4 @@
+(test
+ (name main)
+ (package lwt_retry)
+ (libraries lwttester lwt_retry))

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

@@ -0,0 +1,158 @@
+(* 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
+open Lwt.Syntax
+
+module Retry = Lwt_retry
+
+let pp = Retry.pp_error ~retry:Format.pp_print_float ~fatal:Format.pp_print_int
+
+let suite = suite "lwt_retry" [
+    test_direct "can format retries outcomes"
+      (fun () ->
+         Format.asprintf "%a" pp (`Retry 3.0) = "`Retry 3.");
+
+    test_direct "can format fatal outcomes"
+      (fun () ->
+         Format.asprintf "%a" pp (`Fatal 42) = "`Fatal 42");
+
+    test_direct "can format with default printer"
+      (fun () ->
+         Format.asprintf "%a" (fun x -> Retry.pp_error x) (`Fatal 42)
+         =
+         "`Fatal <opaque>");
+
+    test "success without retry"
+      (fun () ->
+        let strm =
+          Retry.on_error (fun () -> Lwt.return_ok 42)
+        in
+        let* actual = Lwt_stream.next strm in
+        assert (actual = Ok 42);
+        (* ensure the post condition of an empty stream *)
+        Lwt_stream.is_empty strm);
+
+    test "does not run extra attempts"
+      (fun () ->
+         let count = ref 0 in
+         let strm =
+           Retry.on_error (fun () ->
+               incr count;
+               Lwt.return_ok 42)
+         in
+         let* actual = Lwt_stream.next strm in
+         assert (actual = Ok 42);
+         (* Force another attempt on the stream *)
+         let+ _ = Lwt_stream.is_empty strm in
+         (* We should have run 1 and only 1 attempt,
+            or else the execution logic is wrong. *)
+         !count = 1);
+
+    test "just retries" (fun () ->
+        let strm =
+          Retry.on_error (fun () -> Lwt.return_error (`Retry ()))
+        in
+        let retry_attempts = 5 in
+        let expected_retries = List.init retry_attempts (fun i -> Error (`Retry (), i + 1)) in
+        let+ actual_retries = Lwt_stream.nget retry_attempts strm in
+        actual_retries = expected_retries);
+
+    test "retries before fatal error" (fun () ->
+        let retries_before_fatal = 3 in
+        let i = ref 0 in
+        let strm = Retry.on_error
+            (fun () ->
+               if !i < retries_before_fatal then (
+                 incr i;
+                 Lwt.return_error (`Retry ())
+               ) else
+                 Lwt.return_error (`Fatal ()))
+        in
+        let* n_retry_errors = Lwt_stream.nget retries_before_fatal strm >|= List.length in
+        assert (n_retry_errors = retries_before_fatal);
+        let* fatal_error = Lwt_stream.next strm in
+        assert (fatal_error = Error (`Fatal (), retries_before_fatal + 1));
+        (* ensure the post condition of an empty stream *)
+        Lwt_stream.is_empty strm);
+
+    test "retries before success" (fun () ->
+        let retries_before_fatal = 3 in
+        let i = ref 0 in
+        let strm = Retry.on_error (fun () ->
+            if !i < retries_before_fatal then (
+              incr i;
+              Lwt.return_error (`Retry ())
+            ) else
+              Lwt.return_ok ()
+          )
+        in
+        let* n_retry_errors = Lwt_stream.nget retries_before_fatal strm >|= List.length in
+        assert (n_retry_errors = retries_before_fatal);
+        let* success = Lwt_stream.next strm in
+        assert (success = Ok ());
+        (* ensure the post condition of an empty stream *)
+        Lwt_stream.is_empty strm);
+
+    test "[n_times 0] runs one attempt" (fun () ->
+        let operation () = Lwt.return_error (`Retry ()) in
+        let+ attempt = Retry.(operation |> on_error |> n_times 0) in
+        attempt = Error (`Retry (), 1));
+
+    test "n_times gives up on a fatal error" (fun () ->
+        let i = ref 0 in
+        let operation () =
+          if !i < 3 then (
+            incr i;
+            Lwt.return_error (`Retry ())
+          ) else
+            Lwt.return_error (`Fatal ())
+        in
+        let+ fatal_error = Retry.(operation |> on_error |> n_times 5) in
+        fatal_error = Error (`Fatal (), 4));
+
+    test "n_times gives a retry error when exhausted"  (fun () ->
+        let retries = 5 in
+        let operation () = Lwt.return_error (`Retry ()) in
+        let+ result = Retry.(operation |> on_error |> n_times retries) in
+        result = Error (`Retry (), retries + 1));
+
+    test "n_times is ok on success" (fun () ->
+        let i = ref 0 in
+        let operation () =
+          if !i < 3 then (
+            incr i;
+            Lwt.return_error (`Retry ())
+          ) else
+            Lwt.return_ok ()
+        in
+        let+ success = Retry.(operation |> on_error |> n_times 5) in
+        success = Ok ());
+
+    test_direct "n_times on negative raises Invalid_argument"  (fun () ->
+        let invalid_negative_retries = -5 in
+        let operation () = Lwt.return_error (`Retry ()) in
+        let attempts = Retry.(operation |> on_error) in
+        try
+          let _ = Retry.(attempts |> n_times invalid_negative_retries) in
+          false (* We failed to raise the invalid argument exception *)
+        with
+          Invalid_argument _ -> true);
+
+    (* test that the sleeps actually throttle computations as desired *)
+    test "with_sleep really does sleep"  (fun ()  ->
+      let duration _ = 0.01 in
+      let operation () = Lwt.return_error (`Retry ()) in
+      (* If [with_sleep] is removed the test fails, as expected *)
+      let retries = Retry.(operation |> on_error |> with_sleep ~duration |> n_times 5) in
+      (* We will expect the [racing_operation] to complete before the retries with_sleep *)
+      let racing_operation = Lwt_unix.sleep (duration ()) >|= Result.ok in
+      let+ actual = Lwt.choose [racing_operation; retries] in
+      actual = Ok ());
+  ]
+
+let () =
+  Test.run "retry" [suite]

unikernel/duniverse/lwt/test/test.ml

@@ -0,0 +1,352 @@
+(* 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. *)
+
+
+
+type test = {
+  test_name : string;
+  skip_if_this_is_false : unit -> bool;
+  sequential : bool;
+  run : unit -> bool Lwt.t;
+}
+
+type outcome =
+  | Passed
+  | Failed
+  | Exception of exn
+  | Skipped
+
+exception Skip
+exception Duplicate_Test_Names of string
+
+let test_direct test_name ?(only_if = fun () -> true) run =
+  let run =
+    fun () ->
+      Lwt.return (run ())
+  in
+  {test_name; skip_if_this_is_false = only_if; sequential = false; run}
+
+let test test_name ?(only_if = fun () -> true) ?(sequential = false) run =
+  {test_name; skip_if_this_is_false = only_if; sequential; run}
+
+module Log =
+struct
+  let log_file =
+    let pid = Unix.getpid () in
+    let ms = Unix.gettimeofday () |> modf |> fst in
+    let filename = Printf.sprintf "test.%i.%03.0f.log" pid (ms *. 1e3) in
+    open_out filename
+  let () =
+    at_exit (fun () -> close_out_noerr log_file)
+
+  let start_time = ref None
+  let elapsed () =
+    let now = Unix.gettimeofday () in
+    match !start_time with
+    | None ->
+      start_time := Some now;
+      0.
+    | Some start_time ->
+      now -. start_time
+
+  let write identifier message =
+    Printf.ksprintf (output_string log_file) "%s [%07.3f]: %s\n"
+      identifier (mod_float (elapsed ()) 1000.) message;
+    flush log_file
+  let log k =
+    k (fun identifier ->
+      Printf.ksprintf (write identifier))
+end
+
+let log = Log.log
+
+let run_test : test -> outcome Lwt.t = fun test ->
+  if test.skip_if_this_is_false () = false then begin
+    log @@ (fun k -> k test.test_name "skipping");
+    Lwt.return Skipped
+  end
+
+  else begin
+    let start_time = Unix.gettimeofday () in
+    log @@ (fun k -> k test.test_name "starting");
+
+    (* Lwt.async_exception_hook handling inspired by
+         https://github.com/mirage/alcotest/issues/45 *)
+    let async_exception_promise, async_exception_occurred = Lwt.task () in
+    let old_async_exception_hook = !Lwt.async_exception_hook in
+    Lwt.async_exception_hook := (fun exn ->
+      Lwt.wakeup_later async_exception_occurred (Exception exn));
+
+    Lwt.finalize
+      (fun () ->
+        let test_completion_promise =
+          Lwt.try_bind
+            (fun () ->
+              test.run ())
+
+            (fun test_did_pass ->
+              if test_did_pass then
+                Lwt.return Passed
+              else
+                Lwt.return Failed)
+
+            (function
+            | Skip ->
+              Lwt.return Skipped
+
+            | exn_raised_by_test ->
+              Lwt.return (Exception exn_raised_by_test))
+        in
+
+        Lwt.pick [test_completion_promise; async_exception_promise])
+
+      (fun () ->
+        Lwt.async_exception_hook := old_async_exception_hook;
+        let elapsed = Unix.gettimeofday () -. start_time in
+        log @@ (fun k -> k test.test_name "finished in %.3f s" elapsed);
+        Lwt.return_unit)
+  end
+
+let outcome_to_character : outcome -> string = function
+  | Passed -> "."
+  | Failed -> "F"
+  | Exception _ -> "E"
+  | Skipped -> "S"
+
+
+
+type suite = {
+  suite_name : string;
+  suite_tests : test list;
+  skip_suite_if_this_is_false : unit -> bool;
+}
+
+let contains_dup_tests suite tests =
+  let names =
+    List.map (fun t -> "suite:" ^ suite ^ " test:" ^ t.test_name) tests in
+  let sorted_unique_names = List.sort_uniq String.compare names in
+  let counts =
+    List.map (fun x ->
+      let tests = List.find_all (fun y -> y = x) names in
+      (x, List.length tests)) sorted_unique_names in
+  let dups = List.filter (fun (_, count) -> count > 1) counts |>
+                          List.map (fun (name, _) -> name) in
+  if List.length dups > 0 then
+    Some dups
+  else
+    None
+
+let suite name ?(only_if = fun () -> true) tests =
+  match contains_dup_tests name tests with
+    | Some names -> raise (Duplicate_Test_Names (String.concat ", " names))
+    | None -> ();
+  {suite_name = name;
+   suite_tests = tests;
+   skip_suite_if_this_is_false = only_if}
+
+let run_test_suite : suite -> ((string * outcome) list) Lwt.t = fun suite ->
+  if suite.skip_suite_if_this_is_false () = false then
+    let outcomes =
+      suite.suite_tests
+      |> List.map (fun {test_name; _} -> (test_name, Skipped))
+    in
+    (outcome_to_character Skipped).[0]
+    |> String.make (List.length outcomes)
+    |> print_string;
+    flush stdout;
+
+    Lwt.return outcomes
+
+  else
+    suite.suite_tests |> Lwt_list.map_s begin fun test ->
+      Lwt.bind (run_test test) (fun outcome ->
+      outcome |> outcome_to_character |> print_string;
+      flush stdout;
+      Lwt.return (test.test_name, outcome))
+    end
+
+let outcomes_all_ok : (_ * outcome) list -> bool = fun outcomes ->
+  outcomes
+  |> List.for_all (fun (_test_name, outcome) ->
+    match outcome with
+    | Passed | Skipped -> true
+    | Failed | Exception _ -> false)
+
+let show_failures : (string * outcome) list -> unit =
+  List.iter (fun (test_name, outcome) ->
+    match outcome with
+    | Passed
+    | Skipped ->
+      ()
+
+    | Failed ->
+      Printf.eprintf
+        "Test '%s' produced 'false'\n" test_name
+
+    | Exception exn ->
+      Printf.eprintf
+        "Test '%s' raised '%s'\n" test_name (Printexc.to_string exn))
+
+
+
+type ('a, 'b) aggregated_outcomes = ('a * (('b * outcome) list)) list
+
+let fold_over_outcomes :
+    ('a -> outcome -> 'a) ->
+    'a ->
+    (_, _) aggregated_outcomes ->
+      'a =
+    fun f init outcomes ->
+
+  List.fold_left (fun accumulator (_suite_name, test_outcomes) ->
+    List.fold_left (fun accumulator (_test_name, test_outcome) ->
+      f accumulator test_outcome)
+      accumulator
+      test_outcomes)
+    init
+    outcomes
+
+let count_ran : (_, _) aggregated_outcomes -> int = fun outcomes ->
+  outcomes
+  |> fold_over_outcomes
+    (fun count -> function
+      | Skipped ->
+        count
+      | _ ->
+        count + 1)
+    0
+
+let count_skipped : (_, _) aggregated_outcomes -> int = fun outcomes ->
+  outcomes
+  |> fold_over_outcomes
+    (fun count -> function
+      | Skipped ->
+        count + 1
+      | _ ->
+        count)
+    0
+
+(* Runs a series of test suites. If one of the test suites fails, does not run
+   subsequent suites. *)
+let run library_name suites =
+  Printexc.record_backtrace true;
+
+  Printexc.register_printer (function
+    | Failure message -> Some (Printf.sprintf "Failure(%S)" message)
+    | _ -> None);
+
+  Printf.printf "Testing library '%s'...\n" library_name;
+
+  let start_time = Unix.gettimeofday () in
+
+  let rec loop_over_suites aggregated_outcomes suites =
+    match suites with
+    | [] ->
+      let end_time = Unix.gettimeofday () in
+      Printf.printf
+        "\nOk. %i tests ran, %i tests skipped in %.2f seconds\n"
+        (count_ran aggregated_outcomes)
+        (count_skipped aggregated_outcomes)
+        (end_time -. start_time);
+      Lwt.return_unit
+
+    | suite::rest ->
+      Lwt.bind (run_test_suite suite) begin fun outcomes ->
+        if not (outcomes_all_ok outcomes) then begin
+          print_newline ();
+          flush stdout;
+          Printf.eprintf "Failures in test suite '%s':\n" suite.suite_name;
+          show_failures outcomes;
+          exit 1
+        end
+        else
+          loop_over_suites
+            ((suite.suite_name, outcomes)::aggregated_outcomes) rest
+      end
+  in
+
+  loop_over_suites [] suites
+  |> Lwt_main.run
+
+let concurrent library_name suites =
+  Printexc.register_printer (function
+    | Failure message -> Some (Printf.sprintf "Failure(%S)" message)
+    | _ -> None);
+
+  Printf.printf "Testing library '%s'...\n" library_name;
+
+  let open Lwt.Infix in
+
+  let run_test (suite, test) =
+    begin
+      if suite.skip_suite_if_this_is_false () = false then
+        Lwt.return Skipped
+      else
+        run_test test
+    end
+    >|= fun outcome ->
+    print_string (outcome_to_character outcome);
+    flush stdout;
+    ((suite, test), outcome)
+  in
+
+  let start_time = Unix.gettimeofday () in
+
+  (* List all the tests. *)
+  suites
+  |> List.map (fun suite ->
+    suite.suite_tests
+    |> List.map (fun test ->
+      (suite, test)))
+  |> List.flatten
+
+  (* Separate the tests that must be run sequentially, and run them. *)
+  |> List.partition (fun (_suite, test) -> test.sequential)
+  |> fun (sequential, concurrent) ->
+    Lwt_list.map_s run_test sequential
+  >>= fun sequential_outcomes ->
+
+  (* Run the tests that can be run concurrently. *)
+  concurrent
+  |> Lwt_list.map_p run_test
+
+  (* Summarize the results. *)
+  >>= fun concurrent_outcomes ->
+  let outcomes = sequential_outcomes @ concurrent_outcomes in
+  if outcomes_all_ok outcomes then
+    let end_time = Unix.gettimeofday () in
+    let aggregated_outcomes = [(), outcomes] in
+    Printf.printf
+      "\nOk. %i tests ran, %i tests skipped in %.2f seconds\n"
+      (count_ran aggregated_outcomes)
+      (count_skipped aggregated_outcomes)
+      (end_time -. start_time);
+    Lwt.return_unit
+  else begin
+    print_newline ();
+    flush stdout;
+    outcomes |> List.iter (function
+      | (suite, test), Failed ->
+        Printf.eprintf "Test '%s' in suite '%s' produced 'false'\n"
+          test.test_name suite.suite_name
+      | (suite, test), Exception exn ->
+        Printf.eprintf "Test '%s' in suite '%s' raised '%s'\n"
+          test.test_name suite.suite_name (Printexc.to_string exn)
+      | _ ->
+        ());
+    exit 1
+  end
+
+let concurrent library_name suites =
+  Lwt_main.run (concurrent library_name suites)
+
+let with_async_exception_hook hook f =
+  let old_hook = !Lwt.async_exception_hook in
+  Lwt.async_exception_hook := hook;
+  Lwt.finalize f (fun () ->
+    Lwt.async_exception_hook := old_hook;
+    Lwt.return_unit)
+
+let instrument = function
+  | true -> Printf.ksprintf (fun _s -> true)
+  | false -> Printf.ksprintf (fun s -> prerr_endline ("\n" ^ s); false)

unikernel/duniverse/lwt/test/test.mli

@@ -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. *)
+
+
+
+(** Helpers for tests. *)
+
+type test
+(** Type of a test *)
+
+type suite
+(** Type of a suite of tests *)
+
+exception Skip
+(** In some tests, it is only clear that the test should be skipped after it has
+    started running (for example, after an attempted system call raises a
+    certain exception, indicating it is not supported).
+
+    Such tests should raise [Test.Skip], or reject their final promise with
+    [Test.Skip]. *)
+
+val test_direct : string -> ?only_if:(unit -> bool) -> (unit -> bool) -> test
+(** Defines a test. [run] must returns [true] if the test succeeded
+    and [false] otherwise. [only_if] is used to conditionally skip the
+    test. *)
+
+val test :
+  string ->
+  ?only_if:(unit -> bool) ->
+  ?sequential:bool ->
+  (unit -> bool Lwt.t) ->
+    test
+(** Like [test_direct], but defines a test which runs a thread. *)
+
+val suite : string -> ?only_if:(unit -> bool) -> test list -> suite
+(** Defines a suite of tests *)
+
+val run : string -> suite list -> unit
+(** Run all the given tests and exit the program with an exit code
+    of [0] if all tests succeeded and with [1] otherwise. *)
+
+val concurrent : string -> suite list -> unit
+(** Same as [run], but runs all the tests concurrently. *)
+
+val with_async_exception_hook : (exn -> unit) -> (unit -> 'a Lwt.t) -> 'a Lwt.t
+(** [Test.with_async_exception_hook hook f] sets [!Lwt.async_exception_hook] to
+    [hook], runs [f ()], and then restores [!Lwt.async_exception_hook] to its
+    former value. *)
+
+val instrument : bool -> ('a, unit, string, bool) format4 -> 'a
+(** Acts like [Printf.eprintf], but prints nothing if the boolean is [true]. *)

unikernel/duniverse/lwt/test/test_unix.ml

@@ -0,0 +1,23 @@
+(* 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 temp_name =
+  let rng = Random.State.make_self_init () in
+  fun () ->
+    let number = Random.State.int rng 10000 in
+    Printf.sprintf "lwt-testing-%04d" number
+
+let temp_file () =
+  Filename.temp_file ~temp_dir:"." "lwt-testing-" ""
+
+let temp_directory () =
+  let rec attempt () =
+    let path = temp_name () in
+    try
+      Unix.mkdir path 0o755;
+      path
+    with Unix.Unix_error (Unix.EEXIST, "mkdir", _) -> attempt ()
+  in
+  attempt ()

unikernel/duniverse/lwt/test/test_unix.mli

@@ -0,0 +1,14 @@
+(* 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. *)
+
+
+
+val temp_name : unit -> string
+(** Generates the name of a temporary file (or directory) in [_build/]. Note
+    that a file at the path may already exist. *)
+
+val temp_file : unit -> string
+(** Creates a temporary file in [_build/] and evaluates to its path. *)
+
+val temp_directory : unit -> string
+(** Creates a temporary directory in [build/] and evaluates to its path. *)

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