Upgrade dscheck to allow testing on OCaml 4 with ocaml-ci

Author: polytypic

.github/workflows/main.yml

@@ -46,32 +46,3 @@ jobs:
 
       - name: Test
         run: opam exec -- dune runtest
-
-  build-4_x:
-    strategy:
-      fail-fast: false
-      matrix:
-        os:
-          - ubuntu-latest
-        ocaml-compiler:
-          - 4.13.x
-          - 4.14.x
-
-    runs-on: ${{ matrix.os }}
-
-    steps:
-      - name: Check out code
-        uses: actions/checkout@v3
-
-      - name: Set up OCaml
-        uses: ocaml/setup-ocaml@v2
-        with:
-          opam-pin: false
-          opam-depext: false
-          ocaml-compiler: ${{ matrix.ocaml-compiler }}
-
-      - name: Install dependencies
-        run: opam install . --deps-only
-
-      - name: Build (release)
-        run: opam exec -- dune build --release

bench/bench_queue.ml

@@ -46,8 +46,13 @@ let run_one ~budgetf ?(n_adders = 2) ?(n_takers = 2)
         let n = Util.alloc n_msgs_to_take in
         if n <> 0 then
           let rec loop n =
-            if 0 < n then
-              loop (n - Bool.to_int (Option.is_some (Queue.pop_opt t)))
+            if 0 < n then begin
+              match Queue.pop_opt t with
+              | None ->
+                  Domain.cpu_relax ();
+                  loop n
+              | Some _ -> loop (n - 1)
+            end
             else work ()
           in
           loop n

bench/bench_relaxed_queue.ml

@@ -31,13 +31,23 @@ let run_one ~budgetf ~n_adders ~n_takers ?(n_msgs = 50 * Util.iter_factor)
               work ()
           | `Not_lockfree ->
               let rec loop n =
-                if 0 < n then loop (n - Bool.to_int (Not_lockfree.push t i))
+                if 0 < n then
+                  if Not_lockfree.push t i then loop (n - 1)
+                  else begin
+                    Domain.cpu_relax ();
+                    loop n
+                  end
                 else work ()
               in
               loop n
           | `CAS_interface ->
               let rec loop n =
-                if 0 < n then loop (n - Bool.to_int (CAS_interface.push t i))
+                if 0 < n then
+                  if CAS_interface.push t i then loop (n - 1)
+                  else begin
+                    Domain.cpu_relax ();
+                    loop n
+                  end
                 else work ()
               in
               loop n
@@ -56,15 +66,25 @@ let run_one ~budgetf ~n_adders ~n_takers ?(n_msgs = 50 * Util.iter_factor)
               work ()
           | `Not_lockfree ->
               let rec loop n =
-                if 0 < n then
-                  loop (n - Bool.to_int (Option.is_some (Not_lockfree.pop t)))
+                if 0 < n then begin
+                  match Not_lockfree.pop t with
+                  | None ->
+                      Domain.cpu_relax ();
+                      loop n
+                  | Some _ -> loop (n - 1)
+                end
                 else work ()
               in
               loop n
           | `CAS_interface ->
               let rec loop n =
-                if 0 < n then
-                  loop (n - Bool.to_int (Option.is_some (CAS_interface.pop t)))
+                if 0 < n then begin
+                  match CAS_interface.pop t with
+                  | None ->
+                      Domain.cpu_relax ();
+                      loop n
+                  | Some _ -> loop (n - 1)
+                end
                 else work ()
               in
               loop n

bench/bench_spsc_queue.ml

@@ -17,13 +17,22 @@ let run_one ~budgetf ?(size_exponent = 3) ?(n_msgs = 80 * Util.iter_factor) () =
   let work i () =
     if i = 0 then
       let rec loop n =
-        if 0 < n then loop (n - Bool.to_int (Queue.try_push t n))
+        if 0 < n then
+          if Queue.try_push t n then loop (n - 1)
+          else begin
+            Domain.cpu_relax ();
+            loop n
+          end
       in
       loop n_msgs
     else
       let rec loop n =
         if 0 < n then
-          match Queue.pop_opt t with Some _ -> loop (n - 1) | None -> loop n
+          match Queue.pop_opt t with
+          | Some _ -> loop (n - 1)
+          | None ->
+              Domain.cpu_relax ();
+              loop n
       in
       loop n_msgs
   in

bench/bench_ws_deque.ml

@@ -29,7 +29,11 @@ let run_one ~budgetf ?(n_domains = 1) () =
     | work ->
         work own;
         run own
-    | exception Exit -> if not !exit then run own
+    | exception Exit ->
+        if not !exit then begin
+          Domain.cpu_relax ();
+          run own
+        end
   in
 
   let spawn own work =
@@ -42,7 +46,9 @@ let run_one ~budgetf ?(n_domains = 1) () =
     let x = !promise in
     if x == Obj.magic exit then begin
       begin
-        match try_own own with exception Exit -> () | work -> work own
+        match try_own own with
+        | exception Exit -> Domain.cpu_relax ()
+        | work -> work own
       end;
       await own promise
     end

bench/dune

@@ -1,4 +1,15 @@
+(* -*- tuareg -*- *)
+
+let maybe_domain_shims =
+  if Jbuild_plugin.V1.ocaml_version < "5" then "domain_shims" else ""
+
+let () =
+  Jbuild_plugin.V1.send
+  @@ {|
+
 (test
  (package saturn)
  (name main)
- (libraries saturn multicore-bench multicore-magic))
+ (libraries saturn multicore-bench multicore-magic |}
+  ^ maybe_domain_shims ^ {| ))
+|}

dune-project

@@ -1,4 +1,4 @@
-(lang dune 3.2)
+(lang dune 3.9)
 (name saturn)
 (generate_opam_files true)
 (implicit_transitive_deps false)
@@ -16,12 +16,13 @@
   (saturn_lockfree (= :version))
   (multicore-magic (and (>= 2.1.0) :with-test))
   (multicore-bench (and (>= 0.1.0) :with-test))
+  (backoff (and (>= 0.1.0) :with-test))
   (alcotest (and (>= 1.7.0) :with-test))
   (qcheck (and (>= 0.21.3) :with-test))
   (qcheck-stm (and (>= 0.3) :with-test))
   (qcheck-alcotest (and (>= 0.21.3) :with-test))
   (yojson (and (>= 2.0.2) :with-test))
-  (dscheck (and (>= 0.2.0) :with-test))))
+  (dscheck (and (>= 0.4.0) :with-test))))
 (package
  (name saturn_lockfree)
  (synopsis "Collection of lock-free data structures for Multicore OCaml")
@@ -37,4 +38,4 @@
   (qcheck-multicoretests-util (and (>= 0.3) :with-test))
   (qcheck-alcotest (and (>= 0.21.3) :with-test))
   (yojson (and (>= 2.0.2) :with-test))
-  (dscheck (and (>= 0.2.0) :with-test))))
+  (dscheck (and (>= 0.4.0) :with-test))))

saturn.opam

@@ -9,18 +9,19 @@ homepage: "https://github.com/ocaml-multicore/saturn"
 doc: "https://ocaml-multicore.github.io/saturn/"
 bug-reports: "https://github.com/ocaml-multicore/saturn/issues"
 depends: [
-  "dune" {>= "3.2"}
+  "dune" {>= "3.9"}
   "ocaml" {>= "4.13"}
   "domain_shims" {>= "0.1.0" & with-test}
   "saturn_lockfree" {= version}
   "multicore-magic" {>= "2.1.0" & with-test}
   "multicore-bench" {>= "0.1.0" & with-test}
+  "backoff" {>= "0.1.0" & with-test}
   "alcotest" {>= "1.7.0" & with-test}
   "qcheck" {>= "0.21.3" & with-test}
   "qcheck-stm" {>= "0.3" & with-test}
   "qcheck-alcotest" {>= "0.21.3" & with-test}
   "yojson" {>= "2.0.2" & with-test}
-  "dscheck" {>= "0.2.0" & with-test}
+  "dscheck" {>= "0.4.0" & with-test}
   "odoc" {with-doc}
 ]
 build: [

saturn_lockfree.opam

@@ -8,7 +8,7 @@ homepage: "https://github.com/ocaml-multicore/saturn"
 doc: "https://ocaml-multicore.github.io/saturn/"
 bug-reports: "https://github.com/ocaml-multicore/saturn/issues"
 depends: [
-  "dune" {>= "3.2"}
+  "dune" {>= "3.9"}
   "ocaml" {>= "4.13"}
   "domain_shims" {>= "0.1.0" & with-test}
   "backoff" {>= "0.1.0"}
@@ -20,7 +20,7 @@ depends: [
   "qcheck-multicoretests-util" {>= "0.3" & with-test}
   "qcheck-alcotest" {>= "0.21.3" & with-test}
   "yojson" {>= "2.0.2" & with-test}
-  "dscheck" {>= "0.2.0" & with-test}
+  "dscheck" {>= "0.4.0" & with-test}
   "odoc" {with-doc}
 ]
 build: [

src/domain.ocaml4.ml

@@ -0,0 +1 @@
+let cpu_relax = Thread.yield