Use withr::defer() instead of on.exit()

Author: hadley

R/mock.R

@@ -40,7 +40,7 @@ with_mock <- function(..., .env = topenv()) {
   mock_funs <- lapply(dots[!code_pos], eval, parent.frame())
   mocks <- extract_mocks(mock_funs, .env = .env)
 
-  on.exit(lapply(mocks, reset_mock), add = TRUE)
+  withr::defer(lapply(mocks, reset_mock))
   lapply(mocks, set_mock)
 
   # Evaluate the code
@@ -60,7 +60,7 @@ local_mock <- function(..., .env = topenv(), .local_envir = parent.frame()) {
 
   mocks <- extract_mocks(list(...), .env = .env)
   on_exit <- bquote(
-    on.exit(lapply(.(mocks), .(reset_mock)), add = TRUE),
+    withr::defer(lapply(.(mocks), .(reset_mock))),
   )
 
   lapply(mocks, set_mock)

R/reporter-debug.R

@@ -13,7 +13,7 @@ DebugReporter <- R6::R6Class(
       if (!expectation_success(result) && !is.null(result$start_frame)) {
         if (sink_number() > 0) {
           sink(self$out)
-          on.exit(sink(), add = TRUE)
+          withr::defer(sink())
         }
 
         recover2(
@@ -53,7 +53,7 @@ recover2 <- function(start_frame = 1L, end_frame = sys.nframe()) {
 
   if (.isMethodsDispatchOn()) {
     tState <- tracingState(FALSE)
-    on.exit(tracingState(tState))
+    withr::defer(tracingState(tState))
   }
   from <- min(end_frame, length(calls))
 

R/reporter-zzz.R

@@ -39,7 +39,7 @@ with_reporter <- function(reporter, code, start_end_reporter = TRUE) {
   reporter <- find_reporter(reporter)
 
   old <- set_reporter(reporter)
-  on.exit(set_reporter(old), add = TRUE)
+  withr::defer(set_reporter(old))
 
   if (start_end_reporter) {
     reporter$start_reporter()

R/source.R

@@ -33,7 +33,7 @@ source_file <- function(
   ## We need to parse from a connection, because parse() has a bug,
   ## and converts the input to the native encoding, if the text arg is used
   con <- textConnection(lines, encoding = "UTF-8")
-  on.exit(try(close(con), silent = TRUE), add = TRUE)
+  withr::defer(try(close(con), silent = TRUE))
   exprs <- parse(con, n = -1, srcfile = srcfile, encoding = "UTF-8")
   exprs <- filter_desc(exprs, desc, error_call = error_call)
 
@@ -44,7 +44,7 @@ source_file <- function(
 
   if (chdir) {
     old_dir <- setwd(dirname(path))
-    on.exit(setwd(old_dir), add = TRUE)
+    withr::defer(setwd(old_dir))
   }
 
   withr::local_options(testthat_topenv = env, testthat_path = path)

R/teardown.R

@@ -73,7 +73,7 @@ teardown_run <- function(path = ".") {
   }
 
   old_dir <- setwd(path)
-  on.exit(setwd(old_dir), add = TRUE)
+  withr::defer(setwd(old_dir))
 
   lapply(file_teardown_env$queue, function(f) try(f()))
   teardown_reset()

R/test-files.R

@@ -341,7 +341,7 @@ test_one_file <- function(
   error_call = caller_env()
 ) {
   reporter <- get_reporter()
-  on.exit(teardown_run(), add = TRUE)
+  withr::defer(teardown_run())
 
   reporter$start_file(path)
   source_file(

R/test-that.R

@@ -65,7 +65,7 @@ test_code <- function(test, code, env, reporter, skip_on_empty = TRUE) {
 
   if (!is.null(test)) {
     reporter$start_test(context = reporter$.context, test = test)
-    on.exit(reporter$end_test(context = reporter$.context, test = test))
+    withr::defer(reporter$end_test(context = reporter$.context, test = test))
   }
 
   ok <- TRUE
@@ -111,7 +111,7 @@ test_code <- function(test, code, env, reporter, skip_on_empty = TRUE) {
     # case of a stack overflow.  This is important for the DebugReporter.
     # Call options() manually, avoid withr overhead.
     options(expressions = expressions_opt_new)
-    on.exit(options(expressions = expressions_opt), add = TRUE)
+    withr::defer(options(expressions = expressions_opt))
 
     # Add structured backtrace to the expectation
     if (can_entrace(e)) {
@@ -180,7 +180,7 @@ test_code <- function(test, code, env, reporter, skip_on_empty = TRUE) {
 
   test_env <- new.env(parent = env)
   old <- options(rlang_trace_top_env = test_env)[[1]]
-  on.exit(options(rlang_trace_top_env = old), add = TRUE)
+  withr::defer(options(rlang_trace_top_env = old))
 
   withr::local_options(testthat_topenv = test_env)
 

tests/test-catch.R

@@ -12,7 +12,7 @@ local({
 
   perform_test <- function(pkgName, catchEnabled) {
     owd <- setwd(tempdir())
-    on.exit(setwd(owd), add = TRUE)
+    withr::defer(setwd(owd))
 
     pkgPath <- file.path(tempdir(), pkgName)
     libPath <- file.path(tempdir(), "rlib")
@@ -21,13 +21,10 @@ local({
     }
     .libPaths(c(libPath, .libPaths()))
 
-    on.exit(
-      {
-        unlink(pkgPath, recursive = TRUE)
-        unlink(libPath, recursive = TRUE)
-      },
-      add = TRUE
-    )
+    withr::defer({
+      unlink(pkgPath, recursive = TRUE)
+      unlink(libPath, recursive = TRUE)
+    })
 
     quietly(usethis::create_package(pkgPath, open = FALSE))
     quietly(testthat::use_catch(pkgPath))

tests/testthat/test-expect-inheritance.R

@@ -31,7 +31,7 @@ test_that("test_s4_class respects class hierarchy", {
   A <- methods::setClass("A", contains = "list")
   B <- methods::setClass("B", contains = "list")
   C <- methods::setClass("C", contains = c("A", "B"))
-  on.exit({
+  withr::defer({
     methods::removeClass("A")
     methods::removeClass("B")
     methods::removeClass("C")

tests/testthat/test-expect-known.R

@@ -4,7 +4,7 @@ local_edition(2)
 
 test_that("uses specified width", {
   old <- options(width = 20)
-  on.exit(options(old), add = TRUE)
+  withr::defer(options(old))
 
   x <- 1:100
   expect_known_output(print(x), "width-80.txt")
@@ -51,7 +51,7 @@ test_that("Warning for non-UTF-8 reference files", {
   Encoding(x) <- "latin1"
 
   tmp <- tempfile()
-  on.exit(unlink(tmp), add = TRUE)
+  withr::defer(unlink(tmp))
   writeBin(x, tmp)
 
   suppressWarnings(
@@ -81,7 +81,7 @@ test_that("first run is successful", {
 
 test_that("equal_to_ref does not overwrite existing", {
   tmp_rds <- tempfile(fileext = ".rds")
-  on.exit(unlink(tmp_rds))
+  withr::defer(unlink(tmp_rds))
   ref_obj1 <- 1:3
   ref_obj2 <- 2:4
   saveRDS(ref_obj1, tmp_rds)
@@ -99,7 +99,7 @@ test_that("equal_to_ref does not overwrite existing", {
 
 test_that("serializes to version 2 by default", {
   tmp_rds <- tempfile(fileext = ".rds")
-  on.exit(unlink(tmp_rds))
+  withr::defer(unlink(tmp_rds))
 
   expect_warning(
     expect_known_value("a", tmp_rds),
@@ -111,7 +111,7 @@ test_that("serializes to version 2 by default", {
 
 test_that("version 3 is possible", {
   tmp_rds <- tempfile(fileext = ".rds")
-  on.exit(unlink(tmp_rds))
+  withr::defer(unlink(tmp_rds))
 
   expect_warning(
     expect_known_value("a", tmp_rds, version = 3),