diff --git a/test/effect-based/dune b/test/effect-based/dune index 1d4898d3..9989823f 100644 --- a/test/effect-based/dune +++ b/test/effect-based/dune @@ -1,11 +1,11 @@ (tests (names t_fib1 t_futs1 t_many t_fib_fork_join - t_fib_fork_join_all t_sort t_fork_join) + t_fib_fork_join_all t_sort t_fork_join t_fork_join_heavy) (preprocess (action (run %{project_root}/src/cpp/cpp.exe %{input-file}))) (enabled_if (>= %{ocaml_version} 5.0)) - (libraries moonpool trace + (libraries moonpool trace trace-tef qcheck-core qcheck-core.runner ;tracy-client.trace )) diff --git a/test/effect-based/t_fork_join.ml b/test/effect-based/t_fork_join.ml index 7fc8fa31..e9110f72 100644 --- a/test/effect-based/t_fork_join.ml +++ b/test/effect-based/t_fork_join.ml @@ -326,15 +326,15 @@ let t_map ~chunk_size () = let () = QCheck_base_runner.run_tests_main [ - t_eval; - t_map ~chunk_size:1 (); - t_map ~chunk_size:50 (); - t_for_nested ~min:1 ~chunk_size:1 (); - t_for_nested ~min:4 ~chunk_size:1 (); - t_for_nested ~min:1 ~chunk_size:3 (); - t_for_nested ~min:4 ~chunk_size:3 (); + (* t_eval; *) + (* t_map ~chunk_size:1 (); *) + (* t_map ~chunk_size:50 (); *) + (* t_for_nested ~min:1 ~chunk_size:1 (); *) + (* t_for_nested ~min:4 ~chunk_size:1 (); *) + (* t_for_nested ~min:1 ~chunk_size:3 (); *) + (* t_for_nested ~min:4 ~chunk_size:3 (); *) t_for_nested ~min:1 ~chunk_size:100 (); - t_for_nested ~min:4 ~chunk_size:100 (); + (* t_for_nested ~min:4 ~chunk_size:100 (); *) ] [@@@endif] diff --git a/test/effect-based/t_fork_join_heavy.ml b/test/effect-based/t_fork_join_heavy.ml new file mode 100644 index 00000000..be86299a --- /dev/null +++ b/test/effect-based/t_fork_join_heavy.ml @@ -0,0 +1,57 @@ +[@@@ifge 5.0] + +module Q = QCheck + +let spf = Printf.sprintf +let ( let@ ) = ( @@ ) +let ppl = Q.Print.(list @@ list int) + +open! Moonpool + +let run ~min () = + let@ _sp = + Trace.with_span ~__FILE__ ~__LINE__ "run" ~data:(fun () -> + [ "min", `Int min ]) + in + + Printf.printf "run with min=%d\n%!" min; + let neg x = -x in + + let chunk_size = 100 in + let l = List.init 300 (fun _ -> List.init 15 (fun i -> i)) in + + let ref_l1 = List.map (List.map neg) l in + let ref_l2 = List.map (List.map neg) ref_l1 in + + for _i = 1 to 800 do + let@ _sp = Trace.with_span ~__FILE__ ~__LINE__ "step" in + + let l1, l2 = + let@ pool = Pool.with_ ~min () in + let@ () = Pool.run_wait_block pool in + + let l1, l2 = + Fork_join.both + (fun () -> + Fork_join.map_list ~chunk_size + (Fork_join.map_list ~chunk_size neg) + l) + (fun () -> + Fork_join.map_list ~chunk_size + (Fork_join.map_list ~chunk_size neg) + ref_l1) + in + l1, l2 + in + + if l1 <> ref_l1 then failwith (spf "l1=%s, ref_l1=%s" (ppl l1) (ppl ref_l1)); + if l2 <> ref_l2 then failwith (spf "l1=%s, ref_l1=%s" (ppl l2) (ppl ref_l2)) + done + +let () = + let@ () = Trace_tef.with_setup () in + run ~min:4 (); + run ~min:1 (); + Printf.printf "done\n%!" + +[@@@endif]