Merge pull request #115 from ropensci/test_setup_method

Test cleanup
ropensci · Apr 15, 2024 · 4cace24 · 4cace24
2 parents 1abe899 + b5fbff6
commit 4cace24
Show file tree

Hide file tree

Showing 14 changed files with 68 additions and 48 deletions.
diff --git a/R/autodoc.R b/R/autodoc.R
@@ -15,6 +15,7 @@
   }
 
   # create Roxygen documentation for data package
+  on.exit(close(con))
   con <- file(tempfilename, open = "w")
   writeLines(
     c(
@@ -90,5 +91,4 @@
       ), con
     )
   }
-  close(con)
 }
diff --git a/R/build.R b/R/build.R
@@ -20,12 +20,12 @@
 #' @importFrom futile.logger flog.logger flog.trace appender.file flog.debug flog.info flog.warn flog.error flog.fatal flog.appender flog.threshold INFO TRACE appender.console appender.tee
 #' @importFrom knitr knit spin
 #' @details Note that if \code{package_build} returns an error when rendering an \code{.Rmd}
-#' internally, but that same \code{.Rmd} can be run successfully manually using \code{rmarkdown::render}, 
-#' then the following code facilitates debugging. Set \code{options(error = function(){ sink(); recover()})} 
-#' before running \code{package_build} . This will enable examination of the active function calls at the time of the error, 
-#' with output printed to the console rather than \code{knitr}'s default sink. 
-#' After debugging, evaluate \code{options(error = NULL)} to revert to default error handling. 
-#' See section "22.5.3 RMarkdown" at \url{ https://adv-r.hadley.nz/debugging.html} for more details. 
+#' internally, but that same \code{.Rmd} can be run successfully manually using \code{rmarkdown::render},
+#' then the following code facilitates debugging. Set \code{options(error = function(){ sink(); recover()})}
+#' before running \code{package_build} . This will enable examination of the active function calls at the time of the error,
+#' with output printed to the console rather than \code{knitr}'s default sink.
+#' After debugging, evaluate \code{options(error = NULL)} to revert to default error handling.
+#' See section "22.5.3 RMarkdown" at \url{ https://adv-r.hadley.nz/debugging.html} for more details.
 #' @export
 #' @examples
 #' if(rmarkdown::pandoc_available()){
@@ -51,7 +51,6 @@ package_build <- function(packageName = NULL,
                           ...) {
   .multilog_setup(LOGFILE = NULL)
   # flog.appender(appender.console())
-  # requireNamespace("futile.logger")
   if (is.null(packageName)) {
     packageName <- "."
     # use normalizePath

diff --git a/R/processData.R b/R/processData.R
@@ -31,7 +31,6 @@
 #' @importFrom utils getSrcref modifyList
 #' @importFrom usethis proj_set proj_get
 DataPackageR <- function(arg = NULL, deps = TRUE) {
-  # requireNamespace("futile.logger")
   pkg_dir <- arg
   pkg_dir <- normalizePath(pkg_dir, winslash = "/")
   cat("\n")
@@ -455,16 +454,19 @@ DataPackageR <- function(arg = NULL, deps = TRUE) {
           new = missing_doc
         )
         file.info("Writing merged docs.")
-        docfile <- file(
-          file.path(
-            target,
-            paste0("documentation", ".R")
-          ),
-          open = "w"
-        )
-        for (i in seq_along(doc_parsed)) {
-          writeLines(text = doc_parsed[[i]], con = docfile)
-        }
+        local({
+          on.exit(close(docfile))
+          docfile <- file(
+            file.path(
+              target,
+              paste0("documentation", ".R")
+            ),
+            open = "w"
+          )
+          for (i in seq_along(doc_parsed)) {
+            writeLines(text = doc_parsed[[i]], con = docfile)
+          }
+        })
       }
       # Partial build if enabled=FALSE for
       # any file We've disabled an object but don't

diff --git a/R/use.R b/R/use.R
@@ -137,7 +137,7 @@ use_processing_script <- function(file = NULL, title = NULL, author = NULL, over
     (grepl("\\.r$", tolower(raw_file)) |
       grepl("\\.rmd$", tolower(raw_file)))) {
     # we have a valid file name and should create it.
-    if (utils::file_test("-f", normalizePath(file.path(proj_path, "data-raw", basename(raw_file)), winslash = "/")) &&
+    if (file.exists(file.path(proj_path, "data-raw", basename(raw_file))) &&
         !overwrite) {
       .bullet(paste0("Skipping file creation: pass overwrite = TRUE to use_processing_script()"), bullet = crayon::red("\u2622")) #nolint
     } else {

diff --git a/R/zzz.R b/R/zzz.R
@@ -1,4 +1,12 @@
 .onLoad <- function(libname, pkgname) {
-  options("DataPackageR_interact" = interactive())
+  # keeping this first option hardcoded on load for now
   options("DataPackageR_packagebuilding" = FALSE)
+  # respect previous user setting for 'DataPackageR_interact' if set
+  op <- options()
+  op.DataPackageR <- list(
+    DataPackageR_interact = interactive()
+  )
+  toset <- !(names(op.DataPackageR) %in% names(op))
+  if (any(toset)) options(op.DataPackageR[toset])
+  invisible()
 }
diff --git a/inst/extdata/tests/extra.rmd b/inst/extdata/tests/extra.rmd
@@ -30,8 +30,7 @@ This API reads from an environment named `ENVS`, containing `subsetCars` and any
 This file will add the pressure data set to the example.
 
 ```{r}
-data(pressure)
-pressure <- pressure # need to do an assignment
+data(pressure, envir = environment())
 plot(pressure)
 ```
 
diff --git a/man/package_build.Rd b/man/package_build.Rd
diff --git a/tests/testthat.R b/tests/testthat.R
@@ -1,8 +1,6 @@
 library(testthat)
 library(DataPackageR)
-options("DataPackageR_interact" = FALSE)
 # Test only if pandoc is available.
 if (rmarkdown::pandoc_available()) {
   test_check("DataPackageR")
 }
-options("DataPackageR_interact" = interactive())
diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R
@@ -0,0 +1,10 @@
+# use these options for testthat tests, interactively or non-interactively,
+# and restore previously set options when tests are finished
+# https://testthat.r-lib.org/articles/special-files.html
+withr::local_options(
+  list(
+    DataPackageR_interact = FALSE,
+    DataPackageR_packagebuilding = FALSE
+    ),
+  .local_envir = teardown_env()
+)
diff --git a/tests/testthat/test-build-locations.R b/tests/testthat/test-build-locations.R
@@ -1,9 +1,4 @@
 context("building packages")
-test_that(".onLoad sets options", {
-  DataPackageR:::.onLoad()
-  expect_true(getOption("DataPackageR_interact") == interactive())
-  options("DataPackageR_interact" = FALSE)
-})
 
 test_that("package can be built from different locations", {
   file <- system.file("extdata", "tests", "subsetCars.Rmd",

diff --git a/tests/testthat/test-data-version.R b/tests/testthat/test-data-version.R
@@ -4,7 +4,15 @@ test_that("assert_data_version", {
   f <- tempdir()
   f <- file.path(f, "foo.Rmd")
   con <- file(f)
-  writeLines("```{r}\n tbl = table(sample(1:10,1000,replace=TRUE)) \n```\n",
+  writeLines(
+    c("---",
+      'title: "foo"',
+      "---",
+      "",
+      "```{r}",
+      "tbl = table(sample(1:10,1000,replace=TRUE))",
+      "```"
+    ),
     con = con
   )
   close(con)
@@ -17,7 +25,7 @@ test_that("assert_data_version", {
     code_files = f
   ))
   package_build(file.path(tempdir(), pname))
-
+  on.exit(devtools::unload(pname))
   devtools::load_all(file.path(tempdir(), pname))
   suppressWarnings(expect_true(
     data_version(pkg = pname) == numeric_version("0.1.0")

diff --git a/tests/testthat/test-edge-cases.R b/tests/testthat/test-edge-cases.R
@@ -1,9 +1,8 @@
 context("edge cases")
 test_that("package built in different edge cases", {
-  require(futile.logger)
-  DataPackageR:::.multilog_setup(normalizePath(file.path(tempdir(),"test.log"), winslash = "/"))
+  DataPackageR:::.multilog_setup(file.path(tempdir(),"test.log"))
   DataPackageR:::.multilog_thresold(INFO, TRACE)
-  
+
   file <- system.file("extdata", "tests", "subsetCars.Rmd",
     package = "DataPackageR"
   )
@@ -57,7 +56,9 @@ test_that("package built in different edge cases", {
     force = TRUE,
     recursive = TRUE
   )
-  package.skeleton("foo", path = tempdir())
+  test_env <- new.env()
+  assign('test_obj', pi, envir = test_env)
+  package.skeleton("foo", path = tempdir(), environment = test_env)
   suppressWarnings(expect_error(
     DataPackageR:::DataPackageR(
       file.path(tempdir(), "foo")
@@ -88,7 +89,7 @@ test_that("package built in different edge cases", {
   )
 
 
-  package.skeleton("foo", path = tempdir(), force = TRUE)
+  package.skeleton("foo", path = tempdir(), environment = test_env, force = TRUE)
   expect_error(yml_find(file.path(tempdir(), "foo")))
   dir.create(file.path(tempdir(), "foo", "data-raw"))
   unlink(file.path(tempdir(), "foo", "DESCRIPTION"))
@@ -168,8 +169,8 @@ test_that("package built in different edge cases", {
     force = TRUE,
     recursive = TRUE
   )
-  package.skeleton("foo", path = tempdir())
-  DataPackageR:::.multilog_setup(normalizePath(file.path(tempdir(),"test.log"), winslash = "/"))
+  package.skeleton("foo", path = tempdir(), environment = test_env, force = TRUE)
+  DataPackageR:::.multilog_setup(file.path(tempdir(),"test.log"))
   DataPackageR:::.multilog_thresold(INFO, TRACE)
 
   # data in digest changes while names do not
@@ -243,7 +244,7 @@ test_that("package built in different edge cases", {
       )
     )
   }))
-  
+
   unlink(file.path(tempdir(), "foo"),
     force = TRUE,
     recursive = TRUE
@@ -296,7 +297,7 @@ test_that("package built in different edge cases", {
     force = TRUE,
     recursive = TRUE
   )
-  package.skeleton(path = tempdir(), "foo")
+  package.skeleton("foo", path = tempdir(), environment = test_env, force = TRUE)
   dir.create(file.path(tempdir(), "foo", "data-raw"))
   suppressWarnings(
     expect_error(

diff --git a/tests/testthat/test-news-update.R b/tests/testthat/test-news-update.R
@@ -10,12 +10,11 @@ test_that("news file is created", {
     force = TRUE,
     r_object_names = c("cars_over_20")
   )
-  options(DataPackageR_interact = FALSE)
   package_build(file.path(tempdir(), "subsetCars"))
   expect_equal(readLines(file.path(tempdir(), "subsetCars", "NEWS.md"))[3], "Package built in non-interactive mode") # nolint
   unlink(file.path(tempdir(), "subsetCars"),
     recursive = TRUE,
     force = TRUE
   )
-  expect_equal(DataPackageR:::.prompt_user_for_change_description(interact = FALSE), "Package built in non-interactive mode") # nolint
+  expect_equal(DataPackageR:::.prompt_user_for_change_description(), "Package built in non-interactive mode") # nolint
 })
diff --git a/tests/testthat/test-pkg_description.R b/tests/testthat/test-pkg_description.R
@@ -15,6 +15,7 @@ test_that("can_read_pkg_description,  data_version", {
     r_object_names = c("cars_over_20", "pressure")
   )
   DataPackageR:::read_pkg_description(file.path(tempdir(), "subsetCars"))
+  on.exit(devtools::unload("subsetCars"))
   devtools::load_all(file.path(tempdir(), "subsetCars"))
   expected_version <-
     structure(list(c(0L, 1L, 0L)),