Add Lwt.all

src/core/lwt.ml

@@ -2448,6 +2448,7 @@ sig
 
   val both : 'a t -> 'b t -> ('a * 'b) t
   val join : unit t list -> unit t
+  val all : ('a t) list -> ('a list) t
 
   val choose : 'a t list -> 'a t
   val pick : 'a t list -> 'a t
@@ -2580,6 +2581,20 @@ struct
       | Some v1, Some v2 -> v1, v2
       | _ -> assert false)
 
+  let all ps =
+    let vs = Array.make (List.length ps) None in
+    ps
+    |> List.mapi (fun index p ->
+      bind p (fun v -> vs.(index) <- Some v; return_unit))
+    |> join
+    |> map (fun () ->
+      vs
+      |> Array.map (fun v ->
+        match v with
+        | Some v -> v
+        | None -> assert false)
+      |> Array.to_list)
+
 
 
   (* Maintainer's note: the next few functions are helpers for [choose] and

src/core/lwt.mli

@@ -962,6 +962,19 @@ let () =
     chosen arbitrarily. Note that this occurs only after all the promises are
     resolved, not immediately when the first promise is rejected. *)
 
+val all : ('a t) list -> ('a list) t
+(** [Lwt.all ps] is like {!Lwt.join}[ ps]: it waits for all promises in the list
+    [ps] to become {{: #TYPEt} {e resolved}}.
+
+    It then resolves the returned promise with the list of all resulting values.
+
+    Note that if any of the promises in [ps] is rejected, the returned promise
+    is also rejected. This means that none of the values will be available, even
+    if some of the promises in [ps] were already resolved when one of them is
+    rejected. For more fine-grained handling of rejection, structure the program
+    with {!Lwt_stream} or {!Lwt_list}, or use {!Lwt.join} and collect values
+    manually. *)
+
 
 
 (** {3 Racing} *)

test/core/test_lwt.ml

@@ -1892,13 +1892,66 @@ let join_tests = suite "join" [
 ]
 let suites = suites @ [join_tests]
 
+let all_tests = suite "all" [
+  test "empty" begin fun () ->
+    let p = Lwt.all [] in
+    state_is (Lwt.Return []) p
+  end;
+
+  test "all fulfilled" begin fun () ->
+    let p = Lwt.all [Lwt.return 1; Lwt.return 2] in
+    state_is (Lwt.Return [1; 2]) p
+  end;
+
+  test "all rejected" begin fun () ->
+    let p = Lwt.all [Lwt.fail Exception; Lwt.fail Exception] in
+    state_is (Lwt.Fail Exception) p
+  end;
+
+  test "fulfilled and pending, fulfilled" begin fun () ->
+    let p, r = Lwt.wait () in
+    let p = Lwt.all [Lwt.return 1; p] in
+    Lwt.wakeup r 2;
+    state_is (Lwt.Return [1; 2]) p
+  end;
+
+  test "rejected and pending, fulfilled" begin fun () ->
+    let p, r = Lwt.wait () in
+    let p = Lwt.all [Lwt.fail Exception; p] in
+    Lwt.wakeup r 2;
+    state_is (Lwt.Fail Exception) p
+  end;
+
+  test "fulfilled and pending, rejected" begin fun () ->
+    let p, r = Lwt.wait () in
+    let p = Lwt.all [Lwt.return 1; p] in
+    Lwt.wakeup_exn r Exception;
+    state_is (Lwt.Fail Exception) p
+  end;
+
+  test "rejected and pending, rejected" begin fun () ->
+    let p, r = Lwt.wait () in
+    let p = Lwt.all [Lwt.fail Exception; p] in
+    Lwt.wakeup_exn r Exit;
+    state_is (Lwt.Fail Exception) p
+  end;
+
+  test "diamond" begin fun () ->
+    let p, r = Lwt.wait () in
+    let p = Lwt.all [p; p] in
+    Lwt.wakeup r 1;
+    state_is (Lwt.Return [1; 1]) p
+  end;
+]
+let suites = suites @ [all_tests]
+
 let both_tests = suite "both" [
   test "both fulfilled" begin fun () ->
     let p = Lwt.both (Lwt.return 1) (Lwt.return 2) in
     state_is (Lwt.Return (1, 2)) p
   end;
 
-  test "all rejected" begin fun () ->
+  test "both rejected" begin fun () ->
     let p = Lwt.both (Lwt.fail Exception) (Lwt.fail Exit) in
     state_is (Lwt.Fail Exception) p
   end;