BUG FIX: makeClusterPSOCK() failed to fall back to setup_strategy = "…

…sequential", when not supported by the current R version [#65]
HenrikBengtsson · Aug 3, 2021 · f630586 · f630586
1 parent 7bde9fa
commit f630586
Show file tree

Hide file tree

Showing 2 changed files with 28 additions and 19 deletions.
diff --git a/NEWS b/NEWS
@@ -1,14 +1,17 @@
 Package: parallelly
 ===================
 
-Version: 1.27.0-9000 [2021-07-29]
+Version: 1.27.0-9000 [2021-08-03]
 
 BUG FIXES:
 
  * Environment variable 'R_PARALLELLY_SUPPORTSMULTICORE_UNSTABLE' was
    incorrectly parsed as a logical instead of a character string. If the
    variables was set to, say, "quiet", this would cause an error when the
    package was loaded.
+
+ * makeClusterPSOCK() failed to fall back to setup_strategy = "sequential",
+   when not supported by the current R version.
 
 
 Version: 1.27.0 [2021-07-19]

diff --git a/R/makeClusterPSOCK.R b/R/makeClusterPSOCK.R
@@ -144,23 +144,37 @@ makeClusterPSOCK <- function(workers, makeNode = makeNodePSOCK, port = c("auto",
   })
   setup_strategy <- unlist(setup_strategy, use.names = FALSE)
   is_parallel <- (setup_strategy == "parallel")
+  force_sequential <- FALSE
   if (any(is_parallel)) {
     if (verbose) message(sprintf("%s - Parallel setup requested for some PSOCK nodes", verbose_prefix))
+
     if (!all(is_parallel)) {
       if (verbose) message(sprintf("%s - Parallel setup requested only for some PSOCK nodes; will revert to a sequential setup for all", verbose_prefix))
-      setup_strategy <- "sequential"
-      ## Force all nodes to be setup using the 'sequential' setup strategy
-      for (ii in which(is_parallel)) {
-        if (verbose) message(sprintf("%s - Node %d of %d ...", verbose_prefix, ii, n))
-        args <- list(workers[[ii]], port = port, ..., rank = ii, action = "options", verbose = verbose)
-        args$setup_strategy <- "sequential"
-        options <- do.call(makeNode, args = args)
-        stop_if_not(inherits(options, "makeNodePSOCKOptions"))
-        nodeOptions[[ii]] <- options
+      force_sequential <- TRUE
+    } else {
+      ## Force setup_strategy = "sequential"?
+      affected <- affected_by_bug18119()
+      if (!is.na(affected) && affected) {
+        if (verbose) message(sprintf("%s - Parallel setup requested but not supported on this version of R: %s", verbose_prefix, getRversion()))
+        force_sequential <- TRUE
       }
     }
   }
 
+  if (force_sequential) {
+    ## Force all nodes to be setup using the 'sequential' setup strategy
+    setup_strategy <- "sequential"
+
+    for (ii in which(is_parallel)) {
+      if (verbose) message(sprintf("%s - Node %d of %d ...", verbose_prefix, ii, n))
+      args <- list(workers[[ii]], port = port, ..., rank = ii, action = "options", verbose = verbose)
+      args$setup_strategy <- "sequential"
+      options <- do.call(makeNode, args = args)
+      stop_if_not(inherits(options, "makeNodePSOCKOptions"))
+      nodeOptions[[ii]] <- options
+    }
+  }
+
   ## Sanity check
   setup_strategy <- lapply(nodeOptions, FUN = function(options) {
     value <- options$setup_strategy
@@ -184,14 +198,6 @@ makeClusterPSOCK <- function(workers, makeNode = makeNodePSOCK, port = c("auto",
     cl <- NULL
   })
 
-  ## Force setup_strategy = "sequential"?
-  if (setup_strategy == "parallel") {
-    affected <- affected_by_bug18119()
-    if (!is.na(affected) && affected) {
-      setup_strategy <- "sequential"
-    }
-  }
-
   if (setup_strategy == "parallel") {
     ## To please R CMD check on R (< 4.0.0)
     if (getRversion() < "4.0.0") {
@@ -1096,7 +1102,7 @@ launchNodePSOCK <- function(options, verbose = FALSE) {
   setup_strategy <- options[["setup_strategy"]]
 
   if (setup_strategy == "parallel") {
-    stop("PSOCK cluster setup strategy 'parallel' is not yet supported")
+    stop("INTERNAL ERROR: launchNodePSOCK() called with setup_strategy='parallel', which should never occur")
   }
 
   verbose <- as.logical(verbose)