96 lines
3.3 KiB
OCaml
96 lines
3.3 KiB
OCaml
(* 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
|
|
|
|
(* None of the APIs make promises about how much larger the elapsed time will
|
|
* be, but they all promise that it won't be less than the expected time. *)
|
|
let cmp_elapsed_time test_name start_time expected_time =
|
|
let elapsed_time = Unix.gettimeofday () -. start_time in
|
|
let diff = elapsed_time -. expected_time in
|
|
let result = diff >= 0. && diff <= 0.2 in
|
|
instrument result "Lwt_unix sleep and timeout: %s: %f %f %f %b"
|
|
test_name elapsed_time expected_time diff (Lwt_sys.have `libev)
|
|
|
|
let suite = suite "Lwt_unix sleep and timeout" [
|
|
test "sleep" begin fun () ->
|
|
let start_time = Unix.gettimeofday () in
|
|
let duration = 1.0 in
|
|
Lwt_unix.sleep duration
|
|
>>= fun () ->
|
|
let check = cmp_elapsed_time "sleep" start_time duration in
|
|
Lwt.return check
|
|
end;
|
|
|
|
test "timeout" begin fun () ->
|
|
let start_time = Unix.gettimeofday () in
|
|
let duration = 1.0 in
|
|
Lwt.catch
|
|
(fun () ->
|
|
Lwt_unix.timeout duration
|
|
>>= fun () -> Lwt.return_false
|
|
)
|
|
(function
|
|
| Lwt_unix.Timeout ->
|
|
let check = cmp_elapsed_time "timeout" start_time duration in
|
|
Lwt.return check
|
|
| exn -> Lwt.reraise exn
|
|
)
|
|
end;
|
|
|
|
test "with_timeout : no timeout" begin fun () ->
|
|
let duration = 1.0 in
|
|
Lwt_unix.with_timeout duration Lwt.pause
|
|
>>= fun () -> Lwt.return_true
|
|
end;
|
|
|
|
test "with_timeout : timeout" begin fun () ->
|
|
let start_time = Unix.gettimeofday () in
|
|
let duration = 1.0 in
|
|
let f () = Lwt_unix.sleep 2.0 in
|
|
Lwt.catch
|
|
(fun () ->
|
|
Lwt_unix.with_timeout duration f
|
|
>>= fun () ->
|
|
Printf.eprintf "\nno timeout\n";
|
|
Lwt.return_false
|
|
)
|
|
(function
|
|
| Lwt_unix.Timeout ->
|
|
let check =
|
|
cmp_elapsed_time "with_timeout : timeout" start_time duration in
|
|
Lwt.return check
|
|
| exn -> Lwt.reraise exn
|
|
)
|
|
end;
|
|
|
|
test "pause" begin fun () ->
|
|
let bind_callback_ran = ref false in
|
|
Lwt.async (fun () -> Lwt.return_unit >|= fun () -> bind_callback_ran := true);
|
|
let bind_is_immediate = !bind_callback_ran in
|
|
let pause_callback_ran = ref false in
|
|
Lwt.async (fun () -> Lwt.pause () >|= fun () -> pause_callback_ran := true);
|
|
let pause_is_immediate = !pause_callback_ran in
|
|
Lwt.return (bind_is_immediate && not pause_is_immediate)
|
|
end;
|
|
|
|
test "auto_pause" begin fun () ->
|
|
let f = Lwt_unix.auto_pause 1.0 in
|
|
let run_auto_pause () =
|
|
let callback_ran = ref false in
|
|
Lwt.async (fun () -> f () >|= fun () -> callback_ran := true);
|
|
!callback_ran;
|
|
in
|
|
let check1 = run_auto_pause () in
|
|
let check2 = run_auto_pause () in
|
|
Lwt_unix.sleep 1.0
|
|
>|= fun () ->
|
|
let check3 = run_auto_pause () in
|
|
let check4 = run_auto_pause () in
|
|
let check5 = run_auto_pause () in
|
|
let check = check1 && check2 && not check3 && check4 && check5 in
|
|
instrument check "Lwt_unix sleep and timeout: auto_pause: %b %b %b %b %b"
|
|
check1 check2 check3 check4 check5
|
|
end;
|
|
]
|