Use the 'submitted' state, if 'future' supports it

Author: HenrikBengtsson

NAMESPACE

@@ -117,6 +117,7 @@ importFrom(stringi,stri_replace_all_fixed)
 importFrom(tools,pskill)
 importFrom(utils,capture.output)
 importFrom(utils,file_test)
+importFrom(utils,packageVersion)
 importFrom(utils,sessionInfo)
 importFrom(utils,str)
 importFrom(utils,tail)

R/BatchtoolsFutureBackend-class.R

@@ -361,7 +361,9 @@ launchFuture.BatchtoolsFutureBackend <- local({
     if (debug) mdebugf("Launched future #%d", jobid$job.id)
 
     future[["submitted_on"]] <- submitted_on
-    future[["state"]] <- "running"
+
+    ## Until future (> 1.67.0) is on CRAN
+    future[["state"]] <- if (futureSupportsStateSubmitted()) "submitted" else "running"
 
     ## 6. Reserve worker for future
     registerFuture(future)
@@ -595,7 +597,15 @@ status <- function(future, ...) {
 finished <- function(future, ...) {
   status <- status(future)
   if (is_na(status)) return(NA)
-  any(c("finished", "error", "expired") %in% status)
+  if (any(c("finished", "error", "expired") %in% status)) {
+    return(TRUE)
+  }
+  
+  if (future[["state"]] == "submitted" && "started" %in% status) {
+    future[["state"]] <- "running"
+  }
+  
+  FALSE
 }
 
 

R/utils.R

@@ -198,3 +198,13 @@ assert_no_positional_args_but_first <- function(call = sys.call(sys.parent())) {
     stopf("Function %s() requires that all arguments beyond the first one are passed by name and not by position: %s", as.character(call[[1L]]), deparse(call, width.cutoff = 100L))
   }
 }
+
+
+#' @importFrom utils packageVersion
+futureSupportsStateSubmitted <- local({
+  .value <- NA
+  function() {
+    if (is.na(.value)) .value <<- (packageVersion("future") > "1.67.0")
+    .value
+  }
+})