From d78c39e4c5b70ea35fab3830a66366706b8336d0 Mon Sep 17 00:00:00 2001 From: Rich FitzJohn Date: Mon, 30 Sep 2024 20:09:50 +0100 Subject: [PATCH 01/12] Fix environment on generator load --- R/compile.R | 5 +++++ R/package.R | 2 +- inst/template/dust.R | 7 ++++++- 3 files changed, 12 insertions(+), 2 deletions(-) diff --git a/R/compile.R b/R/compile.R index ba39a23e..d816cf7f 100644 --- a/R/compile.R +++ b/R/compile.R @@ -95,6 +95,11 @@ 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: + res$r <- glue_whisker(res$r, list(path_pkg = workdir)) + 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/package.R b/R/package.R index 729cb0fc..79944671 100644 --- a/R/package.R +++ b/R/package.R @@ -80,7 +80,7 @@ dust_package <- function(path, quiet = NULL) { } code_r <- c(dust_header("##"), vcapply(data, "[[", "r")) - writelines_if_changed(code_r, path, "R/dust.R", quiet) + writelines_if_changed(code_r, path, "R/package.R", quiet) if (file.exists(file.path(path, "src/Makevars"))) { makevars <- read_lines(file.path(path, "src/Makevars")) diff --git a/inst/template/dust.R b/inst/template/dust.R index 781f1321..59ad4d46 100644 --- a/inst/template/dust.R +++ b/inst/template/dust.R @@ -1,3 +1,8 @@ {{name}} <- function() { - dust2::dust_system_generator("{{name}}", "{{time_type_property}}", {{default_dt}}) + if (isNamespaceLoaded("{{package}}")) { + env <- asNamespace("{{package}}") + } else { + env <- dust2:::load_temporary_package("{{{{path_pkg}}}}", "{{package}}", FALSE) + } + dust2::dust_system_generator("{{name}}", "{{time_type_property}}", {{default_dt}}, env) } From dac33c0e015b31f096caa15f4ef5cc93128f53e7 Mon Sep 17 00:00:00 2001 From: Rich FitzJohn Date: Mon, 30 Sep 2024 20:33:49 +0100 Subject: [PATCH 02/12] More general solution --- R/interface.R | 13 +++++++++++++ inst/template/dust.R | 9 +++------ 2 files changed, 16 insertions(+), 6 deletions(-) diff --git a/R/interface.R b/R/interface.R index f423dec3..e8801b1b 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", @@ -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/inst/template/dust.R b/inst/template/dust.R index 59ad4d46..575f78cd 100644 --- a/inst/template/dust.R +++ b/inst/template/dust.R @@ -1,8 +1,5 @@ {{name}} <- function() { - if (isNamespaceLoaded("{{package}}")) { - env <- asNamespace("{{package}}") - } else { - env <- dust2:::load_temporary_package("{{{{path_pkg}}}}", "{{package}}", FALSE) - } - dust2::dust_system_generator("{{name}}", "{{time_type_property}}", {{default_dt}}, env) + package <- list(name = "{{package}}", path = "{{{{path_pkg}}}}") + dust2::dust_system_generator("{{name}}", "{{time_type_property}}", {{default_dt}}, + package) } From 902fd8b22d9366f3c487794bd52f4e2ad71e90d0 Mon Sep 17 00:00:00 2001 From: Rich FitzJohn Date: Tue, 1 Oct 2024 07:47:50 +0100 Subject: [PATCH 03/12] Add test of loading generator in other process --- R/package.R | 2 +- tests/testthat/test-zzz-compile.R | 22 ++++++++++++++++++++++ 2 files changed, 23 insertions(+), 1 deletion(-) diff --git a/R/package.R b/R/package.R index 79944671..882d8ed8 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/tests/testthat/test-zzz-compile.R b/tests/testthat/test-zzz-compile.R index db2cec71..9ff20438 100644 --- a/tests/testthat/test-zzz-compile.R +++ b/tests/testthat/test-zzz-compile.R @@ -46,3 +46,25 @@ test_that("can compile into a stable directory", { expect_match(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(readLines(log), "Loading mysir", all = FALSE) +}) From d3b670b67cd09227f21693722779f2f6ec75ff44 Mon Sep 17 00:00:00 2001 From: Rich FitzJohn Date: Tue, 1 Oct 2024 07:52:37 +0100 Subject: [PATCH 04/12] Add missing template --- inst/template/package.R | 3 +++ 1 file changed, 3 insertions(+) create mode 100644 inst/template/package.R 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}}) +} From b70028164db9473e3f4eb41b8000573a9cadd971 Mon Sep 17 00:00:00 2001 From: Rich FitzJohn Date: Tue, 1 Oct 2024 08:46:28 +0100 Subject: [PATCH 05/12] Fix name of generated file --- R/package.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/package.R b/R/package.R index 882d8ed8..f49fed4a 100644 --- a/R/package.R +++ b/R/package.R @@ -80,7 +80,7 @@ dust_package <- function(path, quiet = NULL) { } code_r <- c(dust_header("##"), vcapply(data, "[[", "r")) - writelines_if_changed(code_r, path, "R/package.R", quiet) + writelines_if_changed(code_r, path, "R/dust.R", quiet) if (file.exists(file.path(path, "src/Makevars"))) { makevars <- read_lines(file.path(path, "src/Makevars")) From 437d4743566333dcb89b915ca462d24d7992c344 Mon Sep 17 00:00:00 2001 From: Rich FitzJohn Date: Wed, 2 Oct 2024 14:36:25 +0100 Subject: [PATCH 06/12] Sanitise windows filenames --- R/compile.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/compile.R b/R/compile.R index d816cf7f..5b4b464d 100644 --- a/R/compile.R +++ b/R/compile.R @@ -98,7 +98,8 @@ dust_compile <- function(filename, quiet = NULL, workdir = NULL, ## Second round of substitution in here, in order to sub in the work ## directory now that we have it: - res$r <- glue_whisker(res$r, list(path_pkg = workdir)) + 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) From 86192ca3fca0e9db55415d5c19887db770568300 Mon Sep 17 00:00:00 2001 From: Rich FitzJohn Date: Wed, 2 Oct 2024 14:33:50 +0100 Subject: [PATCH 07/12] Fix regression in bad argument to dust_system_create --- R/interface.R | 2 +- tests/testthat/test-interface.R | 7 ++----- 2 files changed, 3 insertions(+), 6 deletions(-) diff --git a/R/interface.R b/R/interface.R index e8801b1b..03859b3d 100644 --- a/R/interface.R +++ b/R/interface.R @@ -700,7 +700,7 @@ is_uncalled_generator <- function(sys) { code <- body(sys) rlang::is_call(code, "{") && length(code) == 2 && - rlang::is_call(code[[2]], "dust_system") + rlang::is_call(code[[2]], "dust_system_generator") } diff --git a/tests/testthat/test-interface.R b/tests/testthat/test-interface.R index ba81ee9d..752ad795 100644 --- a/tests/testthat/test-interface.R +++ b/tests/testthat/test-interface.R @@ -18,14 +18,11 @@ test_that("error if given invalid inputs to dust_system_create", { dust_system_create("sir"), "Expected 'generator' to be a 'dust_system_generator' object") - foo <- function() { - dust_system("foo") - } err <- expect_error( - dust_system_create(foo), + dust_system_create(sir), "Expected 'generator' to be a 'dust_system_generator' object") expect_equal(err$body, - c(i = "Did you mean 'foo()' (i.e., with parentheses)")) + c(i = "Did you mean 'sir()' (i.e., with parentheses)")) }) From 3eb1ca1fcbe1909dcdfe0874a3be910e5a120239 Mon Sep 17 00:00:00 2001 From: Rich FitzJohn Date: Wed, 2 Oct 2024 14:42:21 +0100 Subject: [PATCH 08/12] Fix detection of uncalled generators with new template --- R/interface.R | 4 ++-- R/util.R | 5 +++++ tests/testthat/test-zzz-compile.R | 1 + 3 files changed, 8 insertions(+), 2 deletions(-) diff --git a/R/interface.R b/R/interface.R index 03859b3d..d802976d 100644 --- a/R/interface.R +++ b/R/interface.R @@ -699,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_generator") + length(code) %in% 2:3 && + rlang::is_call(last(code), "dust_system_generator") } 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/tests/testthat/test-zzz-compile.R b/tests/testthat/test-zzz-compile.R index 9ff20438..30f38f93 100644 --- a/tests/testthat/test-zzz-compile.R +++ b/tests/testthat/test-zzz-compile.R @@ -9,6 +9,7 @@ test_that("can compile simple system", { expect_s3_class(res, "dust_system_generator") expect_equal(res$name, "mysir") expect_true(res$properties$has_compare) + expect_true(is_uncalled_generator(gen)) obj1 <- dust_system_create(gen(), list(), n_particles = 10, seed = 1) dust_system_set_state_initial(obj1) From f4e13cf04a06e796ae60198961488e78e56de944 Mon Sep 17 00:00:00 2001 From: Rich FitzJohn Date: Wed, 2 Oct 2024 14:47:01 +0100 Subject: [PATCH 09/12] Fix for covr --- tests/testthat/test-interface.R | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/tests/testthat/test-interface.R b/tests/testthat/test-interface.R index 752ad795..a231bfbd 100644 --- a/tests/testthat/test-interface.R +++ b/tests/testthat/test-interface.R @@ -18,6 +18,17 @@ test_that("error if given invalid inputs to dust_system_create", { dust_system_create("sir"), "Expected 'generator' to be a 'dust_system_generator' object") + foo <- function() { + 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") From c697a5a8ee44b27a03f0fca46e4aacb6333c3c51 Mon Sep 17 00:00:00 2001 From: Rich FitzJohn Date: Wed, 2 Oct 2024 14:47:41 +0100 Subject: [PATCH 10/12] Cope on covr --- tests/testthat/test-zzz-compile.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test-zzz-compile.R b/tests/testthat/test-zzz-compile.R index 30f38f93..1df03538 100644 --- a/tests/testthat/test-zzz-compile.R +++ b/tests/testthat/test-zzz-compile.R @@ -9,7 +9,6 @@ test_that("can compile simple system", { expect_s3_class(res, "dust_system_generator") expect_equal(res$name, "mysir") expect_true(res$properties$has_compare) - expect_true(is_uncalled_generator(gen)) obj1 <- dust_system_create(gen(), list(), n_particles = 10, seed = 1) dust_system_set_state_initial(obj1) @@ -22,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)) }) From 8a75e2aa1d02f7dca4ffb8db50579f1aa55b5f77 Mon Sep 17 00:00:00 2001 From: Rich FitzJohn Date: Thu, 3 Oct 2024 08:44:07 +0100 Subject: [PATCH 11/12] Strip ansi for log test --- tests/testthat/test-zzz-compile.R | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-zzz-compile.R b/tests/testthat/test-zzz-compile.R index 1df03538..1756f565 100644 --- a/tests/testthat/test-zzz-compile.R +++ b/tests/testthat/test-zzz-compile.R @@ -45,8 +45,12 @@ 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))) }) From d5d1652aee20b6d95a7a9f4244eacb7509e75157 Mon Sep 17 00:00:00 2001 From: Rich FitzJohn Date: Thu, 3 Oct 2024 14:49:39 +0100 Subject: [PATCH 12/12] Apply suggestions from code review Co-authored-by: Wes Hinsley --- tests/testthat/test-zzz-compile.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-zzz-compile.R b/tests/testthat/test-zzz-compile.R index 1756f565..9648a749 100644 --- a/tests/testthat/test-zzz-compile.R +++ b/tests/testthat/test-zzz-compile.R @@ -49,7 +49,7 @@ test_that("can compile into a stable directory", { "'src/dust.cpp' is up to date", all = FALSE) expect_match(cli::ansi_strip(log_txt), - "Loading(.+)mysir2", + "Loading mysir2", all = FALSE) expect_false(any(grepl("compiling", log_txt, ignore.case = TRUE))) }) @@ -73,5 +73,5 @@ 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(readLines(log), "Loading mysir", all = FALSE) + expect_match(cli::ansi_string(readLines(log)), "Loading mysir", all = FALSE) })