TESTS: Use 'testme' for unit tests

Author: HenrikBengtsson

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: doFuture
-Version: 1.0.2-9002
+Version: 1.0.2-9003
 Title: Use Foreach to Parallelize via the Future Framework
 Depends:
     foreach (>= 1.5.0),

R/testme.R

@@ -0,0 +1,10 @@
+## This runs 'testme' test inst/testme/test-<name>.R scripts
+## Don't edit - it was autogenerated by inst/testme/deploy.R
+testme <- function(name) {
+  path <- system.file(package = 'doFuture', 'testme', mustWork = TRUE)
+  Sys.setenv(R_TESTME_PATH = path)
+  Sys.setenv(R_TESTME_PACKAGE = 'doFuture')
+  Sys.setenv(R_TESTME_NAME = name)
+  on.exit(Sys.unsetenv('R_TESTME_NAME'))
+  source(file.path(path, 'run.R'))
+}

inst/testme/_epilogue/001.undo-future.R

@@ -0,0 +1,5 @@
+## Undo future debug
+options(future.debug = FALSE)
+
+## Undo future strategy
+future::plan(oplan)

inst/testme/_epilogue/002.undo-state.R

@@ -0,0 +1,79 @@
+testme <- as.environment("testme")
+hpaste <- future:::hpaste
+
+## Undo options
+## (a) Reset
+options(oopts0)
+
+## (b) Remove added
+local({
+  added <- setdiff(names(options()), names(oopts0))
+  opts <- vector("list", length = length(added))
+  names(opts) <- added
+  options(opts)
+})
+
+## (c) Assert that everything was undone
+if (!identical(options(), oopts0)) {
+  message("Failed to undo options:")
+  oopts <- options()
+  message(sprintf(" - Expected options: [n=%d] %s",
+                  length(oopts0), hpaste(sQuote(names(oopts0)))))
+  extra <- setdiff(names(oopts), names(oopts0))
+  message(paste(sprintf(" - Options still there: [n=%d]", length(extra)),
+                hpaste(sQuote(extra))))
+  missing <- setdiff(names(oopts0), names(oopts))
+  message(paste(sprintf(" - Options missing: [n=%d]", length(missing)),
+                hpaste(sQuote(missing))))
+                
+  message("Differences option by option:")
+  void <- lapply(names(oopts0), FUN = function(name) {
+    value0 <- oopts0[[name]]
+    value  <- oopts[[name]]
+    if (!identical(value, value0)) {
+      if (testme[["debug"]]) {
+        utils::str(list(name = name, expected = value0, actual = value))
+      }
+    }
+  })
+}
+
+
+## Undo system environment variables
+## (a) Reset
+do.call(Sys.setenv, args=as.list(oenvs0))
+## (b) Removed added
+added <- setdiff(names(Sys.getenv()), names(oenvs0))
+Sys.unsetenv(added)
+## (c) Assert that everything was undone
+if (!identical(Sys.getenv(), oenvs0)) {
+  message("Failed to undo environment variables:")
+  oenvs <- Sys.getenv()
+  message(sprintf(" - Expected environment variables: [n=%d] %s",
+                  length(oenvs0), hpaste(sQuote(names(oenvs0)))))
+  extra <- setdiff(names(oenvs), names(oenvs0))
+  message(paste(sprintf(" - Environment variables still there: [n=%d]", length(extra)),
+                hpaste(sQuote(extra))))
+  missing <- setdiff(names(oenvs0), names(oenvs))
+  message(paste(sprintf(" - Environment variables missing: [n=%d]", length(missing)),
+                hpaste(sQuote(missing))))
+  message("Differences environment variable by environment variable:")
+  void <- lapply(names(oenvs0), FUN = function(name) {
+    value0 <- unname(oenvs0[name])
+    value  <- unname(oenvs[name])
+    if (!identical(value, value0)) {
+      if (testme[["debug"]]) {
+        utils::str(list(name = name, expected = value0, actual = value))
+      }
+    }
+  })
+}
+
+
+## Assert undo was successful
+if (testme[["debug"]]) {
+  stopifnot(identical(options(), oopts0))
+}
+
+## Undo variables
+rm(list = c(setdiff(ls(envir = globalenv()), ovars)), envir = globalenv())

inst/testme/_epilogue/090.gc.R

@@ -0,0 +1,8 @@
+## Travis CI specific: Explicit garbage collection because it
+## looks like Travis CI might run out of memory during 'covr'
+## testing and we now have so many tests. /HB 2017-01-11
+if ("covr" %in% loadedNamespaces()) {
+  res <- gc()
+  testme <- as.environment("testme")
+  if (testme[["debug"]]) print(res)
+}

inst/testme/_epilogue/099.session_info.R

@@ -0,0 +1,6 @@
+testme <- as.environment("testme")
+if (testme[["debug"]]) {
+  info <- utils::sessionInfo()
+  message("Session information:")
+  print(info)
+}

inst/testme/_epilogue/995.detritus-connections.R

@@ -0,0 +1,11 @@
+## Look for detritus files
+testme <- as.environment("testme")
+local({
+  delta <- diff_connections(get_connections(), testme[["testme_connections"]])
+  if (any(lengths(delta) > 0)) {
+    message(sprintf("Detritus connections generated by test %s:", sQuote(testme[["name"]])))
+    print(delta)
+  }
+})
+
+

inst/testme/_epilogue/999.detritus-files.R

@@ -0,0 +1,31 @@
+## Look for detritus files
+testme <- as.environment("testme")
+
+local({
+  path <- dirname(tempdir())
+  
+  if (basename(path) == "working_dir") {
+    files <- dir(pattern = "^Rscript", path = path, all.files = TRUE, full.names = TRUE)
+    if (length(files) > 0L) {
+      message(sprintf("Detritus 'Rscript*' files generated by test %s:", sQuote(testme[["name"]])))
+      print(files)
+      
+      ## Remove detritus files produced by this test script, so that
+      ## other test scripts will not fail because of these files.
+      unlink(files)
+  
+      ## Signal the problem
+      msg <- sprintf("Detected 'Rscript*' files: [n=%d] %s", length(files), paste(sQuote(basename(files)), collapse = ", "))
+      ## Are detritus files files expected by design on MS Windows?
+      ## If so, produce a warning, otherwise an error
+      if ("detritus-files" %in% testme[["tags"]] &&
+          .Platform[["OS.type"]] == "windows") {
+        warning(msg, immediate. = TRUE)
+      } else {
+        stop(msg)
+      }
+    }
+  } else {
+    message(sprintf("Skipping, because path appears not to be an 'R CMD check' folder: %s", sQuote(path)))
+  }
+})

inst/testme/_prologue/001.load.R

@@ -0,0 +1,3 @@
+testme <- as.environment("testme")
+loadNamespace(testme[["package"]])
+

inst/testme/_prologue/002.record-state.R

@@ -0,0 +1,4 @@
+## Record original state
+ovars <- ls(envir = globalenv())
+oenvs <- oenvs0 <- Sys.getenv()
+oopts0 <- options()