mirror of
https://github.com/c-cube/moonpool.git
synced 2026-03-07 13:27:56 -05:00
update to trace 0.11 and qcheck 0.21
This commit is contained in:
parent
1136191850
commit
18701bfde4
9 changed files with 46 additions and 40 deletions
30
dune-project
30
dune-project
|
|
@ -28,12 +28,18 @@
|
|||
dune
|
||||
(either
|
||||
(>= 1.0))
|
||||
(trace :with-test)
|
||||
(trace-tef :with-test)
|
||||
(qcheck-core
|
||||
(and
|
||||
:with-test
|
||||
(>= 0.19)))
|
||||
(trace
|
||||
(and
|
||||
(>= 0.11)
|
||||
:with-test))
|
||||
(trace-tef
|
||||
(and
|
||||
(>= 0.11)
|
||||
:with-test))
|
||||
(qcheck-core
|
||||
(and
|
||||
:with-test
|
||||
(>= 0.21)))
|
||||
(thread-local-storage
|
||||
(and
|
||||
(>= 0.2)
|
||||
|
|
@ -71,12 +77,18 @@
|
|||
(qcheck-core
|
||||
(and
|
||||
:with-test
|
||||
(>= 0.19)))
|
||||
(>= 0.21)))
|
||||
(hmap :with-test)
|
||||
(lwt (and (>= 5.0) (< 6.0)))
|
||||
base-unix
|
||||
(trace :with-test)
|
||||
(trace-tef :with-test)
|
||||
(trace
|
||||
(and
|
||||
(>= 0.11)
|
||||
:with-test))
|
||||
(trace-tef
|
||||
(and
|
||||
(>= 0.11)
|
||||
:with-test))
|
||||
(odoc :with-doc)))
|
||||
|
||||
; See the complete stanza docs at https://dune.readthedocs.io/en/stable/dune-files.html#dune-project
|
||||
|
|
|
|||
|
|
@ -11,12 +11,12 @@ depends: [
|
|||
"dune" {>= "3.0"}
|
||||
"moonpool" {= version}
|
||||
"ocaml" {>= "5.0"}
|
||||
"qcheck-core" {with-test & >= "0.19"}
|
||||
"qcheck-core" {with-test & >= "0.21"}
|
||||
"hmap" {with-test}
|
||||
"lwt" {>= "5.0" & < "6.0"}
|
||||
"base-unix"
|
||||
"trace" {with-test}
|
||||
"trace-tef" {with-test}
|
||||
"trace" {>= "0.11" & with-test}
|
||||
"trace-tef" {>= "0.11" & with-test}
|
||||
"odoc" {with-doc}
|
||||
]
|
||||
build: [
|
||||
|
|
|
|||
|
|
@ -12,9 +12,9 @@ depends: [
|
|||
"ocaml" {>= "5.0"}
|
||||
"dune" {>= "3.0"}
|
||||
"either" {>= "1.0"}
|
||||
"trace" {with-test}
|
||||
"trace-tef" {with-test}
|
||||
"qcheck-core" {with-test & >= "0.19"}
|
||||
"trace" {>= "0.11" & with-test}
|
||||
"trace-tef" {>= "0.11" & with-test}
|
||||
"qcheck-core" {with-test & >= "0.21"}
|
||||
"thread-local-storage" {>= "0.2" & < "0.3"}
|
||||
"odoc" {with-doc}
|
||||
"hmap" {with-test}
|
||||
|
|
|
|||
|
|
@ -171,7 +171,7 @@ module Evaluator = struct
|
|||
|
||||
let gen_fun =
|
||||
Q.Gen.(
|
||||
frequency
|
||||
oneof_weighted
|
||||
[
|
||||
( 2,
|
||||
let+ n = 0 -- 100 in
|
||||
|
|
@ -190,7 +190,7 @@ module Evaluator = struct
|
|||
abs x
|
||||
in
|
||||
let open Q.Gen in
|
||||
frequency
|
||||
oneof_weighted
|
||||
[
|
||||
( 1,
|
||||
let+ x = 1 -- 10000 in
|
||||
|
|
@ -208,13 +208,13 @@ module Evaluator = struct
|
|||
let+ f = gen_fun
|
||||
and+ csize = 1 -- 16
|
||||
and+ l = list_size (0 -- 290) (gen 1)
|
||||
and+ r = oneofl [ R_add; R_max; R_add_shift ] in
|
||||
and+ r = oneof_list [ R_add; R_max; R_add_shift ] in
|
||||
Map_arr (csize, f, l, r) );
|
||||
( clamp_if_base 2,
|
||||
let+ f = gen_fun
|
||||
and+ csize = 1 -- 3
|
||||
and+ l = list_size (1 -- 7) (gen (min 3 (n - 1)))
|
||||
and+ r = oneofl [ R_add; R_max; R_add_shift ] in
|
||||
and+ r = oneof_list [ R_add; R_max; R_add_shift ] in
|
||||
Map_arr (csize, f, l, r) );
|
||||
]
|
||||
|
||||
|
|
@ -280,7 +280,7 @@ let t_for_nested ~min ~chunk_size () =
|
|||
let neg x = -x in
|
||||
Q.Test.make
|
||||
~name:(spf "t_for_nested ~min:%d" min)
|
||||
Q.(small_list (small_list small_int))
|
||||
Q.(list_small (list_small nat_small))
|
||||
(fun l ->
|
||||
let ref_l1 = List.map (List.map neg) l in
|
||||
let ref_l2 = List.map (List.map neg) ref_l1 in
|
||||
|
|
@ -302,7 +302,7 @@ let t_for_nested ~min ~chunk_size () =
|
|||
let t_map ~chunk_size () =
|
||||
let ppa = Q.Print.(array string) in
|
||||
Q.Test.make ~name:"map1"
|
||||
Q.(small_list small_int |> Q.set_stats [ "len", List.length ])
|
||||
Q.(list_small nat_small |> Q.set_stats [ "len", List.length ])
|
||||
(fun l ->
|
||||
let@ pool = Ws_pool.with_ ~num_threads:4 () in
|
||||
let@ () = Ws_pool.run_wait_block pool in
|
||||
|
|
|
|||
|
|
@ -25,7 +25,7 @@ let main ~port ~n ~n_conn ~verbose ~msg_per_conn () : unit =
|
|||
|
||||
let@ () = M_lwt.spawn_lwt in
|
||||
let _sp =
|
||||
Trace.enter_manual_span ~parent:None ~__FILE__ ~__LINE__ "connect.client"
|
||||
Trace.enter_span ~parent:None ~__FILE__ ~__LINE__ "connect.client"
|
||||
in
|
||||
Trace.message "connecting new client…";
|
||||
|
||||
|
|
@ -43,9 +43,7 @@ let main ~port ~n ~n_conn ~verbose ~msg_per_conn () : unit =
|
|||
|
||||
for _j = 1 to msg_per_conn do
|
||||
let _sp =
|
||||
Trace.enter_manual_span
|
||||
~parent:(Some (Trace.ctx_of_span _sp))
|
||||
~__FILE__ ~__LINE__ "write.loop"
|
||||
Trace.enter_span ~parent:(Some _sp) ~__FILE__ ~__LINE__ "write.loop"
|
||||
in
|
||||
|
||||
let s = spf "hello %d" _j in
|
||||
|
|
@ -57,10 +55,10 @@ let main ~port ~n ~n_conn ~verbose ~msg_per_conn () : unit =
|
|||
Lwt_io.read_into_exactly ic buf 0 (String.length s) |> await_lwt;
|
||||
if verbose then
|
||||
Printf.printf "read: %s\n%!" (Bytes.sub_string buf 0 (String.length s));
|
||||
Trace.exit_manual_span _sp;
|
||||
Trace.exit_span _sp;
|
||||
()
|
||||
done;
|
||||
Trace.exit_manual_span _sp
|
||||
Trace.exit_span _sp
|
||||
in
|
||||
|
||||
(* start the first [n_conn] tasks *)
|
||||
|
|
|
|||
|
|
@ -22,7 +22,7 @@ let main ~port ~verbose ~runner:_ () : unit =
|
|||
let handle_client client_addr (ic, oc) : _ Lwt.t =
|
||||
let@ () = M_lwt.spawn_lwt in
|
||||
let _sp =
|
||||
Trace.enter_manual_span ~parent:None ~__FILE__ ~__LINE__ "handle.client"
|
||||
Trace.enter_span ~parent:None ~__FILE__ ~__LINE__ "handle.client"
|
||||
~data:(fun () -> [ "addr", `String (str_of_sockaddr client_addr) ])
|
||||
in
|
||||
|
||||
|
|
@ -45,7 +45,7 @@ let main ~port ~verbose ~runner:_ () : unit =
|
|||
done;
|
||||
if verbose then
|
||||
Printf.printf "done with client on %s\n%!" (str_of_sockaddr client_addr);
|
||||
Trace.exit_manual_span _sp;
|
||||
Trace.exit_span _sp;
|
||||
Trace.message "exit handle client"
|
||||
in
|
||||
|
||||
|
|
|
|||
|
|
@ -21,9 +21,7 @@ let main ~port ~ext ~dir ~n_conn () : unit =
|
|||
(* TODO: *)
|
||||
let run_task () : unit Lwt.t =
|
||||
let@ () = M_lwt.spawn_lwt in
|
||||
let _sp =
|
||||
Trace.enter_manual_span ~parent:None ~__FILE__ ~__LINE__ "run-task"
|
||||
in
|
||||
let _sp = Trace.enter_span ~parent:None ~__FILE__ ~__LINE__ "run-task" in
|
||||
|
||||
let seen = Str_tbl.create 16 in
|
||||
|
||||
|
|
@ -35,9 +33,7 @@ let main ~port ~ext ~dir ~n_conn () : unit =
|
|||
()
|
||||
else if Sys.is_directory file then (
|
||||
let _sp =
|
||||
Trace.enter_manual_span
|
||||
~parent:(Some (Trace.ctx_of_span _sp))
|
||||
~__FILE__ ~__LINE__ "walk-dir"
|
||||
Trace.enter_span ~parent:(Some _sp) ~__FILE__ ~__LINE__ "walk-dir"
|
||||
~data:(fun () -> [ "d", `String file ])
|
||||
in
|
||||
|
||||
|
|
@ -55,7 +51,7 @@ let main ~port ~ext ~dir ~n_conn () : unit =
|
|||
)
|
||||
in
|
||||
walk dir;
|
||||
Trace.exit_manual_span _sp
|
||||
Trace.exit_span _sp
|
||||
in
|
||||
|
||||
(* start the first [n_conn] tasks *)
|
||||
|
|
|
|||
|
|
@ -167,7 +167,7 @@ let main ~port ~runner () : unit =
|
|||
let handle_client client_addr (ic, oc) =
|
||||
let@ () = Moonpool_lwt.spawn_lwt in
|
||||
let _sp =
|
||||
Trace.enter_manual_span ~parent:None ~__FILE__ ~__LINE__ "handle.client"
|
||||
Trace.enter_span ~parent:None ~__FILE__ ~__LINE__ "handle.client"
|
||||
~data:(fun () -> [ "addr", `String (str_of_sockaddr client_addr) ])
|
||||
in
|
||||
|
||||
|
|
@ -199,7 +199,7 @@ let main ~port ~runner () : unit =
|
|||
Lwt_io.flush oc |> await_lwt
|
||||
done
|
||||
with End_of_file | Unix.Unix_error (Unix.ECONNRESET, _, _) ->
|
||||
Trace.exit_manual_span _sp;
|
||||
Trace.exit_span _sp;
|
||||
Trace.message "exit handle client"
|
||||
in
|
||||
|
||||
|
|
|
|||
|
|
@ -13,7 +13,7 @@ let with_pool ~kind () f =
|
|||
let () =
|
||||
add_test @@ fun ~kind ->
|
||||
Q.Test.make ~name:"map then join_list"
|
||||
Q.(small_list small_int)
|
||||
Q.(list_small nat_small)
|
||||
(fun l ->
|
||||
let@ pool = with_pool ~kind () in
|
||||
let l' = List.map (fun x -> Fut.spawn ~on:pool (fun () -> x + 1)) l in
|
||||
|
|
@ -24,7 +24,7 @@ let () =
|
|||
let () =
|
||||
add_test @@ fun ~kind ->
|
||||
Q.Test.make ~name:"map bind"
|
||||
Q.(small_list small_int)
|
||||
Q.(list_small nat_small)
|
||||
(fun l ->
|
||||
let@ pool = with_pool ~kind () in
|
||||
let open Fut.Infix in
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue