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