Skip to content

Commit e55ace1

Browse files
jmidjmid
authored
Merge pull request #469 from ocaml-multicore/add-gc-tests
Add gc tests
2 parents 9a80ce8 + d7ab558 commit e55ace1

11 files changed

+661
-0
lines changed

‎src/gc/dune‎

Lines changed: 81 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,81 @@
1+
;; Tests of the stdlib Gc module
2+
3+
(library
4+
(name pagesize)
5+
(modules pagesize)
6+
(foreign_stubs
7+
(language c)
8+
(names pagesizestub)
9+
(flags (:standard)))
10+
)
11+
12+
(test
13+
(name stm_tests_seq)
14+
(modules stm_tests_spec stm_tests_seq)
15+
(package multicoretests)
16+
(flags (:standard -w -37))
17+
(libraries pagesize qcheck-stm.sequential)
18+
(action
19+
(setenv OCAMLRUNPARAM "%{env:OCAMLRUNPARAM=b},v=1"
20+
(run %{test} --verbose)))
21+
)
22+
23+
(test
24+
(name stm_tests_seq_child)
25+
(modules stm_tests_spec stm_tests_seq_child)
26+
(package multicoretests)
27+
(flags (:standard -w -37))
28+
(libraries pagesize qcheck-stm.sequential)
29+
(action
30+
(setenv OCAMLRUNPARAM "%{env:OCAMLRUNPARAM=b},v=1"
31+
(run %{test} --verbose)))
32+
)
33+
34+
(test
35+
(name stm_tests_par)
36+
(modules stm_tests_spec stm_tests_par)
37+
(package multicoretests)
38+
(flags (:standard -w -37))
39+
(libraries pagesize qcheck-stm.domain)
40+
(action
41+
(setenv OCAMLRUNPARAM "%{env:OCAMLRUNPARAM=b},v=1"
42+
(run %{test} --verbose)))
43+
)
44+
45+
(test
46+
(name stm_tests_par_stress)
47+
(modules stm_tests_spec stm_tests_par_stress)
48+
(package multicoretests)
49+
(flags (:standard -w -37))
50+
(libraries pagesize qcheck-stm.domain)
51+
(action
52+
(setenv OCAMLRUNPARAM "%{env:OCAMLRUNPARAM=b},v=1"
53+
(run %{test} --verbose)))
54+
)
55+
56+
(test
57+
(name stm_tests_impl_seq)
58+
(modules stm_tests_spec stm_tests_impl_seq)
59+
(package multicoretests)
60+
(flags (:standard -w -37))
61+
(libraries pagesize qcheck-stm.sequential)
62+
(action (run %{test} --verbose))
63+
)
64+
65+
(test
66+
(name stm_tests_impl_seq_child)
67+
(modules stm_tests_spec stm_tests_impl_seq_child)
68+
(package multicoretests)
69+
(flags (:standard -w -37))
70+
(libraries pagesize qcheck-stm.sequential)
71+
(action (run %{test} --verbose))
72+
)
73+
74+
(test
75+
(name stm_tests_impl_par)
76+
(modules stm_tests_spec stm_tests_impl_par)
77+
(package multicoretests)
78+
(flags (:standard -w -37))
79+
(libraries pagesize qcheck-stm.domain)
80+
(action (run %{test} --verbose))
81+
)

‎src/gc/pagesize.ml‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
external get : unit -> int = "page_size"

‎src/gc/pagesizestub.c‎

Lines changed: 27 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,27 @@
1+
#ifdef _WIN32
2+
#define WIN32_LEAN_AND_MEAN
3+
#include <windows.h>
4+
#include <sysinfoapi.h>
5+
#else
6+
#include <unistd.h>
7+
#endif
8+
9+
#include "caml/mlvalues.h"
10+
#include "caml/memory.h"
11+
12+
CAMLprim value page_size(value ignored) {
13+
CAMLparam1(ignored);
14+
CAMLlocal1(result);
15+
16+
long ps;
17+
#ifdef _WIN32
18+
SYSTEM_INFO si;
19+
GetSystemInfo(&si);
20+
ps = si.dwPageSize;
21+
#else
22+
ps = sysconf(_SC_PAGESIZE); // page size in bytes
23+
#endif
24+
25+
result = Val_int(ps);
26+
CAMLreturn(result);
27+
}

‎src/gc/stm_tests_impl_par.ml‎

Lines changed: 15 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,15 @@
1+
(* parallel tests of the GC, without explicit Gc invocations *)
2+
3+
module ImplGCConf =
4+
struct
5+
include Stm_tests_spec
6+
let arb_cmd = arb_alloc_cmd
7+
end
8+
9+
module GC_STM_dom = STM_domain.Make(ImplGCConf)
10+
11+
let _ =
12+
Printf.printf "Page size: %i\n" (Pagesize.get ());
13+
QCheck_base_runner.run_tests_main [
14+
GC_STM_dom.agree_test_par ~count:1000 ~name:"STM implicit Gc test parallel";
15+
]

‎src/gc/stm_tests_impl_seq.ml‎

Lines changed: 25 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,25 @@
1+
open QCheck
2+
3+
(* sequential tests of the GC, without explicit Gc invocations *)
4+
5+
module ImplGCConf =
6+
struct
7+
include Stm_tests_spec
8+
let arb_cmd = arb_alloc_cmd
9+
end
10+
11+
module GC_STM_seq = STM_sequential.Make(ImplGCConf)
12+
13+
let agree_prop cs = match Util.protect GC_STM_seq.agree_prop cs with
14+
| Ok r -> r
15+
| Error Stack_overflow -> true (* Stack_overflow is accepted behaviour *)
16+
| Error e -> raise e
17+
18+
let agree_test ~count ~name =
19+
Test.make ~name ~count (GC_STM_seq.arb_cmds ImplGCConf.init_state) agree_prop
20+
21+
let _ =
22+
Printf.printf "Page size: %i\n" (Pagesize.get ());
23+
QCheck_base_runner.run_tests_main [
24+
agree_test ~count:1000 ~name:"STM implicit Gc test sequential";
25+
]

‎src/gc/stm_tests_impl_seq_child.ml‎

Lines changed: 26 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,26 @@
1+
open QCheck
2+
3+
(* sequential tests of the GC, without explicit Gc invocations *)
4+
5+
module ImplGCConf =
6+
struct
7+
include Stm_tests_spec
8+
let arb_cmd = arb_alloc_cmd
9+
end
10+
11+
module GC_STM_seq = STM_sequential.Make(ImplGCConf)
12+
13+
(* Run seq. property in a child domain to stresstest parent-child GC *)
14+
let agree_child_prop cs = match Domain.spawn (fun () -> Util.protect GC_STM_seq.agree_prop cs) |> Domain.join with
15+
| Ok r -> r
16+
| Error Stack_overflow -> true (* Stack_overflow is accepted behaviour *)
17+
| Error e -> raise e
18+
19+
let agree_child_test ~count ~name =
20+
Test.make ~name ~count (GC_STM_seq.arb_cmds ImplGCConf.init_state) agree_child_prop
21+
22+
let _ =
23+
Printf.printf "Page size: %i\n" (Pagesize.get ());
24+
QCheck_base_runner.run_tests_main [
25+
agree_child_test ~count:1000 ~name:"STM implicit Gc test sequential in child domain";
26+
]

‎src/gc/stm_tests_par.ml‎

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,9 @@
1+
(* parallel tests of the GC with explicit Gc invocations *)
2+
3+
module GC_STM_dom = STM_domain.Make(Stm_tests_spec)
4+
5+
let _ =
6+
Printf.printf "Page size: %i\n" (Pagesize.get ());
7+
QCheck_base_runner.run_tests_main [
8+
GC_STM_dom.neg_agree_test_par ~count:1000 ~name:"STM Gc test parallel";
9+
]

‎src/gc/stm_tests_par_stress.ml‎

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,9 @@
1+
(* parallel stress tests of the GC with explicit Gc invocations *)
2+
3+
module GC_STM_dom = STM_domain.Make(Stm_tests_spec)
4+
5+
let _ =
6+
Printf.printf "Page size: %i\n" (Pagesize.get ());
7+
QCheck_base_runner.run_tests_main [
8+
GC_STM_dom.stress_test_par ~count:1000 ~name:"STM Gc stress test parallel";
9+
]

‎src/gc/stm_tests_seq.ml‎

Lines changed: 19 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,19 @@
1+
open QCheck
2+
3+
(* sequential tests of the GC with explicit Gc invocations *)
4+
5+
module GC_STM_seq = STM_sequential.Make(Stm_tests_spec)
6+
7+
let agree_prop cs = match Util.protect GC_STM_seq.agree_prop cs with
8+
| Ok r -> r
9+
| Error Stack_overflow -> true (* Stack_overflow is accepted behaviour *)
10+
| Error e -> raise e
11+
12+
let agree_test ~count ~name =
13+
Test.make ~name ~count (GC_STM_seq.arb_cmds Stm_tests_spec.init_state) agree_prop
14+
15+
let _ =
16+
Printf.printf "Page size: %i\n" (Pagesize.get ());
17+
QCheck_base_runner.run_tests_main [
18+
agree_test ~count:1000 ~name:"STM Gc test sequential";
19+
]

‎src/gc/stm_tests_seq_child.ml‎

Lines changed: 20 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,20 @@
1+
open QCheck
2+
3+
(* sequential tests of the GC with explicit Gc invocations *)
4+
5+
module GC_STM_seq = STM_sequential.Make(Stm_tests_spec)
6+
7+
(* Run seq. property in a child domain to stresstest parent-child GC *)
8+
let agree_child_prop cs = match Domain.spawn (fun () -> Util.protect GC_STM_seq.agree_prop cs) |> Domain.join with
9+
| Ok r -> r
10+
| Error Stack_overflow -> true (* Stack_overflow is accepted behaviour *)
11+
| Error e -> raise e
12+
13+
let agree_child_test ~count ~name =
14+
Test.make ~name ~count (GC_STM_seq.arb_cmds Stm_tests_spec.init_state) agree_child_prop
15+
16+
let _ =
17+
Printf.printf "Page size: %i\n" (Pagesize.get ());
18+
QCheck_base_runner.run_tests_main [
19+
agree_child_test ~count:1000 ~name:"STM Gc test sequential in child domain";
20+
]

0 commit comments

Comments
 (0)