Future "evaluator" function that implements the new FutureBackend should never be called

Author: HenrikBengtsson

R/backend_api-ClusterFutureBackend-class.R

@@ -51,11 +51,7 @@
 #'
 #' @export
 cluster <- function(..., persistent = FALSE, workers = availableWorkers(), envir = parent.frame()) {
-  f <- Future(..., envir = envir)
-  f[["workers"]] <- workers
-  f[["persistent"]] <- persistent
-  class(f) <- c("ClusterFuture", "MultiprocessFuture", "Future")
-  f
+  stop("INTERNAL ERROR: The future::cluster() function implements the FutureBackend and should never be called directly")
 }
 class(cluster) <- c("cluster", "multiprocess", "future", "function")
 attr(cluster, "init") <- TRUE

R/backend_api-MulticoreFutureBackend-class.R

@@ -69,10 +69,7 @@
 #'
 #' @export
 multicore <- function(..., workers = availableCores(constraints = "multicore"), envir = parent.frame()) {
-  f <- Future(..., envir = envir)
-  f[["workers"]] <- workers
-  class(f) <- c("MulticoreFuture", "MultiprocessFuture", "Future")
-  f
+  stop("INTERNAL ERROR: The future::multicore() function implements the FutureBackend and should never be called directly")
 }
 class(multicore) <- c("multicore", "multiprocess", "future", "function")
 

R/backend_api-MultisessionFutureBackend-class.R

@@ -65,10 +65,7 @@
 #'
 #' @export
 multisession <- function(..., workers = availableCores(), lazy = FALSE, rscript_libs = .libPaths(), envir = parent.frame()) {
-  f <- Future(..., lazy = lazy, envir = envir)
-  f[["workers"]] <- workers
-  class(f) <- c("MultisessionFuture", "MultiprocessFuture", "Future")
-  f
+  stop("INTERNAL ERROR: The future::multisession() function implements the FutureBackend and should never be called directly")
 }
 class(multisession) <- c("multisession", "cluster", "multiprocess", "future", "function")
 attr(multisession, "init") <- TRUE

R/backend_api-SequentialFutureBackend-class.R

@@ -27,9 +27,7 @@
 #' @aliases uniprocess
 #' @export
 sequential <- function(..., envir = parent.frame()) {
-  f <- Future(..., envir = envir)
-  class(f) <- c("SequentialFuture", "UniprocessFuture", "Future")
-  f
+  stop("INTERNAL ERROR: The future::sequential() function implements the FutureBackend and should never be called directly")
 }
 class(sequential) <- c("sequential", "uniprocess", "future", "function")
 

R/utils_api-plan.R

@@ -103,28 +103,31 @@
       ## recursive loop caused by other plan() calls.
       attr(evaluator, "init") <- "done"
 
-      ## Create dummy future to trigger setup (minimum overhead)
-      f <- evaluator(NA, label = "future-plan-test", 
-                     globals = FALSE, lazy = FALSE)
-
-      ## Cleanup, by resolving it
-      ## (otherwise the garbage collector would have to do it)
-      res <- tryCatch({
-        value(f)
-      }, FutureError = identity)
-      if (inherits(res, "FutureError")) {
-        res[["message"]] <- paste0(
-          "Initialization of plan() failed, because the test future used for validation failed. The reason was: ", conditionMessage(res))
-        stop(res)
-      }
-
-      if (!identical(res, NA)) {
-        res <- if (is.null(res)) {
-          "NULL"
-        } else {
-          commaq(res)
+      ## Non-FutureBackend backends are initiated by calling the evaluator
+      if (is.null(attr(evaluator, "backend"))) {
+        ## Create dummy future to trigger setup (minimum overhead)
+        f <- evaluator(NA, label = "future-plan-test", 
+                       globals = FALSE, lazy = FALSE)
+  
+        ## Cleanup, by resolving it
+        ## (otherwise the garbage collector would have to do it)
+        res <- tryCatch({
+          value(f)
+        }, FutureError = identity)
+        if (inherits(res, "FutureError")) {
+          res[["message"]] <- paste0(
+            "Initialization of plan() failed, because the test future used for validation failed. The reason was: ", conditionMessage(res))
+          stop(res)
+        }
+  
+        if (!identical(res, NA)) {
+          res <- if (is.null(res)) {
+            "NULL"
+          } else {
+            commaq(res)
+          }
+          stop(FutureError(sprintf("Initialization of plan() failed, because the value of the test future is not NA as expected: %s", res)))
         }
-        stop(FutureError(sprintf("Initialization of plan() failed, because the value of the test future is not NA as expected: %s", res)))
       }
 
       if (debug) {

tests/cluster-missing-future-pkg.R

@@ -47,6 +47,7 @@ for (type in types) {
 
     res <- tryCatch({
       plan(cluster, workers = cl)
+      value(future(NA))
     }, error = identity)
     print(res)
     stopifnot(inherits(res, "FutureError"))

tests/future,labels.R

@@ -11,11 +11,15 @@ for (strategy in strategies) {
   for (label in list(NULL, sprintf("strategy = %s", strategy))) {
     fcn <- get(strategy, mode = "function")
     stopifnot(inherits(fcn, strategy))
-    f <- fcn(42, label = label)
-    print(f)
-    stopifnot(identical(f$label, label))
-    v <- value(f)
-    stopifnot(v == 42)
+
+    ## Non-FutureBackend:s 'evaluator' functions can be called directly
+    if (is.null(attr(fcn, "backend"))) {
+      f <- fcn(42, label = label)
+      print(f)
+      stopifnot(identical(f$label, label))
+      v <- value(f)
+      stopifnot(v == 42)
+    }
 
     f <- future(42, label = label)
     print(f)

tests/globals,tricky.R

@@ -141,16 +141,15 @@ for (cores in 1:availCores) {
       message(sprintf("value(b) = %g", value(b)))
       stopifnot(value(b) == 2)
 
-
       ## BUG FIX: In future (<= 1.0.0) a global 'pkg' would be
       ## overwritten by the name of the last package attached
       ## by the future.
       pkg <- "foo"
-      f <- sequential({ pkg })
+      f <- future({ pkg })
       v <- value(f)
       message(sprintf("value(f) = %s", sQuote(v)))
       stopifnot(pkg == "foo", v == "foo")
-      
+
       message(sprintf("Method for identifying globals: '%s' ... DONE", method))
     }
 
@@ -178,6 +177,8 @@ for (cores in 1:availCores) {
     v <- value(f)
     message(sprintf("value(f) = %s", sQuote(v)))
     stopifnot(v == TRUE)
+    
+    plan(sequential)
   } ## for (strategy ...)
 
   message(sprintf("Testing with %d cores ... DONE", cores))

tests/multicore.R

@@ -190,8 +190,12 @@ plan(cluster, workers = cl)
 ## %plan% can operate on any expression, so it
 ## works just as an withPlan({ ... }, plan = ...)
 fun <- { plan("next") } %plan% sequential
-f <- fun(1)
-stopifnot(inherits(f, "SequentialFuture"), !f$lazy, inherits(f, "SequentialFuture"))
+
+## Non-FutureBackend:s should be called directly
+if (is.null(attr(fun, "backend"))) {
+  f <- fun(1)
+  stopifnot(inherits(f, "SequentialFuture"), !f$lazy, inherits(f, "SequentialFuture"))
+}
 
 x %<-% { a <- 1 } %plan% sequential
 stopifnot(inherits(plan("next"), "cluster"))