Migrate to the 'testme' test structure

Author: HenrikBengtsson

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: progressr
-Version: 0.16.0-9014
+Version: 0.16.0-9015
 Title: An Inclusive, Unifying API for Progress Updates
 Description: A minimal, unifying API for scripts and packages to report progress updates from anywhere including when using parallel processing.  The package is designed such that the developer can to focus on what progress should be reported on without having to worry about how to present it.  The end user has full control of how, where, and when to render these progress updates, e.g. in the terminal using utils::txtProgressBar(), cli::cli_progress_bar(), in a graphical user interface using utils::winProgressBar(), tcltk::tkProgressBar() or shiny::withProgress(), via the speakers using beepr::beep(), or on a file system via the size of a file. Anyone can add additional, customized, progression handlers. The 'progressr' package uses R's condition framework for signaling progress updated. Because of this, progress can be reported from almost anywhere in R, e.g. from classical for and while loops, from map-reduce API:s like the lapply() family of functions, 'purrr', 'plyr', and 'foreach'. It will also work with parallel processing via the 'future' framework, e.g. future.apply::future_lapply(), furrr::future_map(), and 'foreach' with 'doFuture'. The package is compatible with Shiny applications.
 Authors@R: c(person("Henrik", "Bengtsson",

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 = 'progressr', 'testme', mustWork = TRUE)
+  Sys.setenv(R_TESTME_PATH = path)
+  Sys.setenv(R_TESTME_PACKAGE = 'progressr')
+  Sys.setenv(R_TESTME_NAME = name)
+  on.exit(Sys.unsetenv('R_TESTME_NAME'))
+  source(file.path(path, 'run.R'))
+}

tests/incl/end.R inst/testme/_epilogue/002.undo-state.Rtests/incl/end.R renamed to inst/testme/_epilogue/002.undo-state.R

@@ -1,11 +1,17 @@
+testme <- as.environment("testme")
+
 ## Undo options
 ## (a) Reset
 options(oopts0)
+
 ## (b) Remove added
-added <- setdiff(names(options()), names(oopts0))
-opts <- vector("list", length = length(added))
-names(opts) <- added
-options(opts)
+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:")
@@ -23,11 +29,12 @@ if (!identical(options(), oopts0)) {
     value0 <- oopts0[[name]]
     value  <- oopts[[name]]
     if (!identical(value, value0)) {
-      utils::str(list(name = name, expected = value0, actual = value))
+      if (testme[["debug"]]) {
+        utils::str(list(name = name, expected = value0, actual = value))
+      }
     }
   }
 }
-stopifnot(identical(options(), oopts0))
 
 
 ## Undo system environment variables
@@ -53,11 +60,18 @@ if (!identical(Sys.getenv(), oenvs0)) {
     value0 <- unname(oenvs0[name])
     value  <- unname(oenvs[name])
     if (!identical(value, value0)) {
-      utils::str(list(name = name, expected = value0, actual = value))
+      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(), ovars)))
+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,2 @@
+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()

inst/testme/_prologue/030.imports.R

@@ -0,0 +1,12 @@
+## Private package functions
+`%||%` <- progressr:::`%||%`
+hpaste <- progressr:::hpaste
+mdebug <- progressr:::mdebug
+mprint <- progressr:::mprint
+mprintf <- progressr:::mprintf
+mstr <- progressr:::mstr
+query_r_cmd_check <- progressr:::query_r_cmd_check
+in_r_cmd_check <- progressr:::in_r_cmd_check
+stop_if_not <- progressr:::stop_if_not
+printf <- function(...) cat(sprintf(...))
+known_progression_handlers <- progressr:::known_progression_handlers