Merge pull request #798 from lorenzwalthert/testing-infra

- Improve testing infra (#798)

Author: lorenzwalthert

NEWS.md

@@ -16,6 +16,8 @@
 
 * Break the line between `%>%` and `{` inside and outside function calls (#825).
 
+* improved test setup with fixtures and similar (#798).
+
 # styler 1.5.1
 
 ## Alignment detection

R/testing.R

@@ -257,24 +257,19 @@ n_times_faster_with_cache <- function(x1, x2 = x1, ...,
   out <- purrr::map(1:n, n_times_faster_bench,
     x1 = x1, x2 = x2, fun = fun,
     ..., n = n, clear = clear
-  ) %>%
+  )
+  out <- out %>%
     purrr::map_dbl(
       ~ unname(.x$first["elapsed"] / .x$second["elapsed"])
     ) %>%
     mean()
 
-  if (clear %in% c("always", "final")) {
-    clear_testthat_cache()
-  }
   out
 }
 
 
 n_times_faster_bench <- function(i, x1, x2, fun, ..., n, clear) {
-  fresh_testthat_cache()
-  if ((clear == "always") || (clear == "all but last" & n != i)) {
-    on.exit(clear_testthat_cache())
-  }
+  local_test_setup(cache = TRUE)
   first <- system.time(fun(x1, ...))
 
   if (is.null(x2)) {
@@ -284,7 +279,8 @@ n_times_faster_bench <- function(i, x1, x2, fun, ..., n, clear) {
   }
   list(
     first = first,
-    second = second
+    second = second,
+    cache = cache_info(format = "tabular")
   )
 }
 
@@ -333,9 +329,34 @@ generate_test_samples <- function() {
 #' @include ui-caching.R
 clear_testthat_cache <- purrr::partial(cache_clear, "testthat", ask = FALSE)
 activate_testthat_cache <- purrr::partial(cache_activate, "testthat")
-fresh_testthat_cache <- function() {
-  clear_testthat_cache()
-  activate_testthat_cache()
+
+#' Establish testing setup for current environment
+#'
+#' @param cache Whether or not to create and activate a cache in a temporary
+#'   directory.
+#' @param .local_envir The environment to use for scoping.
+#' @details
+#' * make styler quiet.
+local_test_setup <- function(cache = FALSE,
+                             .local_envir = parent.frame()) {
+  current_cache <- cache_info(format = "tabular")
+  withr::local_options(
+    list("styler.quiet" = TRUE, "R.cache.rootPath" = tempfile()),
+    .local_envir = .local_envir
+  )
+  if (cache) {
+    withr::defer(
+      {
+        clear_testthat_cache()
+        cache_activate(basename(current_cache$location))
+        if (!current_cache$activated) {
+          cache_deactivate()
+        }
+      },
+      envir = .local_envir
+    )
+    activate_testthat_cache()
+  }
 }
 
 cache_more_specs_default <- function() {

R/ui-caching.R

@@ -112,7 +112,8 @@ cache_info <- function(cache_name = NULL, format = "both") {
 #'   function is doing.
 #' @family cache managers
 #' @export
-cache_activate <- function(cache_name = NULL, verbose = !getOption("styler.quiet", FALSE)) {
+cache_activate <- function(cache_name = NULL,
+                           verbose = !getOption("styler.quiet", FALSE)) {
   if (!is.null(cache_name)) {
     options("styler.cache_name" = cache_name)
   } else {

man/local_test_setup.Rd

@@ -1,4 +1,5 @@
 test_that("activated cache brings speedup on style_file() API", {
+  local_test_setup()
   skip_on_cran()
   n <- n_times_faster_with_cache(
     test_path("reference-objects/caching.R"),
@@ -44,32 +45,41 @@ test_that("activated cache brings speedup on style_text() API on character scala
 
 
 test_that("trailing line breaks are ignored for caching", {
+  local_test_setup(cache = TRUE)
   text1 <- paste0(text, collapse = "\n")
   text2 <- c(paste0(text, collapse = "\n"), "\n", "\n", "\n", "\n")
-  n <- n_times_faster_with_cache(text1, text2, clear = "all but last")
-  expect_equal(cache_info()$n, 3)
+  style_text(text1)
+  style_text(text2)
+  expect_equal(cache_info(format = "tabular")$n, 3)
   skip_on_cran()
+  n <- n_times_faster_with_cache(text1, text2)
   expect_gt(n, 55)
 })
 
 test_that("trailing line breaks are ignored for caching in one scalar", {
+  local_test_setup(cache = TRUE)
   text1 <- paste0(text, collapse = "\n")
   text2 <- c(paste0(text, collapse = "\n"), "\n", "\n", "\n", "\n")
-  n <- n_times_faster_with_cache(text1, text2, clear = "all but last")
-  expect_equal(cache_info()$n, 3)
+  style_text(text1)
+  style_text(text2)
+  expect_equal(cache_info(format = "tabular")$n, 3)
   skip_on_cran()
+  n <- n_times_faster_with_cache(text1, text2)
   expect_gt(n, 55)
 })
 
 test_that("trailing line breaks are ignored for caching in one scalar", {
+  local_test_setup(cache = TRUE)
   text1 <- paste0(text, collapse = "\n")
   text2 <- paste0(
     paste0(text, collapse = "\n"), "\n", "\n", "\n", "\n",
     collapse = ""
   )
-  n <- n_times_faster_with_cache(text1, text2, clear = "all but last")
-  expect_equal(cache_info()$n, 3)
+  style_text(text1)
+  style_text(text2)
+  expect_equal(cache_info(format = "tabular")$n, 3)
   skip_on_cran()
+  n <- n_times_faster_with_cache(text1, text2)
   expect_gt(n, 55)
 })
 
@@ -112,31 +122,27 @@ test_that("speedup higher when cached roxygen example code is multiple expressio
 
 
 
-capture.output(test_that("no speedup when tranformer changes", {
+test_that("no speedup when tranformer changes", {
   skip_on_cran()
-  on.exit(clear_testthat_cache())
-  fresh_testthat_cache()
+  local_test_setup()
   t1 <- tidyverse_style()
   first <- system.time(style_text(text, transformers = t1))
   t1 <- tidyverse_style(indent_by = 4)
   second <- system.time(style_text(text, transformers = t1))
   expect_false(first["elapsed"] / 1.3 > second["elapsed"])
-}))
+})
 
 
-capture.output(test_that("unactivated cache does not bring speedup", {
-  skip_on_cran()
-  on.exit(clear_testthat_cache())
-  clear_testthat_cache()
+test_that("unactivated cache does not bring speedup", {
+  skip_on_cran
+  local_test_setup()
   first <- system.time(style_file(test_path("reference-objects/caching.R")))
   second <- system.time(style_file(test_path("reference-objects/caching.R")))
   expect_false(first["elapsed"] / 4 > second["elapsed"])
-}))
+})
 
-capture.output(test_that("avoid deleting comments #584 (see commit messages)", {
-  on.exit(clear_testthat_cache())
-  clear_testthat_cache()
-  activate_testthat_cache()
+test_that("avoid deleting comments #584 (see commit messages)", {
+  local_test_setup()
   text <- c(
     "1 + 1",
     "# Comment",
@@ -151,12 +157,10 @@ capture.output(test_that("avoid deleting comments #584 (see commit messages)", {
     "NULL"
   )
   expect_equal(as.character(style_text(text2)), text2)
-}))
+})
 
-capture.output(test_that("avoid removing roxygen mask (see commit messages in #584)", {
-  on.exit(clear_testthat_cache())
-  clear_testthat_cache()
-  activate_testthat_cache()
+test_that("avoid removing roxygen mask (see commit messages in #584)", {
+  local_test_setup()
   text <- c(
     "c(",
     " 1, 2,",
@@ -176,12 +180,10 @@ capture.output(test_that("avoid removing roxygen mask (see commit messages in #5
     "NULL"
   )
   expect_equal(as.character(style_text(text2)), text2)
-}))
+})
 
-capture.output(test_that("partial caching of multiple expressions on one line works", {
-  on.exit(clear_testthat_cache())
-  clear_testthat_cache()
-  activate_testthat_cache()
+test_that("partial caching of multiple expressions on one line works", {
+  local_test_setup()
   text <- "1"
   style_text(text)
   text2 <- "1 # comment"
@@ -195,7 +197,7 @@ capture.output(test_that("partial caching of multiple expressions on one line wo
   style_text(c("mtcars %>%", "f()"))
   final_text <- c("mtcars %>%", "  f() #")
   expect_equal(as.character(style_text(final_text)), final_text)
-}))
+})
 
 test_that("cache is deactivated at end of caching related testthat file", {
   expect_false(cache_is_activated())

tests/testthat/test-cache-high-level-api.R

@@ -1,9 +1,8 @@
 test_that("base_indention is respected in caching", {
-  on.exit(clear_testthat_cache())
   text <- c("1 + 1")
-  fresh_testthat_cache()
+  local_test_setup(cache = TRUE)
   without_indention <- style_text(text)
-  fresh_testthat_cache()
+  local_test_setup(cache = TRUE)
   style_text(text, base_indention = 5)
   expect_equal(
     style_text(text),
@@ -12,11 +11,10 @@ test_that("base_indention is respected in caching", {
 })
 
 test_that("include_roxygen_exmples is respected in caching", {
-  on.exit(clear_testthat_cache())
   text <- c("#' Roxygen", "#'", "#' @examplesIf", "#' 1+1", "1 + 1")
-  fresh_testthat_cache()
+  local_test_setup(cache = TRUE)
   with_examples <- style_text(text)
-  fresh_testthat_cache()
+  local_test_setup(cache = TRUE)
   style_text(text, include_roxygen_examples = FALSE)
   expect_equal(
     style_text(text, include_roxygen_examples = TRUE),
@@ -26,8 +24,7 @@ test_that("include_roxygen_exmples is respected in caching", {
 
 
 test_that("expression caching when first expression does not comply", {
-  on.exit(clear_testthat_cache())
-  fresh_testthat_cache()
+  local_test_setup(cache = TRUE)
   more <- 'x<- 1
    "multi
 line string"
@@ -86,8 +83,7 @@ line string"
 })
 
 test_that("expression caching when last expression does not comply", {
-  on.exit(clear_testthat_cache())
-  fresh_testthat_cache()
+  local_test_setup(cache = TRUE)
   more <- '   x <- 1
    "multi
 line string"
@@ -120,8 +116,7 @@ line string"
 })
 
 test_that("expression caching when middle expression does not comply", {
-  on.exit(clear_testthat_cache())
-  fresh_testthat_cache()
+  local_test_setup(cache = TRUE)
   more <- '   x <- 1
    "multi
 line string"

tests/testthat/test-cache-interaction-base-indention.R

@@ -1,9 +1,8 @@
 test_that("base_indention is respected in caching", {
-  on.exit(clear_testthat_cache())
+  local_test_setup(cache = TRUE)
   text <- c("1 + 1")
-  fresh_testthat_cache()
   without_indention <- style_text(text)
-  fresh_testthat_cache()
+  local_test_setup(cache = TRUE)
   style_text(text, base_indention = 5)
   expect_equal(
     style_text(text),

tests/testthat/test-cache-interaction-more-specs.R

@@ -1,6 +1,5 @@
 test_that("roxzgen code examples are written to cache as both individual expressions and as whole text", {
-  on.exit(clear_testthat_cache())
-  fresh_testthat_cache()
+  local_test_setup(cache = TRUE)
   more_specs <- cache_more_specs_default()
   text <- c(
     "#' Comment",
@@ -13,7 +12,7 @@ test_that("roxzgen code examples are written to cache as both individual express
     "103"
   )
   styled <- style_text(text)
-  expect_equal(cache_info()$n, 6)
+  expect_equal(cache_info(format = "tabular")$n, 6)
   # 1 whole (with comments)
   # 1code whole
   # 1 code by expr
@@ -46,8 +45,7 @@ test_that("roxzgen code examples are written to cache as both individual express
 
 test_that("roxzgen code examples are written to cache as whole expressions bring speedgain", {
   skip_on_cran()
-  on.exit(clear_testthat_cache())
-  fresh_testthat_cache()
+  local_test_setup(cache = TRUE)
   text <- readLines(test_path("cache-with-r-cache/roxygen-cache-1.R"))
   first <- system.time(styled <- style_text(text))
   # don't use full cache, only roxygen cache

tests/testthat/test-cache-interaction-roxygen-code-examples.R

@@ -57,8 +57,7 @@ test_that("caching utils make right blocks with comments", {
 
 
 test_that("blank lines are correctly identified", {
-  on.exit(clear_testthat_cache())
-  fresh_testthat_cache()
+  local_test_setup(cache = TRUE)
 
   text <- c(
     "1 + 1",
@@ -121,10 +120,9 @@ test_that("caching utils make right blocks with comments", {
 ################################################################################
 
 test_that("Individual comment expressions are not cached", {
-  on.exit(clear_testthat_cache())
-  fresh_testthat_cache()
+  local_test_setup(cache = TRUE)
   style_text(c("# g", "1"))
-  cache_info <- cache_info()
+  cache_info <- cache_info(format = "tabular")
   # because output text is cached as a whole, there should be 2 cached
   # expressions now
   expect_equal(cache_info$n, 2)