diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-threads/scheduler_test.ml b/ocaml/libs/xapi-stdext/lib/xapi-stdext-threads/scheduler_test.ml index 0a4a847403f..259a24ee260 100644 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-threads/scheduler_test.ml +++ b/ocaml/libs/xapi-stdext/lib/xapi-stdext-threads/scheduler_test.ml @@ -14,90 +14,106 @@ module Scheduler = Xapi_stdext_threads_scheduler.Scheduler +let calibrated_ratio () = + let expected = Mtime.Span.(100 * ms |> to_float_ns) in + let elapsed = Mtime_clock.counter () in + (* Add a 10% leeway to the ratio calculated *) + Thread.delay 0.11 ; + let actual = Mtime_clock.count elapsed |> Mtime.Span.to_float_ns in + let ratio = actual /. expected in + Alcotest.(check bool) (Printf.sprintf "ratio is %f" ratio) true true ; + ratio + let started = Atomic.make false let start_schedule () = if not (Atomic.exchange started true) then Thread.create Scheduler.loop () |> ignore -let send event data = Event.(send event data |> sync) +let send event data () = Event.(send event data |> sync) let receive event = Event.(receive event |> sync) -let elapsed_ms cnt = - let elapsed_ns = Mtime_clock.count cnt |> Mtime.Span.to_uint64_ns in - Int64.(div elapsed_ns 1000000L |> to_int) +let is_less ratio a b = + let a = + Mtime.Span.to_float_ns a + |> Float.mul ratio + |> Int64.of_float + |> Mtime.Span.of_uint64_ns + in + Mtime.Span.is_shorter ~than:a b -let is_less = Alcotest.(testable (pp int)) Stdlib.( > ) +let mtime_span () = + let cmp = is_less (calibrated_ratio ()) in + Alcotest.(testable Mtime.Span.pp) cmp let test_single () = let finished = Event.new_channel () in - Scheduler.add_to_queue "one" Scheduler.OneShot 0.001 (fun () -> - send finished true - ) ; + Scheduler.add_to_queue "one" Scheduler.OneShot 0.001 (send finished true) ; start_schedule () ; Alcotest.(check bool) "result" true (receive finished) -let test_remove_self () = +let test_remove_self mtime_span () = let which = Event.new_channel () in Scheduler.add_to_queue "self" (Scheduler.Periodic 0.001) 0.001 (fun () -> (* this should remove the periodic scheduling *) Scheduler.remove_from_queue "self" ; (* add an operation to stop the test *) - Scheduler.add_to_queue "stop" Scheduler.OneShot 0.1 (fun () -> - send which "stop" - ) ; - send which "self" + Scheduler.add_to_queue "stop" Scheduler.OneShot 0.1 (send which "stop") ; + send which "self" () ) ; start_schedule () ; - let cnt = Mtime_clock.counter () in + + let from_wait_to_receive = Mtime_clock.counter () in Alcotest.(check string) "same event name" "self" (receive which) ; Alcotest.(check string) "same event name" "stop" (receive which) ; - let elapsed_ms = elapsed_ms cnt in - Alcotest.check is_less "small time" 300 elapsed_ms -let test_empty () = + let elapsed = Mtime_clock.count from_wait_to_receive in + let expected = Mtime.Span.(300 * ms) in + Alcotest.check mtime_span "small time" expected elapsed + +let test_empty mtime_span () = let finished = Event.new_channel () in - Scheduler.add_to_queue "one" Scheduler.OneShot 0.001 (fun () -> - send finished true - ) ; + Scheduler.add_to_queue "one" Scheduler.OneShot 0.001 (send finished true) ; start_schedule () ; Alcotest.(check bool) "finished" true (receive finished) ; (* wait loop to go to wait with no work to do *) Thread.delay 0.1 ; - Scheduler.add_to_queue "two" Scheduler.OneShot 0.001 (fun () -> - send finished true - ) ; - let cnt = Mtime_clock.counter () in + Scheduler.add_to_queue "two" Scheduler.OneShot 0.001 (send finished true) ; + + let from_wait_to_receive = Mtime_clock.counter () in Alcotest.(check bool) "finished" true (receive finished) ; - let elapsed_ms = elapsed_ms cnt in - Alcotest.check is_less "small time" 100 elapsed_ms -let test_wakeup () = + let elapsed = Mtime_clock.count from_wait_to_receive in + let expected = Mtime.Span.(100 * ms) in + Alcotest.check mtime_span "small time" expected elapsed + +let test_wakeup mtime_span () = let which = Event.new_channel () in (* schedule a long event *) - Scheduler.add_to_queue "long" Scheduler.OneShot 2.0 (fun () -> - send which "long" - ) ; + Scheduler.add_to_queue "long" Scheduler.OneShot 2.0 (send which "long") ; start_schedule () ; (* wait loop to go to wait with no work to do *) Thread.delay 0.1 ; - let cnt = Mtime_clock.counter () in + (* schedule a quick event, should wake up the loop *) - Scheduler.add_to_queue "quick" Scheduler.OneShot 0.1 (fun () -> - send which "quick" - ) ; + Scheduler.add_to_queue "quick" Scheduler.OneShot 0.1 (send which "quick") ; + + let from_wait_to_receive_quick = Mtime_clock.counter () in Alcotest.(check string) "same event name" "quick" (receive which) ; + Scheduler.remove_from_queue "long" ; - let elapsed_ms = elapsed_ms cnt in - Alcotest.check is_less "small time" 150 elapsed_ms + let elapsed = Mtime_clock.count from_wait_to_receive_quick in + let expected = Mtime.Span.(100 * ms) in + Alcotest.check mtime_span "small time" expected elapsed let tests = + let mtime_span = mtime_span () in [ ("test_single", `Quick, test_single) - ; ("test_remove_self", `Quick, test_remove_self) - ; ("test_empty", `Quick, test_empty) - ; ("test_wakeup", `Quick, test_wakeup) + ; ("test_remove_self", `Quick, test_remove_self mtime_span) + ; ("test_empty", `Quick, test_empty mtime_span) + ; ("test_wakeup", `Quick, test_wakeup mtime_span) ] let () = Alcotest.run "Scheduler" [("generic", tests)]