Skip to content

Commit

Permalink
Fix tests to pass on FreeBSD
Browse files Browse the repository at this point in the history
  • Loading branch information
polytypic committed May 23, 2024
1 parent 1cdcace commit 3ea8caf
Showing 1 changed file with 14 additions and 10 deletions.
24 changes: 14 additions & 10 deletions bench/bench_unix.ml
Original file line number Diff line number Diff line change
@@ -1,18 +1,21 @@
open Multicore_bench

let run_one ~budgetf ~n_domains () =
let n_bytes = 65536 in
let block_size = 4096 in
let n_blocks = 16 in

let init _ =
let inn, out = Unix.pipe ~cloexec:true () in
(inn, out, Bytes.create 1)
(inn, out, Bytes.create block_size, Bytes.create 1)
in
let work _ (inn, out, byte) =
let n = Unix.write out (Bytes.create n_bytes) 0 n_bytes in
assert (n = n_bytes);
for _ = 1 to n_bytes do
let n : int = Unix.read inn byte 0 1 in
assert (n = 1)
let work _ (inn, out, block, byte) =
for _ = 1 to n_blocks do
let n = Unix.write out block 0 block_size in
assert (n = block_size);
for _ = 1 to block_size do
let n : int = Unix.read inn byte 0 1 in
assert (n = 1)
done
done;
Unix.close inn;
Unix.close out
Expand All @@ -22,8 +25,9 @@ let run_one ~budgetf ~n_domains () =
Printf.sprintf "%d worker%s" n_domains (if n_domains = 1 then "" else "s")
in
Times.record ~budgetf ~n_domains ~n_warmups:1 ~n_runs_min:1 ~init ~work ()
|> Times.to_thruput_metrics ~n:(n_bytes * n_domains) ~singular:"blocking read"
~config
|> Times.to_thruput_metrics
~n:(block_size * n_blocks * n_domains)
~singular:"blocking read" ~config

let run_suite ~budgetf =
[ 1; 2; 4 ]
Expand Down

0 comments on commit 3ea8caf

Please sign in to comment.