Move withr from imports to suggests

DESCRIPTION

@@ -29,8 +29,7 @@ Imports:
     processx,
     rlang (>= 1.1.1),
     rprojroot,
-    utils,
-    withr (>= 2.4.3)
+    utils
 Suggests: 
     bitops,
     jsonlite,
@@ -40,7 +39,8 @@ Suggests:
     remotes,
     rstudioapi,
     testthat (>= 3.2.1.1),
-    usethis
+    usethis,
+    withr
 Config/Needs/website: tidyverse/tidytemplate, ggplot2
 Config/testthat/edition: 3
 Config/testthat/parallel: TRUE

R/compilation-db.R

@@ -75,19 +75,17 @@
 
   # The `OBJECTS` variable should not depend on R variables, so we can inspect
   # it in isolation
-  withr::with_dir(
-    src_path,
-    pkgbuild::with_build_tools(
-      out <- processx::run(
-        "make",
-        c(
-          "-f",
-          makevars,
-          "-f",
-          system.file("print-var.mk", package = "pkgload"),
-          "print-OBJECTS"
-        ),
-      )
+  local_dir(src_path)
+  pkgbuild::with_build_tools(
+    out <- processx::run(
+      "make",
+      c(
+        "-f",
+        makevars,
+        "-f",
+        system.file("print-var.mk", package = "pkgload"),
+        "print-OBJECTS"
+      ),
     )
   )
 

R/dev-help.R

@@ -163,7 +163,8 @@ topic_write_html <- function(x, path) {
 }
 
 topic_lines <- function(x, type = c("text", "html")) {
-  file <- withr::local_tempfile()
+  file <- tempfile()
+  defer(unlink(file))
 
   switch(
     arg_match(type),

R/enc.R

@@ -1,6 +1,6 @@
 read_lines_enc <- function(path, file_encoding = "UTF-8", n = -1L, ok = TRUE, skipNul = FALSE) {
   con <- file(path, encoding = file_encoding)
-  on.exit(close(con), add = TRUE)
+  defer(close(con))
 
   lines <- readLines(con, warn = FALSE, n = n, ok = ok, skipNul = skipNul)
   Encoding(lines) <- "UTF-8"

R/load-code.R

@@ -30,9 +30,12 @@ load_code <- function(path = ".", quiet = NULL) {
     clear_cache()
     unload(package)
   }
-  on.exit(cleanup())
+  defer(cleanup())
 
-  withr_with_dir(path, source_many(paths, encoding, env))
+  local({
+    local_dir(path)
+    source_many(paths, encoding, env)
+  })
   success <- TRUE
 
   invisible(r_files)
@@ -42,10 +45,10 @@ load_code <- function(path = ".", quiet = NULL) {
 find_code <- function(path = ".", quiet = FALSE) {
   path_r <- package_file("R", path = path)
 
-  r_files <- withr_with_collate(
-    "C",
+  r_files <- local({
+    local_collate("C")
     tools::list_files_with_type(path_r, "code", full.names = TRUE)
-  )
+  })
 
   collate <- pkg_desc(path)$get_collate()
 

R/load.R

@@ -132,7 +132,7 @@
   package <- pkg_name(path)
   description <- pkg_desc(path)
 
-  withr::local_envvar(c(DEVTOOLS_LOAD = package))
+  local_envvar(DEVTOOLS_LOAD = package)
 
   quiet <- load_all_quiet(quiet, "load_all")
 
@@ -146,7 +146,7 @@
     # JIT compilation and it would be locked before we can insert shims into
     # it).
     oldEnabled <- compiler::enableJIT(0)
-    on.exit(compiler::enableJIT(oldEnabled), TRUE)
+    defer(compiler::enableJIT(oldEnabled))
   }
 
   if (missing(compile) && !missing(recompile)) {

R/package-env.R

@@ -47,10 +47,8 @@ populate_pkg_env <- function(pkg,
 
   # Source test helpers into pkg environment
   if (helpers && uses_testthat(path)) {
-    withr_with_envvar(
-      c(NOT_CRAN = "true"),
-      testthat_source_test_helpers(find_test_dir(path), env = pkg_env)
-    )
+    local_envvar(NOT_CRAN = "true")
+    testthat_source_test_helpers(find_test_dir(path), env = pkg_env)
   }
 }
 

R/source.R

@@ -2,11 +2,12 @@ source_many <- function(files, encoding = "UTF-8", envir = parent.frame()) {
   stopifnot(is.character(files))
   stopifnot(is.environment(envir))
 
-  oop <- options(
+
+  local_options(
     keep.source = TRUE,
     show.error.locations = TRUE,
-    topLevelEnvironment = as.environment(envir))
-  on.exit(options(oop))
+    topLevelEnvironment = as.environment(envir)
+  )
 
   for (file in files) {
     try_fetch(

R/utils.R

@@ -136,7 +136,8 @@ strip_internal_calls <- function(x, package) {
 }
 
 sort_ci <- function(x) {
-  withr_with_collate("C", x[order(tolower(x), x)])
+  local_collate("C")
+  x[order(tolower(x), x)]
 }
 
 dev_packages <- function() {

R/withr-shims.R

@@ -0,0 +1,48 @@
+defer <- function (expr, env = caller_env(), after = FALSE) {
+  thunk <- as.call(list(function() expr))
+  do.call(on.exit, list(thunk, TRUE, after), envir = env)
+}
+
+local_envvar <- function(..., .frame = parent.frame()) {
+  old <- set_envvar(list(...))
+  defer(set_envvar(old), .frame)
+
+  invisible()
+}
+
+local_collate <- function(locale, frame = parent.frame()) {
+  old <- Sys.getlocale("LC_COLLATE")
+  defer(Sys.setlocale("LC_COLLATE", old), frame)
+  Sys.setlocale("LC_COLLATE", locale)
+
+  # From https://github.com/r-lib/withr/blob/v3.0.0/R/locale.R#L51-L55:
+  # R supports setting LC_COLLATE to C via envvar. When that is the
+  # case, it takes precedence over the currently set locale. We need
+  # to set both the envvar and the locale for collate to fully take
+  # effect.
+  local_envvar(LC_COLLATE = locale, .frame = frame)
+
+  invisible()
+}
+
+local_dir <- function(path, frame = parent.frame()) {
+  old <- setwd(path)
+  defer(setwd(old), frame)
+
+  invisible()
+}
+
+# adapted from withr:::set_envvar
+set_envvar <- function(envs) {
+  if (length(envs) == 0) {
+    return()
+  }
+
+  old <- Sys.getenv(names(envs), names = TRUE, unset = NA)
+  set <- !is.na(envs)
+
+  if (any(set)) do.call("Sys.setenv", as.list(envs[set]))
+  if (any(!set)) Sys.unsetenv(names(envs)[!set])
+
+  invisible(old)
+}

R/zzz.R

@@ -21,17 +21,13 @@
 }
 
 # These functions are used in load_all() so need to exist in the
-# devtools namespace so the withr namespace is not prematurely loaded
+# devtools namespace so the desc namespace is not prematurely loaded
 # by `::` during a load_all() call.
 #
 # They are lazily assigned to avoid racing issues while installing in
 # parallel (see #89), and forced via `force_load_all_deps()` before
 # unregistering namespaces.
 on_load({
-  withr_with_dir %<~% withr::with_dir
-  withr_with_collate %<~% withr::with_collate
-  withr_with_envvar %<~% withr::with_envvar
-
   desc_desc %<~% desc::desc
   desc_desc_get_field %<~% desc::desc_get_field
   desc_desc_get_version %<~% desc::desc_get_version
@@ -47,9 +43,6 @@ on_load({
 
 force_load_all_deps <- function() {
   list(
-    withr_with_dir,
-    withr_with_collate,
-    withr_with_envvar,
     desc_desc,
     desc_desc_get_field,
     desc_desc_get_version,

tests/testthat/test-dll.R

@@ -9,7 +9,7 @@ test_that("unload() unloads DLLs from packages loaded with library()", {
   .libPaths(c(tmp_libpath, .libPaths()))
 
   # Reset the libpath on exit
-  on.exit(.libPaths(old_libpaths), add = TRUE)
+  defer(.libPaths(old_libpaths))
 
   # Install package
   install.packages(test_path("testDllLoad"), repos = NULL, type = "source",

tests/testthat/test-examples.R

@@ -17,15 +17,15 @@ test_that("run dontrun when requested", {
 
 test_that("can run example package", {
   load_all(test_path("testHelp"))
-  on.exit(unload(test_path("testHelp")))
+  defer(unload(test_path("testHelp")))
 
   env <- dev_example("foofoo", quiet = TRUE)
   expect_equal(env$a, 101)
 })
 
 test_that("can use system macros", {
   load_all(test_path("testHelp"))
-  on.exit(unload(test_path("testHelp")))
+  defer(unload(test_path("testHelp")))
 
   expect_silent(
     run_example(

tests/testthat/test-help.R

@@ -62,7 +62,7 @@ test_that("shim_question behaves the same as utils::? for nonexistent objects",
 
 test_that("show_help and shim_question files for devtools-loaded packages", {
   load_all(test_path('testHelp'))
-  on.exit(unload(test_path('testHelp')))
+  defer(unload(test_path('testHelp')))
 
   h1 <- shim_help("foofoo")
   expect_s3_class(h1, "dev_topic")
@@ -77,16 +77,13 @@ test_that("show_help and shim_question files for devtools-loaded packages", {
     expect_equal(title, "testHelp:foofoo.Rd")
   }
 
-  withr::with_options(
-    c(pager = pager_fun),
-    suppressMessages(
-      print(h1, type = 'text')
-    ))
+  local_options(pager = pager_fun)
+  suppressMessages(print(h1, type = 'text'))
 })
 
 test_that("shim_help and shim_questions works if topic moves", {
   load_all(test_path('testHelp'))
-  on.exit(unload(test_path('testHelp')))
+  defer(unload(test_path('testHelp')))
 
   path_man <- test_path("testHelp/man/")
   base_rd_path <- function(x) basename(x$path)
@@ -95,18 +92,15 @@ test_that("shim_help and shim_questions works if topic moves", {
   expect_equal(base_rd_path(shim_question("foofoo")), "foofoo.Rd")
 
   fs::file_move(fs::path(path_man, "foofoo.Rd"), fs::path(path_man, "barbar.Rd"))
-  on.exit(
-    fs::file_move(fs::path(path_man, "barbar.Rd"), fs::path(path_man, "foofoo.Rd")),
-    add = TRUE
-  )
+  defer(fs::file_move(fs::path(path_man, "barbar.Rd"), fs::path(path_man, "foofoo.Rd")))
 
   expect_equal(base_rd_path(shim_help("foofoo")), "barbar.Rd")
   expect_equal(base_rd_path(shim_question("foofoo")), "barbar.Rd")
 })
 
 test_that("dev_help works with package and function help with the same name", {
   load_all(test_path('testHelp'))
-  on.exit(unload(test_path('testHelp')))
+  defer(unload(test_path('testHelp')))
 
   h1 <- dev_help("testHelp")
   expect_identical(shim_question(testHelp::testHelp), h1)

tests/testthat/test-load.R

@@ -62,7 +62,7 @@ test_that("unloading or reloading forces bindings", {
   withCallingHandlers(
     forced = function(...) forced <<- TRUE, {
       # Allow running test interactively
-      on.exit(unload("testLoadLazy"))
+      defer(unload("testLoadLazy"))
 
       # On older R versions, `env_coalesce()` forces bindings
       attach <- getRversion() >= "4.0.0"
@@ -77,7 +77,7 @@ test_that("unloading or reloading forces bindings", {
 })
 
 test_that("unloading or reloading does not call active bindings", {
-  on.exit(unload("testActiveBindings"))
+  defer(unload("testActiveBindings"))
 
   expect_no_error(load_all(test_path("testActiveBindings")))
 })

tests/testthat/test-namespace-env.R

@@ -1,6 +1,6 @@
 test_that("respects version separator", {
   ns <- create_ns_env(test_path("testVersionSep"))
-  withr::defer(unregister_namespace("testVersionSep"))
+  defer(unregister_namespace("testVersionSep"))
 
   expect_equal(getNamespaceInfo(ns, "spec")[["version"]], "0.0.0-9000")
 })

tests/testthat/test-po.R

@@ -4,7 +4,7 @@ test_that("translation domain correctly loaded", {
   skip_if_c_locale()
 
   load_all(test_path("testTranslations"))
-  withr::defer(unload("testTranslations"))
+  defer(unload("testTranslations"))
 
   expect_equal(withr::with_language("fr", hello()), "Bonjour")
 
@@ -20,7 +20,7 @@ test_that("modified translations are correctly reloaded", {
 
   # Load package and generate translation
   load_all(pkg)
-  withr::defer(unload("testTranslations"))
+  defer(unload("testTranslations"))
   withr::with_language("fr", hello())
 
   # Modify .po file

tests/testthat/test-shim.R

@@ -151,7 +151,7 @@ test_that("shim_library.dynam loads compiled dll/so from inst/src/", {
 
   old_libpaths <- .libPaths()
   .libPaths(c(tmp_libpath, .libPaths()))
-  on.exit(.libPaths(old_libpaths), add = TRUE)
+  defer(.libPaths(old_libpaths))
 
   # Create temp directory for assembling testLibDynam with dll or so in inst/libs/
   temp_dir <-tempdir()