BUG FIX: If a 'callr' future failed, because the parallel processed c…

…rashed,

the corresponding parallel-worker slot was never released.
Related to HenrikBengtsson/future#677

.gitignore

@@ -8,6 +8,7 @@
 .test
 .local
 .make/
+.Rdump/
 *.o
 *.dll
 *.Rout

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: future.callr
-Version: 0.8.1-9001
+Version: 0.8.1-9002
 Depends:
     R (>= 3.4.0),
     future (>= 1.23.0)

NEWS.md

@@ -1,6 +1,9 @@
 # Version (development version)
 
- * ...
+## Bug Fixes
+
+ * If a 'callr' future failed, because the parallel processed crashed,
+   the corresponding parallel-worker slot was never released.
 
 
 # Version 0.8.1 [2022-12-13]

R/CallrFuture-class.R

@@ -337,7 +337,23 @@ await <- local({
     ## Failed?
     if (inherits(result, "error")) {
       msg <- post_mortem_failure(result, future = future)
-      stop(CallrFutureError(msg, future = future))
+      ex <- CallrFutureError(msg, future = future)
+
+      ## Remove future from FutureRegistry?
+      if (!process$is_alive()) {
+        reg <- "workers-callr"
+        if (packageVersion("future") >= "1.32.0-9006") {
+          if (FutureRegistry(reg, action = "contains", future = future)) {
+            FutureRegistry(reg, action = "remove", future = future)
+          }
+        } else {
+          tryCatch({
+            FutureRegistry(reg, action = "remove", future = future)
+          }, error = identity)
+        }
+      }
+
+      stop(ex)
     }
 
     if (debug) mdebugf("- callr:::get_result() ... done (after %d attempts)", ii)

tests/callr,worker-termination.R

@@ -0,0 +1,27 @@
+source("incl/start.R")
+
+message("*** callr() - terminating workers ...")
+
+plan(callr, workers = 2L)
+
+all <- nbrOfWorkers()
+free <- nbrOfFreeWorkers()
+stopifnot(
+  nbrOfWorkers() == 2L,
+  nbrOfFreeWorkers() == 2L
+)
+
+## Force R worker to quit
+f <- future({ tools::pskill(pid = Sys.getpid()) })
+res <- tryCatch(value(f), error = identity)
+print(res)
+stopifnot(inherits(res, "FutureError"))
+
+stopifnot(
+  nbrOfWorkers() == all,
+  nbrOfFreeWorkers() == free
+)
+
+message("*** callr() - terminating workers ... DONE")
+
+source("incl/end.R")