From c29f75efcdb4642f2d536cf5c01457bcd825cb1a Mon Sep 17 00:00:00 2001 From: Carine Morel Date: Tue, 10 Sep 2024 13:41:27 +0200 Subject: [PATCH 1/2] Add time limit for stm tests. --- .../stm_michael_scott_queue.ml | 5 +--- test/mpsc_queue/stm_mpsc_queue.ml | 4 +--- test/skiplist/stm_skiplist.ml | 4 +--- test/spsc_queue/stm_spsc_queue.ml | 4 ++-- test/stm_run/dune | 1 + test/stm_run/intf.ml | 3 +++ test/stm_run/stm_run.ocaml4.ml | 4 +++- test/stm_run/stm_run.ocaml5.ml | 4 +++- test/stm_run/util.ml | 23 +++++++++++++++++++ test/treiber_stack/stm_treiber_stack.ml | 5 +--- test/ws_deque/stm_ws_deque.ml | 4 +--- 11 files changed, 40 insertions(+), 21 deletions(-) create mode 100644 test/stm_run/util.ml diff --git a/test/michael_scott_queue/stm_michael_scott_queue.ml b/test/michael_scott_queue/stm_michael_scott_queue.ml index 702b790c..9e09425a 100644 --- a/test/michael_scott_queue/stm_michael_scott_queue.ml +++ b/test/michael_scott_queue/stm_michael_scott_queue.ml @@ -58,10 +58,7 @@ module STM_ms_queue (Queue : Ms_queues.MS_queue_tests) = struct | _, _ -> false end - let run () = - Stm_run.run ~count:500 ~verbose:true - ~name:("Saturn_lockfree." ^ Queue.name) - (module Spec) + let run () = Stm_run.run ~name:("Saturn_lockfree." ^ Queue.name) (module Spec) end let () = diff --git a/test/mpsc_queue/stm_mpsc_queue.ml b/test/mpsc_queue/stm_mpsc_queue.ml index 0182a2fa..493e2fd4 100644 --- a/test/mpsc_queue/stm_mpsc_queue.ml +++ b/test/mpsc_queue/stm_mpsc_queue.ml @@ -114,7 +114,5 @@ let () = Dom.neg_agree_test_par ~count ~name:(name ^ " parallel, negative"); ] in - Stm_run.run ~count:1000 ~name:"Saturn_lockfree.Mpsc_queue" ~verbose:true - ~make_domain - (module Spec) + Stm_run.run ~name:"Saturn_lockfree.Mpsc_queue" ~make_domain (module Spec) |> exit diff --git a/test/skiplist/stm_skiplist.ml b/test/skiplist/stm_skiplist.ml index 80bd3d9f..1c1b8801 100644 --- a/test/skiplist/stm_skiplist.ml +++ b/test/skiplist/stm_skiplist.ml @@ -64,6 +64,4 @@ module Spec = struct | _, _ -> false end -let () = - Stm_run.run ~count:1000 ~verbose:true ~name:"Lockfree.Skiplist" (module Spec) - |> exit +let () = Stm_run.run ~name:"Lockfree.Skiplist" (module Spec) |> exit diff --git a/test/spsc_queue/stm_spsc_queue.ml b/test/spsc_queue/stm_spsc_queue.ml index 4560ee43..99384a73 100644 --- a/test/spsc_queue/stm_spsc_queue.ml +++ b/test/spsc_queue/stm_spsc_queue.ml @@ -96,9 +96,9 @@ module STM_spsc (Spsc_queue : Spsc_queues.SPSC_tests) = struct Dom.neg_agree_test_par ~count ~name:(name ^ " parallel, negative"); ] in - Stm_run.run ~count:1000 + Stm_run.run ~name:("Saturn_lockfree." ^ Spsc_queue.name) - ~verbose:true ~make_domain + ~make_domain (module Spec) end diff --git a/test/stm_run/dune b/test/stm_run/dune index fb6ced2c..c95ac919 100644 --- a/test/stm_run/dune +++ b/test/stm_run/dune @@ -17,6 +17,7 @@ qcheck-stm.stm qcheck-stm.sequential qcheck-stm.thread + unix (select empty.ml from diff --git a/test/stm_run/intf.ml b/test/stm_run/intf.ml index fd300e7c..74894700 100644 --- a/test/stm_run/intf.ml +++ b/test/stm_run/intf.ml @@ -43,3 +43,6 @@ module type STM_domain = sig val agree_test_par_asym : count:int -> name:string -> QCheck.Test.t val neg_agree_test_par_asym : count:int -> name:string -> QCheck.Test.t end + +let default_count = 1_000 +let default_budgetf = 60.0 diff --git a/test/stm_run/stm_run.ocaml4.ml b/test/stm_run/stm_run.ocaml4.ml index 43af6ff1..655fd3ba 100644 --- a/test/stm_run/stm_run.ocaml4.ml +++ b/test/stm_run/stm_run.ocaml4.ml @@ -1,8 +1,10 @@ include Intf -let run ~verbose ~count ~name ?make_domain (module Spec : STM.Spec) = +let run ?(verbose = true) ?(count = default_count) ?(budgetf = default_budgetf) + ~name ?make_domain (module Spec : STM.Spec) = let module Seq = STM_sequential.Make (Spec) in let module Con = STM_thread.Make (Spec) [@alert "-experimental"] in + Util.run_with_budget ~budgetf ~count @@ fun count -> [ [ Seq.agree_test ~count ~name:(name ^ " sequential") ]; (match make_domain with diff --git a/test/stm_run/stm_run.ocaml5.ml b/test/stm_run/stm_run.ocaml5.ml index 85b0f092..67af5c41 100644 --- a/test/stm_run/stm_run.ocaml5.ml +++ b/test/stm_run/stm_run.ocaml5.ml @@ -1,6 +1,7 @@ include Intf -let run (type cmd state sut) ~verbose ~count ~name ?make_domain +let run (type cmd state sut) ?(verbose = true) ?(count = default_count) + ?(budgetf = default_budgetf) ~name ?make_domain (module Spec : STM.Spec with type cmd = cmd and type state = state @@ -10,6 +11,7 @@ let run (type cmd state sut) ~verbose ~count ~name ?make_domain module Spec = Spec include STM_domain.Make (Spec) end in + Util.run_with_budget ~budgetf ~count @@ fun count -> [ [ Seq.agree_test ~count ~name:(name ^ " sequential") ]; (match make_domain with diff --git a/test/stm_run/util.ml b/test/stm_run/util.ml new file mode 100644 index 00000000..d9710f83 --- /dev/null +++ b/test/stm_run/util.ml @@ -0,0 +1,23 @@ +let run_with_budget ~budgetf ~count run = + let state = Random.State.make_self_init () in + let start = Unix.gettimeofday () in + let rec loop ~total n = + let current = Unix.gettimeofday () in + if current -. start <= budgetf && total < count then begin + let count = + if total = 0 then n + else + let per_test = (current -. start) /. Float.of_int total in + let max_count = + Float.to_int ((start +. budgetf -. current) /. per_test) + in + Int.min (Int.min n (count - total)) max_count |> Int.max 32 + in + let seed = Random.State.full_int state Int.max_int in + QCheck_base_runner.set_seed seed; + let error_code = run count in + if error_code = 0 then loop ~total:(total + count) (n * 2) else error_code + end + else 0 + in + loop ~total:0 32 diff --git a/test/treiber_stack/stm_treiber_stack.ml b/test/treiber_stack/stm_treiber_stack.ml index 5e54de82..9b98ea4e 100644 --- a/test/treiber_stack/stm_treiber_stack.ml +++ b/test/treiber_stack/stm_treiber_stack.ml @@ -55,7 +55,4 @@ module Spec = struct | _, _ -> false end -let () = - Stm_run.run ~count:500 ~verbose:true ~name:"Saturn_lockfree.Treiber_stack" - (module Spec) - |> exit +let () = Stm_run.run ~name:"Saturn_lockfree.Treiber_stack" (module Spec) |> exit diff --git a/test/ws_deque/stm_ws_deque.ml b/test/ws_deque/stm_ws_deque.ml index 568ecccd..f12235f9 100644 --- a/test/ws_deque/stm_ws_deque.ml +++ b/test/ws_deque/stm_ws_deque.ml @@ -83,7 +83,5 @@ let () = Dom.neg_agree_test_par ~count ~name:(name ^ " parallel, negative"); ] in - Stm_run.run ~count:1000 ~name:"Saturn_lockfree.Ws_deque" ~verbose:true - ~make_domain - (module Spec) + Stm_run.run ~name:"Saturn_lockfree.Ws_deque" ~make_domain (module Spec) |> exit From 166ad288f9bec5f29d784891ffe59b6abd8302ce Mon Sep 17 00:00:00 2001 From: Vesa Karvonen Date: Wed, 11 Sep 2024 10:50:01 +0300 Subject: [PATCH 2/2] No need to skip STM tests on 32-bit --- test/michael_scott_queue/dune | 4 +--- test/mpsc_queue/dune | 4 +--- test/spsc_queue/dune | 4 +--- test/treiber_stack/dune | 4 +--- test/ws_deque/dune | 4 +--- 5 files changed, 5 insertions(+), 15 deletions(-) diff --git a/test/michael_scott_queue/dune b/test/michael_scott_queue/dune index b356e2d6..98c58674 100644 --- a/test/michael_scott_queue/dune +++ b/test/michael_scott_queue/dune @@ -57,6 +57,4 @@ (package saturn_lockfree) (name stm_michael_scott_queue) (modules stm_michael_scott_queue) - (libraries ms_queues saturn_lockfree qcheck-core qcheck-stm.stm stm_run) - (enabled_if - (= %{arch_sixtyfour} true))) + (libraries ms_queues saturn_lockfree qcheck-core qcheck-stm.stm stm_run)) diff --git a/test/mpsc_queue/dune b/test/mpsc_queue/dune index 3dc5c26f..97817a5e 100644 --- a/test/mpsc_queue/dune +++ b/test/mpsc_queue/dune @@ -33,6 +33,4 @@ qcheck-core qcheck-multicoretests-util qcheck-stm.stm - stm_run) - (enabled_if - (= %{arch_sixtyfour} true))) + stm_run)) diff --git a/test/spsc_queue/dune b/test/spsc_queue/dune index 8d1046aa..512ae2d1 100644 --- a/test/spsc_queue/dune +++ b/test/spsc_queue/dune @@ -53,6 +53,4 @@ qcheck-core qcheck-multicoretests-util qcheck-stm.stm - stm_run) - (enabled_if - (= %{arch_sixtyfour} true))) + stm_run)) diff --git a/test/treiber_stack/dune b/test/treiber_stack/dune index c0e989a2..5998e9a1 100644 --- a/test/treiber_stack/dune +++ b/test/treiber_stack/dune @@ -33,6 +33,4 @@ (package saturn_lockfree) (name stm_treiber_stack) (modules stm_treiber_stack) - (libraries saturn_lockfree qcheck-core qcheck-stm.stm stm_run) - (enabled_if - (= %{arch_sixtyfour} true))) + (libraries saturn_lockfree qcheck-core qcheck-stm.stm stm_run)) diff --git a/test/ws_deque/dune b/test/ws_deque/dune index 14895a9c..58e9931a 100644 --- a/test/ws_deque/dune +++ b/test/ws_deque/dune @@ -49,6 +49,4 @@ qcheck-core qcheck-multicoretests-util qcheck-stm.stm - stm_run) - (enabled_if - (= %{arch_sixtyfour} true))) + stm_run))