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

18
src/utils/lwt_utils.ml
View File

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