Preparing for when the batchtools registry not being created until when the future is launched

Author: HenrikBengtsson

R/BatchtoolsFuture-class.R

@@ -165,9 +165,12 @@ print.BatchtoolsFuture <- function(x, ...) {
   ## batchtools specific
   reg <- x$config$reg
 
-  ## Type of batchtools future
-  printf("batchtools cluster functions: %s\n",
-         sQuote(reg$cluster.functions$name))
+  if (inherits(reg, "Registry")) {
+    printf("batchtools cluster functions: %s\n",
+           sQuote(reg$cluster.functions$name))
+  } else {
+    printf("batchtools cluster functions: N/A\n")
+  }
 
   ## Ask for status once
   status <- status(x)
@@ -180,10 +183,14 @@ print.BatchtoolsFuture <- function(x, ...) {
     printf("batchtools %s: Not found (happens when finished and deleted)\n",
            class(reg))
   } else {
-    printf("batchtools Registry:\n")
-    printf("  File dir exists: %s\n", file_test("-d", reg$file.dir))
-    printf("  Work dir exists: %s\n", file_test("-d", reg$work.dir))
-    try(print(reg))
+    if (inherits(reg, "Registry")) {
+      printf("batchtools Registry:\n")
+      printf("  File dir exists: %s\n", file_test("-d", reg$file.dir))
+      printf("  Work dir exists: %s\n", file_test("-d", reg$work.dir))
+      try(print(reg))
+    } else {
+      printf("batchtools Registry: N/A\n")
+    }
   }
 
   invisible(x)
@@ -286,6 +293,7 @@ loggedError.BatchtoolsFuture <- function(future, ...) {
 
   config <- future$config
   reg <- config$reg
+  if (!inherits(reg, "Registry")) return(NULL)
   jobid <- config$jobid
   res <- getErrorMessages(reg = reg, ids = jobid)  ### CHECKED
   msg <- res$message
@@ -310,6 +318,7 @@ loggedOutput.BatchtoolsFuture <- function(future, ...) {
 
   config <- future$config
   reg <- config$reg
+  if (!inherits(reg, "Registry")) return(NULL)
   jobid <- config$jobid
   getLog(id = jobid, reg = reg)
 } # loggedOutput()
@@ -400,7 +409,29 @@ run.BatchtoolsFuture <- function(future, ...) {
   ## Always evaluate in local environment
   expr <- substitute(local(expr), list(expr = expr))
 
+  ## (i) Create batchtools registry
   reg <- future$config$reg
+  stop_if_not(is.null(reg) || inherits(reg, "Registry"))
+  if (is.null(reg)) {
+    if (debug) mprint("- Creating batchtools registry")
+    config <- future$config
+    stop_if_not(is.list(config))
+    
+    ## Create batchtools registry
+    reg <- temp_registry(
+      label             = future$label,
+      conf.file         = config$conf.file,
+      cluster.functions = config$cluster.functions,
+      config            = config$registry
+    )
+    if (debug) mprint(reg)
+    future$config$reg <- reg
+
+    ## Register finalizer?
+    if (config$finalize) future <- add_finalizer(future)
+    
+    config <- NULL
+  }
   stop_if_not(inherits(reg, "Registry"))
 
   ## (ii) Attach packages that needs to be attached
@@ -522,6 +553,7 @@ await.BatchtoolsFuture <- function(future, cleanup = TRUE,
   expr <- future$expr
   config <- future$config
   reg <- config$reg
+  stop_if_not(inherits(reg, "Registry"))
   jobid <- config$jobid
 
   mdebug("batchtools::waitForJobs() ...")
@@ -641,6 +673,10 @@ delete.BatchtoolsFuture <- function(future,
   ## Identify registry
   config <- future$config
   reg <- config$reg
+  
+  ## Trying to delete a non-launched batchtools future?
+  if (!inherits(reg, "Registry")) return(invisible(TRUE))
+  
   path <- reg$file.dir
 
   ## Already deleted?

tests/BatchtoolsFuture.R

@@ -35,8 +35,10 @@ f <- BatchtoolsFuture({ x <- 1 })
 
 ## Hack to emulate where batchtools registry is deleted or fails
 f$state <- "running"
-path <- f$config$reg$file.dir
-unlink(path, recursive = TRUE)
+if (!is.null(f$config$reg)) {
+  path <- f$config$reg$file.dir
+  unlink(path, recursive = TRUE)
+}
 
 res <- tryCatch({
   value(f)
@@ -55,20 +57,6 @@ message("*** BatchtoolsFuture() - registry exceptions ... DONE")
 
 message("*** BatchtoolsFuture() - exceptions ...")
 
-f <- BatchtoolsFuture({ 42L })
-res <- tryCatch({
-  loggedError(f)
-}, error = function(ex) ex)
-print(res)
-stopifnot(inherits(res, "error"))
-
-f <- BatchtoolsFuture({ 42L })
-res <- tryCatch({
-  loggedOutput(f)
-}, error = function(ex) ex)
-print(res)
-stopifnot(inherits(res, "error"))
-
 res <- try(f <- BatchtoolsFuture(42L, workers = integer(0)), silent = TRUE)
 print(res)
 stopifnot(inherits(res, "try-error"))

tests/plan.R

@@ -41,20 +41,27 @@ for (type in c("batchtools_interactive", "batchtools_local")) {
   f <- future(42, lazy = TRUE)
   ## In future releases, lazy futures may stay vanilla Future objects
   if (inherits(f, "BatchtoolsFuture")) {
-    utils::str(list(normalize_path(f$config$reg$work.dir), getwd = getwd()))
-    stopifnot(normalize_path(f$config$reg$work.dir) == getwd())
+    if (!is.null(f$config$reg)) {
+      utils::str(list(
+        normalize_path(f$config$reg$work.dir),
+        getwd = getwd()
+      ))
+      stopifnot(normalize_path(f$config$reg$work.dir) == getwd())
+    }
   }
 
   path <- tempdir()
   plan(type, registry = list(work.dir = path))
   f <- future(42, lazy = TRUE)
   ## In future releases, lazy futures may stay vanilla Future objects
   if (inherits(f, "BatchtoolsFuture")) {
-    utils::str(list(
-      normalizePath(f$config$reg$work.dir),
-      path = normalizePath(path)
-    ))
-    stopifnot(normalize_path(f$config$reg$work.dir) == normalize_path(path))
+    if (!is.null(f$config$reg)) {
+      utils::str(list(
+        normalize_path(f$config$reg$work.dir),
+        path = normalize_path(path)
+      ))
+      stopifnot(normalize_path(f$config$reg$work.dir) == normalize_path(path))
+    }
   }
 
   mprintf("*** plan('%s') ... DONE\n", type)