Merge pull request #1119 from r-lib/fix-cran

Delete cache directories if empty

Author: lorenzwalthert

.github/workflows/check-full.yaml

@@ -56,6 +56,6 @@ jobs:
       - uses: r-lib/actions/check-r-package@v2
         with:
           upload-snapshots: true
-          error-on: '"note"'
+          error-on: 'ifelse(getRversion() > 3.6, "warning", "note")'
         env:
           _R_CHECK_FORCE_SUGGESTS_: false

R/zzz.R

@@ -23,6 +23,37 @@
   invisible()
 }
 
+#' Delete a cache or temp directory
+#'
+#' For safety, `path` is only deleted if it is a sub-directory of a temporary
+#' directory or user cache. Since this function relies on `tools::R_user_dir()`,
+#' it early returns `FALSE` on `R < 4.0.0`.
+#' @param path Absolute path to a directory to delete.
+#' @returns `TRUE` if anything was deleted, `FALSE` otherwise.
+#' @keywords internal
+delete_if_cache_directory <- function(path) {
+  path <- normalizePath(path)
+  if (getRversion() < package_version("4.0.0")) {
+    return(FALSE)
+  }
+  designated_cache_path <- normalizePath(tools::R_user_dir("R.cache", which = "cache"))
+  is_in_tools_cache <- startsWith(path, designated_cache_path)
+  temp_dir <- normalizePath(Sys.getenv("TMPDIR", Sys.getenv("TMP")))
+  is_in_generic_cache <- startsWith(path, temp_dir)
+  if (is_in_tools_cache || is_in_generic_cache) {
+    all_files <- list.files(path,
+      full.names = TRUE,
+      recursive = TRUE,
+      all.files = FALSE
+    )
+    if (length(all_files) < 1L) {
+      unlink(path, recursive = TRUE)
+      return(TRUE)
+    }
+  }
+  FALSE
+}
+
 
 ask_to_switch_to_non_default_cache_root <- function(ask = interactive()) {
   if (ask && stats::runif(1L) > 0.9 && is.null(getOption("styler.cache_root"))) {
@@ -40,14 +71,24 @@ ask_to_switch_to_non_default_cache_root_impl <- function() {
 }
 
 remove_old_cache_files <- function() {
+  path_version_specific <- R.cache::getCachePath(c("styler", styler_version))
   all_cached <- list.files(
-    R.cache::getCachePath(c("styler", styler_version)),
+    path_version_specific,
     full.names = TRUE, recursive = TRUE
   )
   date_boundary <- Sys.time() - 60L * 60L * 24L * 6L
   file.remove(
     all_cached[file.info(all_cached)$mtime < date_boundary]
   )
+  path_styler_specific <- dirname(path_version_specific)
+  path_r_cache_specific <- dirname(path_styler_specific)
+  paths <- normalizePath(
+    c(path_version_specific, path_styler_specific, path_r_cache_specific)
+  )
+  purrr::walk(
+    paths,
+    delete_if_cache_directory
+  )
 }
 
 

man/delete_if_cache_directory.Rd

@@ -14,3 +14,18 @@ test_that("clear Cache", {
     length(list.dirs(R.cache::getCachePath("styler"))) == 1L
   )
 })
+
+
+test_that("can delete empty cache directory", {
+  skip_if(getRversion() < package_version("4.0.0"))
+  skip_on_cran()
+  tmpdir <- withr::local_tempdir()
+  withr::local_dir(tmpdir)
+  dir.create("xxx")
+  expect_true(delete_if_cache_directory(file.path(getwd(), "xxx")))
+  dir.create("xxx")
+  file.create("xxx/yyy")
+  list.files("xxx")
+  expect_false(delete_if_cache_directory(file.path(getwd(), "xxx")))
+  expect_true(file.exists(tmpdir))
+})