From 0177d6aee72fa88a7e775d9d8398ba604495e7ee Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Mon, 12 Jun 2023 22:06:18 -0400 Subject: [PATCH] fix fut: actually run all map/bind callbacks if pool is provided --- src/fut.ml | 24 +++++++++++++++--------- 1 file changed, 15 insertions(+), 9 deletions(-) diff --git a/src/fut.ml b/src/fut.ml index 810f87f3..e04c7a13 100644 --- a/src/fut.ml +++ b/src/fut.ml @@ -120,20 +120,26 @@ let bind ?on ~f fut : _ t = | Error (e, bt) -> fail e bt in + let bind_and_fulfill r promise () = + let f_res_fut = apply_f_to_res r in + (* forward result *) + on_result f_res_fut (fun r -> fulfill promise r) + in + match peek fut with - | Some r -> apply_f_to_res r + | Some r -> + (match on with + | None -> apply_f_to_res r + | Some on -> + let fut2, promise = make () in + Pool.run on (bind_and_fulfill r promise); + fut2) | None -> let fut2, promise = make () in on_result fut (fun r -> - let bind_and_fulfill () = - let f_res_fut = apply_f_to_res r in - (* forward result *) - on_result f_res_fut (fun r -> fulfill promise r) - in - match on with - | None -> bind_and_fulfill () - | Some on -> Pool.run on bind_and_fulfill); + | None -> bind_and_fulfill r promise () + | Some on -> Pool.run on (bind_and_fulfill r promise)); fut2