diff --git a/R/compile.R b/R/compile.R index ba39a23e..5b4b464d 100644 --- a/R/compile.R +++ b/R/compile.R @@ -95,6 +95,12 @@ dust_compile <- function(filename, quiet = NULL, workdir = NULL, workdir <- dust_workdir(workdir, hash) quiet <- dust_quiet(quiet) + + ## Second round of substitution in here, in order to sub in the work + ## directory now that we have it: + data <- list(path_pkg = gsub("\\", "/", workdir, fixed = TRUE)) + res$r <- glue_whisker(res$r, data) + dir_create(c(workdir, file.path(workdir, c("R", "src")))) writelines_if_changed(res$description, workdir, "DESCRIPTION", quiet) writelines_if_changed(res$namespace, workdir, "NAMESPACE", quiet) diff --git a/R/interface.R b/R/interface.R index f423dec3..d802976d 100644 --- a/R/interface.R +++ b/R/interface.R @@ -39,6 +39,8 @@ dust_system_generator <- function(name, time_type, default_dt, nms) } + env <- dust_package_env(env) + methods_core <- c("alloc", "state", "set_state", "set_state_initial", "time", "set_time", @@ -697,8 +699,8 @@ is_uncalled_generator <- function(sys) { } code <- body(sys) rlang::is_call(code, "{") && - length(code) == 2 && - rlang::is_call(code[[2]], "dust_system") + length(code) %in% 2:3 && + rlang::is_call(last(code), "dust_system_generator") } @@ -740,3 +742,14 @@ check_time_control <- function(generator, dt, ode_control, ode_control <- check_system_ode_control(ode_control, generator, call = call) list(dt = dt, ode_control = ode_control) } + + +dust_package_env <- function(env, quiet = FALSE) { + if (is.environment(env)) { + env + } else if (isNamespaceLoaded(env$name)) { + asNamespace(env$name) + } else { + env <- load_temporary_package(env$path, env$name, quiet) + } +} diff --git a/R/package.R b/R/package.R index 729cb0fc..f49fed4a 100644 --- a/R/package.R +++ b/R/package.R @@ -223,7 +223,7 @@ package_generate <- function(filename, call) { system <- read_lines(filename) data <- dust_template_data(config$name, config$class, config$time_type, config$default_dt) - list(r = substitute_dust_template(data, "dust.R"), + list(r = substitute_dust_template(data, "package.R"), cpp = dust_generate_cpp(system, config, data)) } diff --git a/R/util.R b/R/util.R index 453a3cc3..c2492b55 100644 --- a/R/util.R +++ b/R/util.R @@ -131,3 +131,8 @@ fmod <- function(n, m) { envvar_is_truthy <- function(name) { tolower(Sys.getenv(name, "false")) %in% c("t", "true", "1") } + + +last <- function(x) { + x[[length(x)]] +} diff --git a/inst/template/dust.R b/inst/template/dust.R index 781f1321..575f78cd 100644 --- a/inst/template/dust.R +++ b/inst/template/dust.R @@ -1,3 +1,5 @@ {{name}} <- function() { - dust2::dust_system_generator("{{name}}", "{{time_type_property}}", {{default_dt}}) + package <- list(name = "{{package}}", path = "{{{{path_pkg}}}}") + dust2::dust_system_generator("{{name}}", "{{time_type_property}}", {{default_dt}}, + package) } diff --git a/inst/template/package.R b/inst/template/package.R new file mode 100644 index 00000000..781f1321 --- /dev/null +++ b/inst/template/package.R @@ -0,0 +1,3 @@ +{{name}} <- function() { + dust2::dust_system_generator("{{name}}", "{{time_type_property}}", {{default_dt}}) +} diff --git a/tests/testthat/test-interface.R b/tests/testthat/test-interface.R index ba81ee9d..a231bfbd 100644 --- a/tests/testthat/test-interface.R +++ b/tests/testthat/test-interface.R @@ -19,13 +19,21 @@ test_that("error if given invalid inputs to dust_system_create", { "Expected 'generator' to be a 'dust_system_generator' object") foo <- function() { - dust_system("foo") + dust2::dust_system_generator(...) } + expect_true(is_uncalled_generator(foo)) err <- expect_error( dust_system_create(foo), "Expected 'generator' to be a 'dust_system_generator' object") expect_equal(err$body, c(i = "Did you mean 'foo()' (i.e., with parentheses)")) + + skip_on_covr() + err <- expect_error( + dust_system_create(sir), + "Expected 'generator' to be a 'dust_system_generator' object") + expect_equal(err$body, + c(i = "Did you mean 'sir()' (i.e., with parentheses)")) }) diff --git a/tests/testthat/test-zzz-compile.R b/tests/testthat/test-zzz-compile.R index db2cec71..9648a749 100644 --- a/tests/testthat/test-zzz-compile.R +++ b/tests/testthat/test-zzz-compile.R @@ -21,6 +21,9 @@ test_that("can compile simple system", { res <- evaluate_promise(dust_compile(filename, quiet = FALSE, debug = TRUE)) expect_identical(res$result, gen) expect_match(res$messages, "Using cached generator") + + skip_on_covr() + expect_true(is_uncalled_generator(gen)) }) @@ -42,7 +45,33 @@ test_that("can compile into a stable directory", { }, list(filename = filename), env = env, stdout = log, stderr = "2>&1") log_txt <- readLines(log) - expect_match(log_txt, "'src/dust.cpp' is up to date", all = FALSE) - expect_match(log_txt, "Loading(.+)mysir2", all = FALSE) + expect_match(cli::ansi_strip(log_txt), + "'src/dust.cpp' is up to date", + all = FALSE) + expect_match(cli::ansi_strip(log_txt), + "Loading mysir2", + all = FALSE) expect_false(any(grepl("compiling", log_txt, ignore.case = TRUE))) }) + + +test_that("generators can be serialised and used from other processes", { + skip_if_not_installed("callr") + + code <- gsub("sir", "mysir", readLines(dust2_file("examples/sir.cpp"))) + filename <- tempfile(fileext = ".cpp") + writeLines(code, filename) + gen <- dust_compile(filename, quiet = TRUE, debug = TRUE) + + tmp <- withr::local_tempfile() + saveRDS(gen, tmp) + + log <- withr::local_tempfile() + expect_equal( + callr::r(function(path) { + sys <- readRDS(path) + 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) +})