Repair environment on load

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)

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)
+  }
+}

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))
 }
 

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)]]
+}

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)
 }

inst/template/package.R

@@ -0,0 +1,3 @@
+{{name}} <- function() {
+  dust2::dust_system_generator("{{name}}", "{{time_type_property}}", {{default_dt}})
+}

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)"))
 })
 
 

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)
+})