balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Utils: fix Lwt_utils.with_timeout

Browse Source 
The function will never fail with `Timeout`, if the concurrent
computation terminates at the same "time".
This commit is contained in:
Grégoire Henry 2017-11-11 03:34:12 +01:00 committed by Benjamin Canou
parent f0acd2e4da
commit 2d08ba778f
1 changed files with 11 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
src/utils/lwt_utils.ml
View File

@ -483,17 +483,17 @@ let () =
(fun () -> Timeout) (fun () -> Timeout)
let with_timeout ?(canceler = Canceler.create ()) timeout f = let with_timeout ?(canceler = Canceler.create ()) timeout f =
let t = Lwt_unix.sleep timeout in let timeout = Lwt_unix.sleep timeout in
Lwt.choose [ let target = f canceler in
(t >|= fun () -> None) ; Lwt.choose [ timeout ; (target >|= fun _ -> ()) ] >>= fun () ->
(f canceler >|= fun x -> Some x) Lwt_unix.yield () >>= fun () ->
] >>= function if Lwt.state target <> Lwt.Sleep then begin
| Some x when Lwt.state t = Lwt.Sleep -> Lwt.cancel timeout ;
Lwt.cancel t ; target
Lwt.return x end else begin
| _ -> Canceler.cancel canceler >>= fun () ->
Canceler.cancel canceler >>= fun () -> fail Timeout
fail Timeout end
let unless cond f = let unless cond f =
if cond then Lwt.return () else f () if cond then Lwt.return () else f ()