TESTS: Move to 'testme' structure

Author: HenrikBengtsson

.Rbuildignore

@@ -51,7 +51,7 @@ Rplots.pdf$
 # Package specific
 #----------------------------
 ^[.]BatchJobs[.]R$
-[.]future
+^[.]future
 
 #----------------------------
 # Miscellaneous

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: future.callr
-Version: 0.8.2-9203
+Version: 0.8.2-9204
 Depends:
     R (>= 3.4.0),
     future (>= 1.34.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 = 'future.callr', 'testme', mustWork = TRUE)
+  Sys.setenv(R_TESTME_PATH = path)
+  Sys.setenv(R_TESTME_PACKAGE = 'future.callr')
+  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,77 @@
+testme <- as.environment("testme")
+
+## 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:")                
+  for (name in names(oopts0)) {
+    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:")
+  for (name in names(oenvs0)) {
+    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,8 @@
+## Look for detritus files
+testme <- as.environment("testme")
+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,28 @@
+## Look for detritus files
+testme <- as.environment("testme")
+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 @@
+loadNamespace("future.callr")