unikernel/duniverse/lwt/test/unix/test_sleep_and_timeout.ml

@@ -0,0 +1,96 @@
+(* 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;
+  ]