TESTS: Add more tests - slight increase in test coverage

Author: HenrikBengtsson

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: parallelly
-Version: 1.46.1-9032
+Version: 1.46.1-9033
 Title: Enhancing the 'parallel' Package
 Imports:
     parallel,

inst/testme/test-freeCores.R

@@ -1,6 +1,6 @@
 library(parallelly)
 
-message("*** freeLoad() ...")
+message("*** freeCores() ...")
 
 free <- freeCores()
 print(free)
@@ -11,4 +11,46 @@ stopifnot(
   !is.na(free), free >= 1L
 )
 
-message("*** freeLoad() ... DONE")
+## Attributes
+stopifnot(
+  !is.null(attr(free, "loadavg")),
+  !is.null(attr(free, "maxCores")),
+  !is.null(attr(free, "memory")),
+  !is.null(attr(free, "fraction"))
+)
+
+for (memory in c("1min", "5min", "15min")) {
+  message(sprintf("- freeCores(memory = '%s')", memory))
+  free <- freeCores(memory = memory)
+  print(free)
+  stopifnot(
+    is.integer(free),
+    length(free) == 1L,
+    !is.na(free), free >= 1L,
+    identical(attr(free, "memory"), memory)
+  )
+}
+
+message("- freeCores(fraction = 0.5)")
+free_half <- freeCores(fraction = 0.5)
+print(free_half)
+stopifnot(
+  is.integer(free_half),
+  length(free_half) == 1L,
+  !is.na(free_half), free_half >= 1L,
+  identical(attr(free_half, "fraction"), 0.5)
+)
+
+
+message("- freeCores() - exceptions")
+
+res <- tryCatch(freeCores(fraction = 0), error = identity)
+stopifnot(inherits(res, "error"))
+
+res <- tryCatch(freeCores(fraction = 1.5), error = identity)
+stopifnot(inherits(res, "error"))
+
+res <- tryCatch(freeCores(fraction = NA_real_), error = identity)
+stopifnot(inherits(res, "error"))
+
+message("*** freeCores() ... DONE")

inst/testme/test-utils,cluster.R

@@ -56,4 +56,54 @@ for (os in list(NULL, "unix", "windows")) {
 }
 
 
+message("- is_localhost()")
+
+is_localhost <- parallelly:::is_localhost
+## Reset cache
+is_localhost(worker = NULL, hostname = NULL)
+
+## Known localhost names
+stopifnot(
+  is_localhost("localhost"),
+  is_localhost("127.0.0.1")
+)
+
+## Current hostname is localhost
+hostname <- Sys.info()[["nodename"]]
+stopifnot(is_localhost(hostname))
+
+## After being identified, hostname should be cached
+stopifnot(is_localhost(hostname))
+
+## A clearly non-local host
+stopifnot(!is_localhost("this-host-does-not-exist-12345.example.org"))
+
+## Reset cache for clean state
+is_localhost(worker = NULL, hostname = NULL)
+
+
+message("- is_ip_number()")
+
+is_ip_number <- parallelly:::is_ip_number
+stopifnot(
+  is_ip_number("192.168.1.1"),
+  is_ip_number("0.0.0.0"),
+  is_ip_number("255.255.255.255"),
+  !is_ip_number("256.0.0.0"),
+  !is_ip_number("not-an-ip"),
+  !is_ip_number("192.168.1"),
+  !is_ip_number("192.168.1.1.1")
+)
+
+
+message("- is_fqdn()")
+
+is_fqdn <- parallelly:::is_fqdn
+stopifnot(
+  is_fqdn("host.example.com"),
+  is_fqdn("a.b"),
+  !is_fqdn("localhost"),
+  !is_fqdn("singlename")
+)
+
 message("*** utils,cluster ... DONE")

inst/testme/test-utils.R

@@ -91,4 +91,80 @@ message("*** inRCmdCheck() ...")
 cat(sprintf("R CMD check is running: %s\n", inRCmdCheck()))
 message("*** inRCmdCheck() ... DONE")
 
+
+# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+# trim()
+# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+message("*** trim() ...")
+
+trim <- parallelly:::trim
+
+stopifnot(
+  identical(trim("  hello  "), "hello"),
+  identical(trim("hello"), "hello"),
+  identical(trim("\t hello \n"), "hello"),
+  identical(trim(""), ""),
+  identical(trim("  "), "")
+)
+
+message("*** trim() ... DONE")
+
+
+# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+# commaq()
+# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+message("*** commaq() ...")
+
+commaq <- parallelly:::commaq
+
+res <- commaq("a")
+stopifnot(identical(res, sQuote("a")))
+
+res <- commaq(c("a", "b"))
+stopifnot(identical(res, paste(sQuote(c("a", "b")), collapse = ", ")))
+
+res <- commaq(character(0))
+stopifnot(identical(res, ""))
+
+message("*** commaq() ... DONE")
+
+
+# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+# hpaste() - lastCollapse
+# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+message("*** hpaste() - lastCollapse ...")
+
+## Two-element vector with lastCollapse
+res <- hpaste(c("a", "b"), lastCollapse = " and ")
+stopifnot(identical(res, "a and b"))
+
+## Single-element vector
+res <- hpaste("a", lastCollapse = " and ")
+stopifnot(identical(res, "a"))
+
+message("*** hpaste() - lastCollapse ... DONE")
+
+
+# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+# pid_exists() - argument validation
+# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+message("*** pid_exists() - argument validation ...")
+
+## Non-existent PID
+result <- pid_exists(2^31 - 1L)
+message("pid_exists(non-existent PID): ", result)
+stopifnot(is.logical(result), length(result) == 1L,
+          isFALSE(result) || is.na(result))
+
+## Invalid arguments
+res <- tryCatch(pid_exists(-1L), error = identity)
+stopifnot(inherits(res, "error"))
+
+res <- tryCatch(pid_exists(NA_real_), error = identity)
+stopifnot(inherits(res, "error"))
+
+message("*** pid_exists() - argument validation ... DONE")
+
+options(parallelly.debug = FALSE)
+
 message("*** utils ... DONE")