R Under development (unstable) (2024-12-03 r87418 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
Warning in doTryCatch(return(expr), name, parentenv, handler) :
  NAs introduced by coercion
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-12-03 r87418 ucrt), platform x86_64-w64-mingw32)
> 
> ## WORKAROUND: On MS Windows, each R process creates a temporary Rscript<hexcode>
> ## 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\2024_12_04_13_25_01_31804\RtmpGyUCdj/file11f185b115a9e', 'D:\temp\2024_12_04_13_25_01_31804\RtmpGyUCdj/file11f185c324cff', 'D:\temp\2024_12_04_13_25_01_31804\RtmpGyUCdj/worker.rank=1.parallelly.parent=73496.11f1846554d0.pid'
> 
> alive <- isNodeAlive(cl)
Warning in doTryCatch(return(expr), name, parentenv, handler) :
  NAs introduced by coercion
Warning in doTryCatch(return(expr), name, parentenv, handler) :
  NAs introduced by coercion
> 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")
+   }
+ }
Warning in doTryCatch(return(expr), name, parentenv, handler) :
  NAs introduced by coercion
Warning in doTryCatch(return(expr), name, parentenv, handler) :
  NAs introduced by coercion
Warning in doTryCatch(return(expr), name, parentenv, handler) :
  NAs introduced by coercion
Warning in doTryCatch(return(expr), name, parentenv, handler) :
  NAs introduced by coercion
Warning in doTryCatch(return(expr), name, parentenv, handler) :
  NAs introduced by coercion
Warning in doTryCatch(return(expr), name, parentenv, handler) :
  NAs introduced by coercion
Warning in doTryCatch(return(expr), name, parentenv, handler) :
  NAs introduced by coercion
Warning in doTryCatch(return(expr), name, parentenv, handler) :
  NAs introduced by coercion
Warning in doTryCatch(return(expr), name, parentenv, handler) :
  NAs introduced by coercion
Warning in doTryCatch(return(expr), name, parentenv, handler) :
  NAs introduced by coercion
Node 1 Node 2 
    NA     NA 
> 
> ## Remove any stray Rscript<hexcode> 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\2024_12_04_13_25_01_31804\RtmpGyUCdj/file11f185b115a9e', 'D:\temp\2024_12_04_13_25_01_31804\RtmpGyUCdj/file11f185c324cff', 'D:\temp\2024_12_04_13_25_01_31804\RtmpGyUCdj/worker.rank=1.parallelly.parent=73496.11f1846554d0.pid'
> 
> cl <- NULL
> 
> message("*** killNode() and isNodeAlive() ... done")
*** killNode() and isNodeAlive() ... done
> 
> source("incl/end.R")
> 
> proc.time()
   user  system elapsed 
   0.82    5.25   17.51