diff --git a/ocaml/libs/http-lib/bufio_test.ml b/ocaml/libs/http-lib/bufio_test.ml index b35c55381de..7937adc73ea 100644 --- a/ocaml/libs/http-lib/bufio_test.ml +++ b/ocaml/libs/http-lib/bufio_test.ml @@ -21,7 +21,30 @@ let test_buf_io = let gen = Gen.tup2 Generate.t timeouts and print = Print.tup2 Generate.print print_timeout in Test.make ~name:__FUNCTION__ ~print gen @@ fun (behaviour, timeout) -> + let every_bytes = + Int.min + (Option.map Observations.Delay.every_bytes behaviour.delay_read + |> Option.value ~default:Int.max_int + ) + (Option.map Observations.Delay.every_bytes behaviour.delay_write + |> Option.value ~default:Int.max_int + ) + in + let operations = Int.max 1 (behaviour.size / every_bytes) in + (* Buf_io uses per-operation timeouts, not a timeout for the whole function, + so if we want a timeout of 0.1s and we insert some delays every 1 byte, + for 64KiB bytes in total, then we need 0.1/65536 timeout for individual operations. + + timeout_span remains the span for the entire function, + and timeout the per operation timeout that we'll pass to the function under test. + *) let timeout_span = Mtime.Span.of_float_ns (timeout *. 1e9) |> Option.get in + let timeout = timeout /. float operations in + let timeout_operation_span = + Mtime.Span.of_float_ns (timeout *. 1e9) |> Option.get + in + (* timeout < 1us would get truncated to 0 *) + QCheck2.assume (timeout > 1e-6) ; (* Format.eprintf "Testing %s@." (print (behaviour, timeout)); *) if behaviour.kind <> Unix.S_SOCK then QCheck2.assume_fail () ; @@ -59,7 +82,7 @@ let test_buf_io = expect_string ~expected:write.data ~actual | {write= Some _; _}, Error (`Exn_trap (Buf_io.Timeout, _)) -> let elapsed = !test_elapsed in - if Mtime.Span.compare elapsed timeout_span < 0 then + if Mtime.Span.compare elapsed timeout_operation_span < 0 then Test.fail_reportf "Timed out earlier than requested: %a < %a" Mtime.Span.pp elapsed Mtime.Span.pp timeout_span | ( {write= Some write; _} diff --git a/ocaml/libs/xapi-stdext/lib/xapi-fd-test/generate.ml b/ocaml/libs/xapi-stdext/lib/xapi-fd-test/generate.ml index b3d28b15c4d..96cd2a897e6 100644 --- a/ocaml/libs/xapi-stdext/lib/xapi-fd-test/generate.ml +++ b/ocaml/libs/xapi-stdext/lib/xapi-fd-test/generate.ml @@ -62,8 +62,12 @@ let delay_of_size total_delay size = let open Gen in let* every_bytes = if size = 0 then return 1 else 1 -- size in let chunks = max 1 (size / every_bytes) in - let duration = total_delay /. float_of_int chunks |> span_of_s in - return @@ Some (Delay.v ~every_bytes ~duration) + let duration = total_delay /. float_of_int chunks in + if duration < 1e-6 then + return None + else + let duration = duration |> span_of_s in + return @@ Some (Delay.v ~every_bytes ~duration) let t = let open Gen in diff --git a/ocaml/libs/xapi-stdext/lib/xapi-fd-test/observations.ml b/ocaml/libs/xapi-stdext/lib/xapi-fd-test/observations.ml index 32213b6de98..d9320234c38 100644 --- a/ocaml/libs/xapi-stdext/lib/xapi-fd-test/observations.ml +++ b/ocaml/libs/xapi-stdext/lib/xapi-fd-test/observations.ml @@ -158,7 +158,9 @@ module CancellableSleep = struct ; buf= Bytes.make 1 ' ' } - let set_rcvtimeo sock timeo = setsockopt_float sock Unix.SO_RCVTIMEO timeo + let set_rcvtimeo sock timeo = + if timeo < 1e-6 then Fmt.invalid_arg "timeout too short: %g" timeo ; + setsockopt_float sock Unix.SO_RCVTIMEO timeo let sleep t dt = set_rcvtimeo t.wait (Mtime.Span.to_float_ns dt *. 1e-9) ; @@ -173,6 +175,8 @@ end module Delay = struct type t = {duration: Mtime.span; every_bytes: int} + let every_bytes t = t.every_bytes + let pp = Fmt.( record ~sep:(any ";") diff --git a/ocaml/libs/xapi-stdext/lib/xapi-fd-test/observations.mli b/ocaml/libs/xapi-stdext/lib/xapi-fd-test/observations.mli index 2e4ecb6b7d0..4300f5d56d7 100644 --- a/ocaml/libs/xapi-stdext/lib/xapi-fd-test/observations.mli +++ b/ocaml/libs/xapi-stdext/lib/xapi-fd-test/observations.mli @@ -109,6 +109,9 @@ module Delay : sig Note that the time taken to send or receive [after_bytes] is not taken into account to guarantee the insertion of the delay. *) + val every_bytes : t -> int + (** [every_bytes t] is how often delays are inserted *) + val apply_read : CancellableSleep.t -> t