From 480029b010decd3e913cfcb3c9c2669327a4b9b3 Mon Sep 17 00:00:00 2001 From: Jan Midtgaard Date: Tue, 23 May 2023 10:34:51 +0200 Subject: [PATCH 01/10] Adjust test/task_one_dep.ml PBTs based on recommended_domain_count --- test/task_one_dep.ml | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/test/task_one_dep.ml b/test/task_one_dep.ml index c2b37fa..26506fe 100644 --- a/test/task_one_dep.ml +++ b/test/task_one_dep.ml @@ -140,8 +140,10 @@ let test_two_nested_pools ~domain_bound ~promise_bound = true) let () = + let domain_bound = max 1 (Domain.recommended_domain_count () / 2) in + let promise_bound = max 2 domain_bound in QCheck_base_runner.run_tests_main [ - test_one_pool ~domain_bound:8 ~promise_bound:10; - test_two_pools_sync_last ~domain_bound:2 ~promise_bound:2; - test_two_nested_pools ~domain_bound:8 ~promise_bound:10; + test_one_pool ~domain_bound ~promise_bound; + test_two_pools_sync_last ~domain_bound ~promise_bound; + test_two_nested_pools ~domain_bound ~promise_bound; ] From bd42572bb3880570ad7ae735734d1e8217de9d5a Mon Sep 17 00:00:00 2001 From: Jan Midtgaard Date: Thu, 25 May 2023 11:44:16 +0200 Subject: [PATCH 02/10] Make Failure"failed to allocate domain" an acceptable behaviour --- test/task_one_dep.ml | 46 +++++++++++++++++++++++++------------------- 1 file changed, 26 insertions(+), 20 deletions(-) diff --git a/test/task_one_dep.ml b/test/task_one_dep.ml index 26506fe..73ad45a 100644 --- a/test/task_one_dep.ml +++ b/test/task_one_dep.ml @@ -111,15 +111,18 @@ let test_two_pools_sync_last ~domain_bound ~promise_bound = (pair gen gen) (Util.repeat 10 @@ fun (input1,input2) -> - let pool1 = Task.setup_pool ~num_domains:input1.num_domains () in - let pool2 = Task.setup_pool ~num_domains:input2.num_domains () in - let ps1 = build_dep_graph pool1 input1 in - let ps2 = build_dep_graph pool2 input2 in - Task.run pool1 (fun () -> List.iter (fun p -> Task.await pool1 p) ps1); - Task.run pool2 (fun () -> List.iter (fun p -> Task.await pool2 p) ps2); - Task.teardown_pool pool1; - Task.teardown_pool pool2; - true) + try + let pool1 = Task.setup_pool ~num_domains:input1.num_domains () in + let pool2 = Task.setup_pool ~num_domains:input2.num_domains () in + let ps1 = build_dep_graph pool1 input1 in + let ps2 = build_dep_graph pool2 input2 in + Task.run pool1 (fun () -> List.iter (fun p -> Task.await pool1 p) ps1); + Task.run pool2 (fun () -> List.iter (fun p -> Task.await pool2 p) ps2); + Task.teardown_pool pool1; + Task.teardown_pool pool2; + true + with + Failure err -> err = "failed to allocate domain") let test_two_nested_pools ~domain_bound ~promise_bound = let gen = arb_deps domain_bound promise_bound in @@ -127,17 +130,20 @@ let test_two_nested_pools ~domain_bound ~promise_bound = (pair gen gen) (Util.repeat 10 @@ fun (input1,input2) -> - let pool1 = Task.setup_pool ~num_domains:input1.num_domains () in - let pool2 = Task.setup_pool ~num_domains:input2.num_domains () in - Task.run pool1 (fun () -> - Task.run pool2 (fun () -> - let ps1 = build_dep_graph pool1 input1 in - let ps2 = build_dep_graph pool2 input2 in - List.iter (fun p -> Task.await pool1 p) ps1; - List.iter (fun p -> Task.await pool2 p) ps2)); - Task.teardown_pool pool1; - Task.teardown_pool pool2; - true) + try + let pool1 = Task.setup_pool ~num_domains:input1.num_domains () in + let pool2 = Task.setup_pool ~num_domains:input2.num_domains () in + Task.run pool1 (fun () -> + Task.run pool2 (fun () -> + let ps1 = build_dep_graph pool1 input1 in + let ps2 = build_dep_graph pool2 input2 in + List.iter (fun p -> Task.await pool1 p) ps1; + List.iter (fun p -> Task.await pool2 p) ps2)); + Task.teardown_pool pool1; + Task.teardown_pool pool2; + true + with + Failure err -> err = "failed to allocate domain") let () = let domain_bound = max 1 (Domain.recommended_domain_count () / 2) in From 89a03c06524285c7784e5f093863c792d0449e88 Mon Sep 17 00:00:00 2001 From: Jan Midtgaard Date: Thu, 25 May 2023 11:46:57 +0200 Subject: [PATCH 03/10] Remove (modes native) from test suite --- test/dune | 67 +++++++++++++++++++------------------------------------ 1 file changed, 23 insertions(+), 44 deletions(-) diff --git a/test/dune b/test/dune index 3782fa4..079e148 100644 --- a/test/dune +++ b/test/dune @@ -1,127 +1,106 @@ (test (name test_chan) (libraries domainslib) - (modules test_chan) - (modes native)) + (modules test_chan)) (test (name fib) - (modules fib) - (modes native)) + (modules fib)) (test (name fib_par) (libraries domainslib) - (modules fib_par) - (modes native)) + (modules fib_par)) (test (name kcas_integration) (libraries domainslib kcas) - (modules kcas_integration) - (modes native)) + (modules kcas_integration)) (test (name enumerate_par) (libraries domainslib) - (modules enumerate_par) - (modes native)) + (modules enumerate_par)) (test (name game_of_life) - (modules game_of_life) - (modes native)) + (modules game_of_life)) (test (name game_of_life_multicore) (libraries domainslib) - (modules game_of_life_multicore) - (modes native)) + (modules game_of_life_multicore)) (test (name LU_decomposition_multicore) (libraries domainslib) (flags (:standard -runtime-variant d)) - (modules LU_decomposition_multicore) - (modes native)) + (modules LU_decomposition_multicore)) (test (name spectralnorm2) - (modules spectralnorm2) - (modes native)) + (modules spectralnorm2)) (test - (name sum_par) - (libraries domainslib) - (modules sum_par) - (modes native)) + (name sum_par) + (libraries domainslib) + (modules sum_par)) (test (name task_throughput) (libraries domainslib mirage-clock-unix) - (modules task_throughput) - (modes native)) + (modules task_throughput)) (test (name spectralnorm2_multicore) (libraries domainslib) - (modules spectralnorm2_multicore) - (modes native)) + (modules spectralnorm2_multicore)) (test (name summed_area_table) (libraries domainslib) - (modules summed_area_table) - (modes native)) + (modules summed_area_table)) (test (name prefix_sum) (libraries domainslib unix) - (modules prefix_sum) - (modes native)) + (modules prefix_sum)) (test (name test_task) (libraries domainslib) - (modules test_task) - (modes native)) + (modules test_task)) (test (name test_parallel_find) (libraries domainslib) - (modules test_parallel_find) - (modes native)) + (modules test_parallel_find)) (test (name test_deadlock) (libraries domainslib) - (modules test_deadlock) - (modes native)) + (modules test_deadlock)) (test (name test_task_crash) (libraries domainslib) - (modules test_task_crash) - (modes native)) + (modules test_task_crash)) (test (name test_task_empty) (libraries domainslib) - (modules test_task_empty) - (modes native)) + (modules test_task_empty)) (test (name backtrace) (libraries domainslib) - (modules backtrace) - (modes native)) + (modules backtrace)) (test (name off_by_one) (libraries domainslib) - (modules off_by_one) - (modes native)) + (modules off_by_one)) ;; Custom property-based tests using QCheck From b060a688af0d5b5bb0252c0826e25325b0b251fd Mon Sep 17 00:00:00 2001 From: Jan Midtgaard Date: Thu, 25 May 2023 12:14:04 +0200 Subject: [PATCH 04/10] Condition the two long running PBTs --- test/dune | 2 ++ 1 file changed, 2 insertions(+) diff --git a/test/dune b/test/dune index 079e148..0c304c3 100644 --- a/test/dune +++ b/test/dune @@ -108,12 +108,14 @@ (name task_one_dep) (modules task_one_dep) (libraries qcheck-multicoretests-util qcheck-core qcheck-core.runner domainslib) + (enabled_if (= %{arch_sixtyfour} true)) ;; takes forever on 32-bit (bytecode) (action (run %{test} --verbose))) (test (name task_more_deps) (modules task_more_deps) (libraries qcheck-multicoretests-util qcheck-core qcheck-core.runner domainslib) + (enabled_if (= %{arch_sixtyfour} true)) ;; takes forever on 32-bit (bytecode) (action (run %{test} --verbose))) (test From 0637fb1884e92cef61f70a69233ea250082e5e4f Mon Sep 17 00:00:00 2001 From: Jan Midtgaard Date: Thu, 25 May 2023 14:28:15 +0200 Subject: [PATCH 05/10] Also disable long running PBTs on ppc64 --- test/dune | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/test/dune b/test/dune index 0c304c3..80cfff8 100644 --- a/test/dune +++ b/test/dune @@ -108,14 +108,14 @@ (name task_one_dep) (modules task_one_dep) (libraries qcheck-multicoretests-util qcheck-core qcheck-core.runner domainslib) - (enabled_if (= %{arch_sixtyfour} true)) ;; takes forever on 32-bit (bytecode) + (enabled_if (and (= %{arch_sixtyfour} true) (<> %{architecture} power))) ;; takes forever on bytecode (action (run %{test} --verbose))) (test (name task_more_deps) (modules task_more_deps) (libraries qcheck-multicoretests-util qcheck-core qcheck-core.runner domainslib) - (enabled_if (= %{arch_sixtyfour} true)) ;; takes forever on 32-bit (bytecode) + (enabled_if (and (= %{arch_sixtyfour} true) (<> %{architecture} power))) ;; takes forever on bytecode (action (run %{test} --verbose))) (test From 07ca1ffaef3e2551b2d131b6a1931ed7d01f513e Mon Sep 17 00:00:00 2001 From: Jan Midtgaard Date: Thu, 25 May 2023 14:36:18 +0200 Subject: [PATCH 06/10] Adjust test/of_by_one.ml to accept failure to allocate domain --- test/off_by_one.ml | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/test/off_by_one.ml b/test/off_by_one.ml index 4ca5c1f..76eb960 100644 --- a/test/off_by_one.ml +++ b/test/off_by_one.ml @@ -10,11 +10,18 @@ let print_array a = let r = Array.init 20 (fun i -> i + 1) let scan_task num_doms = - let pool = Task.setup_pool ~num_domains:num_doms () in - let a = Task.run pool (fun () -> Task.parallel_scan pool (+) (Array.make 20 1)) in - Task.teardown_pool pool; - Printf.printf "%i: %s\n%!" num_doms (print_array a); - assert (a = r) + try + let pool = Task.setup_pool ~num_domains:num_doms () in + let a = Task.run pool (fun () -> Task.parallel_scan pool (+) (Array.make 20 1)) in + Task.teardown_pool pool; + Printf.printf "%i: %s\n%!" num_doms (print_array a); + assert (a = r) + with Failure msg -> + begin + assert (msg = "failed to allocate domain"); + Printf.printf "Failed to allocate %i domains, recommended_domain_count: %i\n%!" + num_doms (Domain.recommended_domain_count ()); + end ;; for num_dom=0 to 21 do scan_task num_dom; From d217373755a9b2907c3159e575e0f09bd028feb4 Mon Sep 17 00:00:00 2001 From: Jan Midtgaard Date: Wed, 31 May 2023 14:35:17 +0200 Subject: [PATCH 07/10] Temporarily disable test/LU_decomposition_multicore on arm32 --- test/dune | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/test/dune b/test/dune index 80cfff8..c0f6534 100644 --- a/test/dune +++ b/test/dune @@ -35,7 +35,9 @@ (name LU_decomposition_multicore) (libraries domainslib) (flags (:standard -runtime-variant d)) - (modules LU_decomposition_multicore)) + (modules LU_decomposition_multicore) + (enabled_if (or (= %{arch_sixtyfour} true) (<> %{architecture} arm))) + ;; disabled temporarily on arm32 due to failure: ocaml/ocaml#12267 (test From c0ed8aff976907c519c2bb5f03c76e343f445645 Mon Sep 17 00:00:00 2001 From: Jan Midtgaard Date: Wed, 31 May 2023 14:44:29 +0200 Subject: [PATCH 08/10] Missing paren :-/ --- test/dune | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/dune b/test/dune index c0f6534..51c13e8 100644 --- a/test/dune +++ b/test/dune @@ -36,7 +36,7 @@ (libraries domainslib) (flags (:standard -runtime-variant d)) (modules LU_decomposition_multicore) - (enabled_if (or (= %{arch_sixtyfour} true) (<> %{architecture} arm))) + (enabled_if (or (= %{arch_sixtyfour} true) (<> %{architecture} arm)))) ;; disabled temporarily on arm32 due to failure: ocaml/ocaml#12267 From b10075a0d1f4a665abb0e5eb76b1aa65c4200023 Mon Sep 17 00:00:00 2001 From: Jan Midtgaard Date: Wed, 31 May 2023 18:05:56 +0200 Subject: [PATCH 09/10] Disable backtrace test temporarily on bytecode platforms --- test/dune | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/test/dune b/test/dune index 51c13e8..a4f845f 100644 --- a/test/dune +++ b/test/dune @@ -97,7 +97,9 @@ (test (name backtrace) (libraries domainslib) - (modules backtrace)) + (modules backtrace) + (enabled_if (and (= %{arch_sixtyfour} true) (<> %{architecture} power)))) + ;; disabled temporarily on bytecode switches https://github.com/ocaml/dune/issues/7845 (test (name off_by_one) From 781a03366de50ff3d949c382c89e533817c3b29a Mon Sep 17 00:00:00 2001 From: Jan Midtgaard Date: Thu, 1 Jun 2023 08:42:56 +0200 Subject: [PATCH 10/10] Disable backtrace and PBTs on s390x too (OCaml5 bytecode arch) --- test/dune | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/test/dune b/test/dune index a4f845f..1e9bcc2 100644 --- a/test/dune +++ b/test/dune @@ -98,7 +98,7 @@ (name backtrace) (libraries domainslib) (modules backtrace) - (enabled_if (and (= %{arch_sixtyfour} true) (<> %{architecture} power)))) + (enabled_if (and (= %{arch_sixtyfour} true) (<> %{architecture} power) (<> %{architecture} s390x)))) ;; disabled temporarily on bytecode switches https://github.com/ocaml/dune/issues/7845 (test @@ -112,14 +112,16 @@ (name task_one_dep) (modules task_one_dep) (libraries qcheck-multicoretests-util qcheck-core qcheck-core.runner domainslib) - (enabled_if (and (= %{arch_sixtyfour} true) (<> %{architecture} power))) ;; takes forever on bytecode + (enabled_if (and (= %{arch_sixtyfour} true) (<> %{architecture} power) (<> %{architecture} s390x))) + ;; takes forever on bytecode (action (run %{test} --verbose))) (test (name task_more_deps) (modules task_more_deps) (libraries qcheck-multicoretests-util qcheck-core qcheck-core.runner domainslib) - (enabled_if (and (= %{arch_sixtyfour} true) (<> %{architecture} power))) ;; takes forever on bytecode + (enabled_if (and (= %{arch_sixtyfour} true) (<> %{architecture} power) (<> %{architecture} s390x))) + ;; takes forever on bytecode (action (run %{test} --verbose))) (test