R Under development (unstable) (2024-02-13 r85898 ucrt) -- "Unsuffered Consequences" Copyright (C) 2024 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > source("incl/start.R") > > if (.Platform$OS.type == "windows") { + killNode <- function(cl) { + parallel::stopCluster(cl) + rep(TRUE, times = length(cl)) + } + } > > options(parallelly.debug = FALSE) > > message("*** killNode() and isNodeAlive() ...") *** killNode() and isNodeAlive() ... > > isNodeAliveSupported <- isTRUE(parallelly:::pid_exists(Sys.getpid())) Warning in doTryCatch(return(expr), name, parentenv, handler) : NAs introduced by coercion > message("isNodeAlive() works: ", isNodeAliveSupported) isNodeAlive() works: TRUE > > cl <- makeClusterPSOCK(2L, autoStop = FALSE) > names(cl) <- sprintf("Node %d", seq_along(cl)) > print(cl) Socket cluster with 2 nodes where 2 nodes are on host 'localhost' (R Under development (unstable) (2024-02-13 r85898 ucrt), platform x86_64-w64-mingw32) > > ## WORKAROUND: On MS Windows, each R process creates a temporary Rscript > ## file. In this test we terminate the workers such that these temporary files > ## are not cleaned up, which will trigger a NOTE by 'R CMD check'. Because of > ## this, we have to make sure to remove such files manually in this test. > if (.Platform$OS.type == "windows") { + files <- setdiff(dir(path = tempdir(), all.files = TRUE), c(".", "..")) + files <- file.path(tempdir(), files) + tmpfiles <- files + files <- parallel::clusterEvalQ(cl, { + files <- setdiff(dir(path = tempdir(), all.files = TRUE), c(".", "..")) + file.path(tempdir(), files) + }) + files <- unlist(files) + tmpfiles <- unique(c(tmpfiles, files)) + message(sprintf("- files: [n=%d] %s", length(tmpfiles), + paste(sQuote(tmpfiles), collapse = ", "))) + } - files: [n=3] 'D:\temp\Rtmpkhoyjq/file2d3042052b27', 'D:\temp\Rtmpkhoyjq/file2d3044f0a34d9', 'D:\temp\Rtmpkhoyjq/worker.rank=1.parallelly.parent=185092.2d30471cd3648.pid' > > alive <- isNodeAlive(cl) > print(alive) Node 1 Node 2 TRUE TRUE > stopifnot( + length(alive) == length(cl), + is.logical(alive) + ) > if (isNodeAliveSupported) { + stopifnot( + !anyNA(alive), + isTRUE(alive[[1]]), isTRUE(alive[[2]]), + all(alive) + ) + } > > message("- Terminate cluster nodes") - Terminate cluster nodes > signaled <- killNode(cl) > print(signaled) [1] TRUE TRUE > stopifnot( + length(signaled) == length(cl), + is.logical(signaled) + ) > ## The value of tools::pskill() is incorrect in R (< 3.5.0) > if (getRversion() >= "3.5.0") { + stopifnot( + isTRUE(signaled[[1]]), isTRUE(signaled[[2]]), + all(signaled) + ) + } > > message("- Waiting for cluster nodes to terminate") - Waiting for cluster nodes to terminate > ## It might take a moment before the background > ## workers are shutdown after having been signaled > timeout <- Sys.time() + 5.0 > repeat { + alive <- isNodeAlive(cl) + print(alive) + stopifnot( + length(alive) == length(cl), + is.logical(alive) + ) + if (!any(alive, na.rm = TRUE)) break + if (Sys.time() > timeout) { + stop("One or more cluster nodes are still running after 5 seconds") + } + } Node 1 Node 2 FALSE FALSE > > ## Remove any stray Rscript files > if (.Platform$OS.type == "windows") { + if (!isNodeAliveSupported) Sys.sleep(5.0) + tmpfiles <- tmpfiles[utils::file_test("-f", tmpfiles)] + if (length(tmpfiles) > 0L) { + warning(sprintf("Cleaning up temporary left-over files: [n=%d] %s", + length(tmpfiles), + paste(sQuote(tmpfiles), collapse = ", "))) + file.remove(tmpfiles) + tmpfiles <- tmpfiles[utils::file_test("-f", tmpfiles)] + if (length(tmpfiles) > 0L) { + stop(sprintf("Failed to remove some temporary left-over files: [n=%d] %s", + length(tmpfiles), + paste(sQuote(tmpfiles), collapse = ", "))) + } + } + } Warning: Cleaning up temporary left-over files: [n=3] 'D:\temp\Rtmpkhoyjq/file2d3042052b27', 'D:\temp\Rtmpkhoyjq/file2d3044f0a34d9', 'D:\temp\Rtmpkhoyjq/worker.rank=1.parallelly.parent=185092.2d30471cd3648.pid' > > cl <- NULL > > message("*** killNode() and isNodeAlive() ... done") *** killNode() and isNodeAlive() ... done > > source("incl/end.R") > > proc.time() user system elapsed 0.20 0.25 7.20