Merge pull request #469 from ocaml-multicore/add-gc-tests

Add gc tests

Author: jmid

src/gc/dune

@@ -0,0 +1,81 @@
+;; Tests of the stdlib Gc module
+
+(library
+ (name pagesize)
+ (modules pagesize)
+ (foreign_stubs
+  (language c)
+  (names pagesizestub)
+  (flags (:standard)))
+)
+
+(test
+ (name stm_tests_seq)
+ (modules stm_tests_spec stm_tests_seq)
+ (package multicoretests)
+ (flags (:standard -w -37))
+ (libraries pagesize qcheck-stm.sequential)
+ (action
+  (setenv OCAMLRUNPARAM "%{env:OCAMLRUNPARAM=b},v=1"
+   (run %{test} --verbose)))
+)
+
+(test
+ (name stm_tests_seq_child)
+ (modules stm_tests_spec stm_tests_seq_child)
+ (package multicoretests)
+ (flags (:standard -w -37))
+ (libraries pagesize qcheck-stm.sequential)
+ (action
+  (setenv OCAMLRUNPARAM "%{env:OCAMLRUNPARAM=b},v=1"
+   (run %{test} --verbose)))
+)
+
+(test
+ (name stm_tests_par)
+ (modules stm_tests_spec stm_tests_par)
+ (package multicoretests)
+ (flags (:standard -w -37))
+ (libraries pagesize qcheck-stm.domain)
+ (action
+  (setenv OCAMLRUNPARAM "%{env:OCAMLRUNPARAM=b},v=1"
+   (run %{test} --verbose)))
+)
+
+(test
+ (name stm_tests_par_stress)
+ (modules stm_tests_spec stm_tests_par_stress)
+ (package multicoretests)
+ (flags (:standard -w -37))
+ (libraries pagesize qcheck-stm.domain)
+ (action
+  (setenv OCAMLRUNPARAM "%{env:OCAMLRUNPARAM=b},v=1"
+   (run %{test} --verbose)))
+)
+
+(test
+ (name stm_tests_impl_seq)
+ (modules stm_tests_spec stm_tests_impl_seq)
+ (package multicoretests)
+ (flags (:standard -w -37))
+ (libraries pagesize qcheck-stm.sequential)
+ (action (run %{test} --verbose))
+)
+
+(test
+ (name stm_tests_impl_seq_child)
+ (modules stm_tests_spec stm_tests_impl_seq_child)
+ (package multicoretests)
+ (flags (:standard -w -37))
+ (libraries pagesize qcheck-stm.sequential)
+ (action (run %{test} --verbose))
+)
+
+(test
+ (name stm_tests_impl_par)
+ (modules stm_tests_spec stm_tests_impl_par)
+ (package multicoretests)
+ (flags (:standard -w -37))
+ (libraries pagesize qcheck-stm.domain)
+ (action (run %{test} --verbose))
+)

src/gc/pagesize.ml

@@ -0,0 +1 @@
+external get : unit -> int = "page_size"

src/gc/pagesizestub.c

@@ -0,0 +1,27 @@
+#ifdef _WIN32
+#define WIN32_LEAN_AND_MEAN
+#include <windows.h>
+#include <sysinfoapi.h>
+#else
+#include <unistd.h>
+#endif
+
+#include "caml/mlvalues.h"
+#include "caml/memory.h"
+
+CAMLprim value page_size(value ignored) {
+  CAMLparam1(ignored);
+  CAMLlocal1(result);
+
+  long ps;
+#ifdef _WIN32
+  SYSTEM_INFO si;
+  GetSystemInfo(&si);
+  ps = si.dwPageSize;
+#else
+  ps = sysconf(_SC_PAGESIZE); // page size in bytes
+#endif
+
+  result = Val_int(ps);
+  CAMLreturn(result);
+}

src/gc/stm_tests_impl_par.ml

@@ -0,0 +1,15 @@
+(* parallel tests of the GC, without explicit Gc invocations *)
+
+module ImplGCConf =
+struct
+  include Stm_tests_spec
+  let arb_cmd = arb_alloc_cmd
+end
+
+module GC_STM_dom = STM_domain.Make(ImplGCConf)
+
+let _ =
+  Printf.printf "Page size: %i\n" (Pagesize.get ());
+  QCheck_base_runner.run_tests_main [
+    GC_STM_dom.agree_test_par ~count:1000 ~name:"STM implicit Gc test parallel";
+  ]

src/gc/stm_tests_impl_seq.ml

@@ -0,0 +1,25 @@
+open QCheck
+
+(* sequential tests of the GC, without explicit Gc invocations *)
+
+module ImplGCConf =
+struct
+  include Stm_tests_spec
+  let arb_cmd = arb_alloc_cmd
+end
+
+module GC_STM_seq = STM_sequential.Make(ImplGCConf)
+
+let agree_prop cs = match Util.protect GC_STM_seq.agree_prop cs with
+  | Ok r -> r
+  | Error Stack_overflow -> true (* Stack_overflow is accepted behaviour *)
+  | Error e -> raise e
+
+let agree_test ~count ~name =
+  Test.make ~name ~count (GC_STM_seq.arb_cmds ImplGCConf.init_state) agree_prop
+
+let _ =
+  Printf.printf "Page size: %i\n" (Pagesize.get ());
+  QCheck_base_runner.run_tests_main [
+    agree_test ~count:1000 ~name:"STM implicit Gc test sequential";
+  ]

src/gc/stm_tests_impl_seq_child.ml

@@ -0,0 +1,26 @@
+open QCheck
+
+(* sequential tests of the GC, without explicit Gc invocations *)
+
+module ImplGCConf =
+struct
+  include Stm_tests_spec
+  let arb_cmd = arb_alloc_cmd
+end
+
+module GC_STM_seq = STM_sequential.Make(ImplGCConf)
+
+(* Run seq. property in a child domain to stresstest parent-child GC *)
+let agree_child_prop cs = match Domain.spawn (fun () -> Util.protect GC_STM_seq.agree_prop cs) |> Domain.join with
+  | Ok r -> r
+  | Error Stack_overflow -> true (* Stack_overflow is accepted behaviour *)
+  | Error e -> raise e
+
+let agree_child_test ~count ~name =
+  Test.make ~name ~count (GC_STM_seq.arb_cmds ImplGCConf.init_state) agree_child_prop
+
+let _ =
+  Printf.printf "Page size: %i\n" (Pagesize.get ());
+  QCheck_base_runner.run_tests_main [
+    agree_child_test ~count:1000 ~name:"STM implicit Gc test sequential in child domain";
+  ]

src/gc/stm_tests_par.ml

@@ -0,0 +1,9 @@
+(* parallel tests of the GC with explicit Gc invocations *)
+
+module GC_STM_dom = STM_domain.Make(Stm_tests_spec)
+
+let _ =
+  Printf.printf "Page size: %i\n" (Pagesize.get ());
+  QCheck_base_runner.run_tests_main [
+    GC_STM_dom.neg_agree_test_par ~count:1000 ~name:"STM Gc test parallel";
+  ]

src/gc/stm_tests_par_stress.ml

@@ -0,0 +1,9 @@
+(* parallel stress tests of the GC with explicit Gc invocations *)
+
+module GC_STM_dom = STM_domain.Make(Stm_tests_spec)
+
+let _ =
+  Printf.printf "Page size: %i\n" (Pagesize.get ());
+  QCheck_base_runner.run_tests_main [
+    GC_STM_dom.stress_test_par    ~count:1000 ~name:"STM Gc stress test parallel";
+  ]

src/gc/stm_tests_seq.ml

@@ -0,0 +1,19 @@
+open QCheck
+
+(* sequential tests of the GC with explicit Gc invocations *)
+
+module GC_STM_seq = STM_sequential.Make(Stm_tests_spec)
+
+let agree_prop cs = match Util.protect GC_STM_seq.agree_prop cs with
+  | Ok r -> r
+  | Error Stack_overflow -> true (* Stack_overflow is accepted behaviour *)
+  | Error e -> raise e
+
+let agree_test ~count ~name =
+  Test.make ~name ~count (GC_STM_seq.arb_cmds Stm_tests_spec.init_state) agree_prop
+
+let _ =
+  Printf.printf "Page size: %i\n" (Pagesize.get ());
+  QCheck_base_runner.run_tests_main [
+    agree_test ~count:1000 ~name:"STM Gc test sequential";
+  ]

src/gc/stm_tests_seq_child.ml

@@ -0,0 +1,20 @@
+open QCheck
+
+(* sequential tests of the GC with explicit Gc invocations *)
+
+module GC_STM_seq = STM_sequential.Make(Stm_tests_spec)
+
+(* Run seq. property in a child domain to stresstest parent-child GC *)
+let agree_child_prop cs = match Domain.spawn (fun () -> Util.protect GC_STM_seq.agree_prop cs) |> Domain.join with
+  | Ok r -> r
+  | Error Stack_overflow -> true (* Stack_overflow is accepted behaviour *)
+  | Error e -> raise e
+
+let agree_child_test ~count ~name =
+  Test.make ~name ~count (GC_STM_seq.arb_cmds Stm_tests_spec.init_state) agree_child_prop
+
+let _ =
+  Printf.printf "Page size: %i\n" (Pagesize.get ());
+  QCheck_base_runner.run_tests_main [
+    agree_child_test              ~count:1000 ~name:"STM Gc test sequential in child domain";
+  ]