From 0c46c3d2a3fa5e349ea0db7104cfa3dfbeaca7f7 Mon Sep 17 00:00:00 2001 From: Rich FitzJohn Date: Mon, 14 Oct 2024 17:39:25 +0100 Subject: [PATCH 1/7] Import OpenMP support detection from dust1 --- NAMESPACE | 2 + R/cpp11.R | 4 + R/openmp.R | 171 +++++++++++++++++++++++++++++++++++ inst/openmp.cpp | 12 +++ man/dust_openmp_support.Rd | 44 +++++++++ man/dust_openmp_threads.Rd | 52 +++++++++++ src/cpp11.cpp | 8 ++ src/openmp.cpp | 29 ++++++ tests/testthat/test-openmp.R | 139 ++++++++++++++++++++++++++++ 9 files changed, 461 insertions(+) create mode 100644 inst/openmp.cpp create mode 100644 man/dust_openmp_support.Rd create mode 100644 man/dust_openmp_threads.Rd create mode 100644 src/openmp.cpp diff --git a/NAMESPACE b/NAMESPACE index 4b8664fb..c9446797 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -19,6 +19,8 @@ export(dust_likelihood_rng_state) export(dust_likelihood_run) export(dust_likelihood_set_rng_state) export(dust_ode_control) +export(dust_openmp_support) +export(dust_openmp_threads) export(dust_package) export(dust_system_compare_data) export(dust_system_create) diff --git a/R/cpp11.R b/R/cpp11.R index e21ac619..3f2ed00d 100644 --- a/R/cpp11.R +++ b/R/cpp11.R @@ -156,6 +156,10 @@ dust2_filter_malaria_set_rng_state <- function(ptr, r_rng_state) { .Call(`_dust2_dust2_filter_malaria_set_rng_state`, ptr, r_rng_state) } +cpp_openmp_info <- function() { + .Call(`_dust2_cpp_openmp_info`) +} + dust2_system_sir_alloc <- function(r_pars, r_time, r_time_control, r_n_particles, r_n_groups, r_seed, r_deterministic, r_n_threads) { .Call(`_dust2_dust2_system_sir_alloc`, r_pars, r_time, r_time_control, r_n_particles, r_n_groups, r_seed, r_deterministic, r_n_threads) } diff --git a/R/openmp.R b/R/openmp.R index b2df5699..f16ac841 100644 --- a/R/openmp.R +++ b/R/openmp.R @@ -1,3 +1,174 @@ +##' Return information about OpenMP support for this machine. +##' +##' @title Information about OpenMP support +##' +##' @param check_compile Logical, indicating if we should check if we +##' can compile an openmp program - this is slow the first time. +##' +##' @seealso [dust_openmp_threads()] for setting a polite number of +##' threads. +##' +##' @return A list with information about the openmp support on your +##' machine. +##' +##' * The first few elements come from the openmp library directly: +##' `num_proc`, `max_threads`, `thread_limit`; these correspond to a +##' call to the function `omp_get_()` in C and +##' `openmp_version` which is the value of the `_OPENMP` macro. +##' * A logical `has_openmp` which is `TRUE` if it looks like runtime +##' OpenMP support is available +##' * The next elements tell you about different sources that might +##' control the number of threads allowed to run: `mc.cores` (from +##' the R option with the same name), `OMP_THREAD_LIMIT`, +##' `OMP_NUM_THREADS`, `MC_CORES` (from environment variables), +##' `limit_r` (limit computed against R-related control variables), +##' `limit_openmp` (limit computed against OpenMP-related variables) +##' and `limit` the smaller of `limit_r` and `limit_openmp` +##' * Finally, if you specified `check_compile = TRUE`, the logical +##' `has_openmp_compiler` will indicate if it looks like we can +##' compile with OpenMP. +##' +##' @export +##' @examples +##' dust_openmp_support() +dust_openmp_support <- function(check_compile = FALSE) { + info <- openmp_info() + if (check_compile) { + info$has_openmp_compiler <- has_openmp_compiler() + } + info +} + + +##' Politely select a number of threads to use. See Details for the +##' algorithm used. +##' +##' There are two limits and we will take the smaller of the two. +##' +##' The first limit comes from piggy-backing off of R's normal +##' parallel configuration; we will use the `MC_CORES` environment +##' variable and `mc.cores` option as a guide to how many cores you +##' are happy to use. We take `mc.cores` first, then `MC_CORES`, which +##' is the same behaviour as `parallel::mclapply` and friends. +##' +##' The second limit comes from openmp. If you do not have OpenMP +##' support, then we use one thread (higher numbers have no effect at +##' all in this case). If you do have OpenMP support, we take the +##' smallest of the number of "processors" (reported by +##' `omp_get_num_procs()`) the "max threads" (reported by +##' `omp_get_max_threads()` and "thread_limit" (reported by +##' `omp_get_thread_limit()`. +##' +##' See [dust::dust_openmp_support()] for the values of all the values +##' that go into this calculation. +##' +##' @title Select number of threads +##' +##' @param n Either `NULL` (select automatically) or an integer as +##' your proposed number of threads. +##' +##' @param action An action to perform if `n` exceeds the maximum +##' number of threads you can use. Options are "error" (the default, +##' throw an error) or "fix" (print a message and reduce `n` down to +##' the limit). +##' +##' @return An integer, indicating the number of threads that you can use +##' @export +##' @examples +##' # Default number of threads; tries to pick something friendly, +##' # erring on the conservative side. +##' dust_openmp_threads(NULL) +##' +##' # Try to pick something silly and it will be reduced for you +##' dust_openmp_threads(1000, action = "fix") +dust_openmp_threads <- function(n = NULL, action = "error") { + info <- openmp_info() + if (is.null(n)) { + n <- info$limit + } else { + n <- openmp_check_limit(n, info$limit, action) + } + n +} + + +has_openmp_compiler <- function() { + if (is.null(cache$has_openmp_compiler)) { + cache$has_openmp_compiler <- has_openmp_compiler_test() + } + cache$has_openmp_compiler +} + + +## This test uses the 'parallel' example, which as its update() method +## returns the thread number by running omp_get_thread_num() +has_openmp_compiler_test <- function() { + workdir <- tempfile("dust_") + dir_create(workdir) + dir_create(file.path(workdir, "src")) + data <- list(package = "dustopenmp", + linking_to = "cpp11, dust2, monty", + compiler_options = "", + system_requirements = "R (>= 4.0.0)") + writeLines(substitute_dust_template(data, "DESCRIPTION"), + file.path(workdir, "DESCRIPTION")) + writeLines(substitute_dust_template(data, "NAMESPACE"), + file.path(workdir, "NAMESPACE")) + writeLines(substitute_dust_template(data, "Makevars"), + file.path(workdir, "src", "Makevars")) + stopifnot(file.copy(dust2_file("openmp.cpp"), + file.path(workdir, "src"), + overwrite = TRUE)) + tryCatch({ + pkgbuild::compile_dll(workdir, compile_attributes = TRUE, + quiet = TRUE, debug = FALSE) + env <- load_temporary_package(workdir, data$package, TRUE) + env$openmp_get_thread_id() >= 0 + }, error = function(e) FALSE) +} + + +## NOTE: This does not return if the *compiler* supports openmp, just +## the runtime. While we are testing that will be the same thing, but +## after installation from binary this requires really a compile time +## test of a simple openmp program. +openmp_info <- function() { + env <- Sys.getenv(c("OMP_THREAD_LIMIT", "OMP_NUM_THREADS", "MC_CORES")) + env <- set_names(as.list(as.integer(env)), names(env)) + info <- cpp_openmp_info() + info[["mc.cores"]] <- getOption("mc.cores", NA_integer_) + + limit <- list() + limit$limit_r <- getOption("mc.cores", as.integer(Sys.getenv("MC_CORES", 1))) + limit$limit_openmp <- min(info$num_procs, + info$num_threads, + info$thread_limit) + if (!info$has_openmp) { + limit$limit_openmp <- 1L + } + limit$limit <- min(limit$limit_r, limit$limit_openmp) + + c(info, env, limit) +} + + +openmp_check_limit <- function(n, limit, action, call = parent.frame()) { + match_value(action, c("error", "fix")) + if (n > limit) { + msg <- "Requested number of threads '{n}' exceeds a limit of '{limit}'" + hint <- "See {.help dust_openmp_threads()} for details" + if (action == "error") { + cli::cli_abort(c(msg, i = hint), call = call) + } else { + cli::cli_alert_warning(msg) + cli::cli_alert_info(hint) + n <- limit + } + } + n +} + + ## We should have the system report back if it supports openmp at all, ## and pass that in here too, because that deserves a warning. ## diff --git a/inst/openmp.cpp b/inst/openmp.cpp new file mode 100644 index 00000000..03375fce --- /dev/null +++ b/inst/openmp.cpp @@ -0,0 +1,12 @@ +#ifdef _OPENMP +#include +#endif + +[[cpp11::register]] +int openmp_get_thread_id() { +#ifdef _OPENMP + return omp_get_thread_num(); +#else + return -1; +#endif +} diff --git a/man/dust_openmp_support.Rd b/man/dust_openmp_support.Rd new file mode 100644 index 00000000..24c6a84c --- /dev/null +++ b/man/dust_openmp_support.Rd @@ -0,0 +1,44 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/openmp.R +\name{dust_openmp_support} +\alias{dust_openmp_support} +\title{Information about OpenMP support} +\usage{ +dust_openmp_support(check_compile = FALSE) +} +\arguments{ +\item{check_compile}{Logical, indicating if we should check if we +can compile an openmp program - this is slow the first time.} +} +\value{ +A list with information about the openmp support on your +machine. +\itemize{ +\item The first few elements come from the openmp library directly: +\code{num_proc}, \code{max_threads}, \code{thread_limit}; these correspond to a +call to the function \verb{omp_get_()} in C and +\code{openmp_version} which is the value of the \verb{_OPENMP} macro. +\item A logical \code{has_openmp} which is \code{TRUE} if it looks like runtime +OpenMP support is available +\item The next elements tell you about different sources that might +control the number of threads allowed to run: \code{mc.cores} (from +the R option with the same name), \code{OMP_THREAD_LIMIT}, +\code{OMP_NUM_THREADS}, \code{MC_CORES} (from environment variables), +\code{limit_r} (limit computed against R-related control variables), +\code{limit_openmp} (limit computed against OpenMP-related variables) +and \code{limit} the smaller of \code{limit_r} and \code{limit_openmp} +\item Finally, if you specified \code{check_compile = TRUE}, the logical +\code{has_openmp_compiler} will indicate if it looks like we can +compile with OpenMP. +} +} +\description{ +Return information about OpenMP support for this machine. +} +\examples{ +dust_openmp_support() +} +\seealso{ +\code{\link[=dust_openmp_threads]{dust_openmp_threads()}} for setting a polite number of +threads. +} diff --git a/man/dust_openmp_threads.Rd b/man/dust_openmp_threads.Rd new file mode 100644 index 00000000..59326321 --- /dev/null +++ b/man/dust_openmp_threads.Rd @@ -0,0 +1,52 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/openmp.R +\name{dust_openmp_threads} +\alias{dust_openmp_threads} +\title{Select number of threads} +\usage{ +dust_openmp_threads(n = NULL, action = "error") +} +\arguments{ +\item{n}{Either \code{NULL} (select automatically) or an integer as +your proposed number of threads.} + +\item{action}{An action to perform if \code{n} exceeds the maximum +number of threads you can use. Options are "error" (the default, +throw an error) or "fix" (print a message and reduce \code{n} down to +the limit).} +} +\value{ +An integer, indicating the number of threads that you can use +} +\description{ +Politely select a number of threads to use. See Details for the +algorithm used. +} +\details{ +There are two limits and we will take the smaller of the two. + +The first limit comes from piggy-backing off of R's normal +parallel configuration; we will use the \code{MC_CORES} environment +variable and \code{mc.cores} option as a guide to how many cores you +are happy to use. We take \code{mc.cores} first, then \code{MC_CORES}, which +is the same behaviour as \code{parallel::mclapply} and friends. + +The second limit comes from openmp. If you do not have OpenMP +support, then we use one thread (higher numbers have no effect at +all in this case). If you do have OpenMP support, we take the +smallest of the number of "processors" (reported by +\code{omp_get_num_procs()}) the "max threads" (reported by +\code{omp_get_max_threads()} and "thread_limit" (reported by +\code{omp_get_thread_limit()}. + +See \code{\link[dust:dust_openmp_support]{dust::dust_openmp_support()}} for the values of all the values +that go into this calculation. +} +\examples{ +# Default number of threads; tries to pick something friendly, +# erring on the conservative side. +dust_openmp_threads(NULL) + +# Try to pick something silly and it will be reduced for you +dust_openmp_threads(1000, action = "fix") +} diff --git a/src/cpp11.cpp b/src/cpp11.cpp index 7c3bf68f..afe86d5c 100644 --- a/src/cpp11.cpp +++ b/src/cpp11.cpp @@ -278,6 +278,13 @@ extern "C" SEXP _dust2_dust2_filter_malaria_set_rng_state(SEXP ptr, SEXP r_rng_s return cpp11::as_sexp(dust2_filter_malaria_set_rng_state(cpp11::as_cpp>(ptr), cpp11::as_cpp>(r_rng_state))); END_CPP11 } +// openmp.cpp +cpp11::writable::list cpp_openmp_info(); +extern "C" SEXP _dust2_cpp_openmp_info() { + BEGIN_CPP11 + return cpp11::as_sexp(cpp_openmp_info()); + END_CPP11 +} // sir.cpp SEXP dust2_system_sir_alloc(cpp11::list r_pars, cpp11::sexp r_time, cpp11::list r_time_control, cpp11::sexp r_n_particles, cpp11::sexp r_n_groups, cpp11::sexp r_seed, cpp11::sexp r_deterministic, cpp11::sexp r_n_threads); extern "C" SEXP _dust2_dust2_system_sir_alloc(SEXP r_pars, SEXP r_time, SEXP r_time_control, SEXP r_n_particles, SEXP r_n_groups, SEXP r_seed, SEXP r_deterministic, SEXP r_n_threads) { @@ -827,6 +834,7 @@ extern "C" SEXP _dust2_dust2_system_walk_simulate(SEXP ptr, SEXP r_times, SEXP r extern "C" { static const R_CallMethodDef CallEntries[] = { + {"_dust2_cpp_openmp_info", (DL_FUNC) &_dust2_cpp_openmp_info, 0}, {"_dust2_dust2_filter_malaria_alloc", (DL_FUNC) &_dust2_dust2_filter_malaria_alloc, 10}, {"_dust2_dust2_filter_malaria_last_history", (DL_FUNC) &_dust2_dust2_filter_malaria_last_history, 5}, {"_dust2_dust2_filter_malaria_last_state", (DL_FUNC) &_dust2_dust2_filter_malaria_last_state, 5}, diff --git a/src/openmp.cpp b/src/openmp.cpp new file mode 100644 index 00000000..9518005f --- /dev/null +++ b/src/openmp.cpp @@ -0,0 +1,29 @@ +#ifdef _OPENMP +#include +#endif + +#include +#include + +[[cpp11::register]] +cpp11::writable::list cpp_openmp_info() { +#ifdef _OPENMP + const int num_procs = omp_get_num_procs(); + const int max_threads = omp_get_max_threads(); + const int thread_limit = omp_get_thread_limit(); + static int openmp_version = _OPENMP; + static bool has_openmp = true; +#else + static int num_procs = NA_INTEGER; + static int max_threads = NA_INTEGER; + static int thread_limit = NA_INTEGER; + static int openmp_version = NA_INTEGER; + static bool has_openmp = false; +#endif + using namespace cpp11::literals; + return cpp11::writable::list({"num_procs"_nm = num_procs, + "max_threads"_nm = max_threads, + "thread_limit"_nm = thread_limit, + "openmp_version"_nm = openmp_version, + "has_openmp"_nm = has_openmp}); +} diff --git a/tests/testthat/test-openmp.R b/tests/testthat/test-openmp.R index f717ad07..74869e7b 100644 --- a/tests/testthat/test-openmp.R +++ b/tests/testthat/test-openmp.R @@ -7,3 +7,142 @@ test_that("Can validate thread count", { "Reducing 'n_threads' from requested 10 to 6") expect_equal(n, 6) }) + + +test_that("dust_openmp_info contains expected fields", { + info <- dust_openmp_support() + expect_type(info, "list") + nms <- c("num_procs", "max_threads", "thread_limit", "openmp_version", + "has_openmp", "mc.cores", "OMP_THREAD_LIMIT", "OMP_NUM_THREADS", + "MC_CORES", "limit_r", "limit_openmp", "limit") + expect_equal(names(info), nms) +}) + + +test_that("dust_openmp_info contains expected fields", { + skip_on_cran() + info1 <- dust_openmp_support() + info2 <- dust_openmp_support(TRUE) + expect_equal( + setdiff(names(info2), names(info1)), + "has_openmp_compiler") + expect_equal( + setdiff(names(info1), names(info2)), + character()) + expect_equal(info2$has_openmp_compiler, cache$has_openmp_compiler) +}) + + +test_that("check limit", { + expect_error( + openmp_check_limit(10, 2, "error"), + "Requested number of threads '10' exceeds a limit of '2'") + + res <- evaluate_promise( + openmp_check_limit(10, 2, "fix")) + expect_match(res$messages[[1]], + "Requested number of threads '10' exceeds a limit of '2'") + expect_equal(res$result, 2) +}) + + +test_that("limit is 1 if openmp not supported", { + skip_if_not_installed("mockery") + mock_info <- mockery::mock( + list(num_procs = NA_integer_, max_threads = NA_integer_, + thread_limit = NA_integer_, openmp_version = NA_integer_, + has_openmp = FALSE)) + mockery::stub(openmp_info, "cpp_openmp_info", mock_info) + res <- openmp_info() + + mockery::expect_called(mock_info, 1L) + expect_equal(res$limit, 1) + expect_identical(res$limit_openmp, 1L) +}) + + +test_that("limit is more than 1 if openmp supported", { + skip_if_not_installed("mockery") + mock_info <- mockery::mock( + list(num_procs = 8L, max_threads = 8L, + thread_limit = 1024L, openmp_version = 201511L, + has_openmp = TRUE)) + mockery::stub(openmp_info, "cpp_openmp_info", mock_info) + res <- withr::with_options( + list(mc.cores = 4), + openmp_info()) + mockery::expect_called(mock_info, 1L) + expect_equal(res$limit, 4) + expect_equal(res$limit_openmp, 8L) + expect_equal(res$limit_r, 4) +}) + + +test_that("order of preference for R's limits", { + expect_equal( + withr::with_options( + list(mc.cores = 4), + withr::with_envvar( + c("MC_CORES" = 8), + unname(openmp_info()[c("mc.cores", "MC_CORES", "limit_r")]))), + list(4, 8, 4)) + + expect_equal( + withr::with_options( + list(mc.cores = 8), + withr::with_envvar( + c("MC_CORES" = 4), + unname(openmp_info()[c("mc.cores", "MC_CORES", "limit_r")]))), + list(8, 4, 8)) +}) + + +test_that("detect compilation failure", { + skip_if_not_installed("mockery") + mock_compile <- mockery::mock( + stop("compilation failed!")) + mockery::stub(has_openmp_compiler_test, "pkgbuild::compile_dll", + mock_compile) + expect_false(has_openmp_compiler_test()) +}) + + +test_that("detect compilation success, but no support", { + skip_if_not_installed("mockery") + mock_thread_id <- mockery::mock(-1, 0) + mock_compile <- mockery::mock() + mock_load <- mockery::mock(list(openmp_get_thread_id = mock_thread_id)) + mockery::stub(has_openmp_compiler_test, "pkgbuild::compile_dll", + mock_compile) + mockery::stub(has_openmp_compiler_test, "load_temporary_package", + mock_load) + expect_false(has_openmp_compiler_test()) + mockery::expect_called(mock_thread_id, 1L) +}) + + +test_that("detect compilation success, with support", { + skip_if_not_installed("mockery") + mock_thread_id <- mockery::mock(0) + mock_compile <- mockery::mock() + mock_load <- mockery::mock(list(openmp_get_thread_id = mock_thread_id)) + mockery::stub(has_openmp_compiler_test, "pkgbuild::compile_dll", + mock_compile) + mockery::stub(has_openmp_compiler_test, "load_temporary_package", + mock_load) + expect_true(has_openmp_compiler_test()) + mockery::expect_called(mock_thread_id, 1L) +}) + + +test_that("dust_openmp_threads interface works", { + expect_equal( + dust_openmp_threads(NULL), + dust_openmp_support()$limit) + expect_equal( + suppressMessages(dust_openmp_threads(1000, action = "fix")), + dust_openmp_support()$limit) + expect_equal( + dust_openmp_threads(1, action = "error"), + 1) +}) From 184ddd0301943a8bc382c5d72168970a7049e792 Mon Sep 17 00:00:00 2001 From: Rich FitzJohn Date: Mon, 14 Oct 2024 17:40:45 +0100 Subject: [PATCH 2/7] Add pkgdown index --- _pkgdown.yml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/_pkgdown.yml b/_pkgdown.yml index 0d60dee9..f559dd09 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -51,6 +51,8 @@ reference: contents: - dust_unpack_state - dust_unpack_index + - dust_openmp_support + - dust_openmp_threads - title: Browser-based debugging contents: - dust_browser_enabled From a9e46fdecc306226023ead715128877aff28882a Mon Sep 17 00:00:00 2001 From: Rich FitzJohn Date: Mon, 14 Oct 2024 17:41:03 +0100 Subject: [PATCH 3/7] Bump version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 8d04fe88..d65fb6d6 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: dust2 Title: Next Generation dust -Version: 0.1.16 +Version: 0.1.17 Authors@R: c(person("Rich", "FitzJohn", role = c("aut", "cre"), email = "rich.fitzjohn@gmail.com"), person("Imperial College of Science, Technology and Medicine", From 2c3bcb8dfba3f278a7da2a8d375e3037d3fc6c02 Mon Sep 17 00:00:00 2001 From: Rich FitzJohn Date: Mon, 14 Oct 2024 17:42:09 +0100 Subject: [PATCH 4/7] Remove reference to dust1 --- R/openmp.R | 4 ++-- man/dust_openmp_threads.Rd | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/openmp.R b/R/openmp.R index f16ac841..40c27c98 100644 --- a/R/openmp.R +++ b/R/openmp.R @@ -59,8 +59,8 @@ dust_openmp_support <- function(check_compile = FALSE) { ##' `omp_get_max_threads()` and "thread_limit" (reported by ##' `omp_get_thread_limit()`. ##' -##' See [dust::dust_openmp_support()] for the values of all the values -##' that go into this calculation. +##' See [dust_openmp_support()] for the values of all the values that +##' go into this calculation. ##' ##' @title Select number of threads ##' diff --git a/man/dust_openmp_threads.Rd b/man/dust_openmp_threads.Rd index 59326321..48505ac0 100644 --- a/man/dust_openmp_threads.Rd +++ b/man/dust_openmp_threads.Rd @@ -39,8 +39,8 @@ smallest of the number of "processors" (reported by \code{omp_get_max_threads()} and "thread_limit" (reported by \code{omp_get_thread_limit()}. -See \code{\link[dust:dust_openmp_support]{dust::dust_openmp_support()}} for the values of all the values -that go into this calculation. +See \code{\link[=dust_openmp_support]{dust_openmp_support()}} for the values of all the values that +go into this calculation. } \examples{ # Default number of threads; tries to pick something friendly, From d13e86fb0023432933958d7f9477c8b11342235f Mon Sep 17 00:00:00 2001 From: Wes Hinsley Date: Tue, 15 Oct 2024 13:59:01 +0100 Subject: [PATCH 5/7] Fix ansi_strip --- tests/testthat/test-zzz-compile.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-zzz-compile.R b/tests/testthat/test-zzz-compile.R index 134a42b7..334d43f4 100644 --- a/tests/testthat/test-zzz-compile.R +++ b/tests/testthat/test-zzz-compile.R @@ -73,7 +73,7 @@ test_that("generators can be serialised and used from other processes", { dust2::dust_system_state(dust2::dust_system_create(sys(), list(), 1)) }, list(tmp), stdout = log, stderr = "2>&1"), numeric(5)) - expect_match(cli::ansi_string(readLines(log)), "Loading mysir", all = FALSE) + expect_match(cli::ansi_strip(readLines(log)), "Loading mysir", all = FALSE) }) From b9b3e7aade429fbd1c5dd2e6f9df80effeeab127 Mon Sep 17 00:00:00 2001 From: Wes Hinsley Date: Tue, 15 Oct 2024 14:01:11 +0100 Subject: [PATCH 6/7] OpenMP vs openmp text consistency --- R/openmp.R | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/R/openmp.R b/R/openmp.R index 40c27c98..a8bafef8 100644 --- a/R/openmp.R +++ b/R/openmp.R @@ -3,15 +3,15 @@ ##' @title Information about OpenMP support ##' ##' @param check_compile Logical, indicating if we should check if we -##' can compile an openmp program - this is slow the first time. +##' can compile an OpenMP program - this is slow the first time. ##' ##' @seealso [dust_openmp_threads()] for setting a polite number of ##' threads. ##' -##' @return A list with information about the openmp support on your +##' @return A list with information about the OpenMP support on your ##' machine. ##' -##' * The first few elements come from the openmp library directly: +##' * The first few elements come from the OpenMP library directly: ##' `num_proc`, `max_threads`, `thread_limit`; these correspond to a ##' call to the function `omp_get_()` in C and ##' `openmp_version` which is the value of the `_OPENMP` macro. @@ -51,7 +51,7 @@ dust_openmp_support <- function(check_compile = FALSE) { ##' are happy to use. We take `mc.cores` first, then `MC_CORES`, which ##' is the same behaviour as `parallel::mclapply` and friends. ##' -##' The second limit comes from openmp. If you do not have OpenMP +##' The second limit comes from OpenMP. If you do not have OpenMP ##' support, then we use one thread (higher numbers have no effect at ##' all in this case). If you do have OpenMP support, we take the ##' smallest of the number of "processors" (reported by @@ -128,10 +128,10 @@ has_openmp_compiler_test <- function() { } -## NOTE: This does not return if the *compiler* supports openmp, just +## NOTE: This does not return if the *compiler* supports OpenMP, just ## the runtime. While we are testing that will be the same thing, but ## after installation from binary this requires really a compile time -## test of a simple openmp program. +## test of a simple OpenMP program. openmp_info <- function() { env <- Sys.getenv(c("OMP_THREAD_LIMIT", "OMP_NUM_THREADS", "MC_CORES")) env <- set_names(as.list(as.integer(env)), names(env)) From cbd7a71ac113ab8c2048845a98de140ee534a6b6 Mon Sep 17 00:00:00 2001 From: Wes Hinsley Date: Tue, 15 Oct 2024 14:01:54 +0100 Subject: [PATCH 7/7] Redocument --- man/dust_openmp_support.Rd | 6 +++--- man/dust_openmp_threads.Rd | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/man/dust_openmp_support.Rd b/man/dust_openmp_support.Rd index 24c6a84c..40af4701 100644 --- a/man/dust_openmp_support.Rd +++ b/man/dust_openmp_support.Rd @@ -8,13 +8,13 @@ dust_openmp_support(check_compile = FALSE) } \arguments{ \item{check_compile}{Logical, indicating if we should check if we -can compile an openmp program - this is slow the first time.} +can compile an OpenMP program - this is slow the first time.} } \value{ -A list with information about the openmp support on your +A list with information about the OpenMP support on your machine. \itemize{ -\item The first few elements come from the openmp library directly: +\item The first few elements come from the OpenMP library directly: \code{num_proc}, \code{max_threads}, \code{thread_limit}; these correspond to a call to the function \verb{omp_get_()} in C and \code{openmp_version} which is the value of the \verb{_OPENMP} macro. diff --git a/man/dust_openmp_threads.Rd b/man/dust_openmp_threads.Rd index 48505ac0..cd7b4bda 100644 --- a/man/dust_openmp_threads.Rd +++ b/man/dust_openmp_threads.Rd @@ -31,7 +31,7 @@ variable and \code{mc.cores} option as a guide to how many cores you are happy to use. We take \code{mc.cores} first, then \code{MC_CORES}, which is the same behaviour as \code{parallel::mclapply} and friends. -The second limit comes from openmp. If you do not have OpenMP +The second limit comes from OpenMP. If you do not have OpenMP support, then we use one thread (higher numbers have no effect at all in this case). If you do have OpenMP support, we take the smallest of the number of "processors" (reported by