R/check_clean_userspace.R

In ThinkR-open/checkhelper: Deal with Check Outputs

# WARNING - Generated by {fusen} from dev/flat_check_clean_userspace.Rmd: do not edit by hand

#' check_clean_userspace
#'
#' @description
#' `r lifecycle::badge("experimental")`
#'
#' @param pkg Path to package to check
#' @param check_output Path to directory where to store check results
#'
#' @return data.frame of files that are left after checks
#' @export
#'
#' @examples
#' \dontrun{
#' # This runs a check of the current package
#' all_files <- check_clean_userspace()
#' all_files
#' }
check_clean_userspace <- function(pkg = ".", check_output = tempfile("dircheck")) {
  scratch_dir <- tempdir() # character(0)

  tmp_orig <- Sys.getenv("TMPDIR")
  Sys.setenv("TMPDIR" = scratch_dir)
  Sys.setenv("TMP" = scratch_dir)
  Sys.setenv("TEMP" = scratch_dir)

  on.exit(Sys.setenv("TMPDIR" = tmp_orig))

  if (!dir.exists(scratch_dir)) {
    dir.create(scratch_dir)
  }
  if (!dir.exists(check_output)) {
    dir.create(check_output)
  }

  all_files <- tibble(
    source = character(0),
    problem = character(0),
    where = character(0),
    file = character(0)
  )

  # browseURL(pkg)

  # Local snapshot
  local_tmpfile <- tempfile("local_shot")
  scratch_tmpfile <- tempfile("scratch_shot")
  local_shot <- utils::fileSnapshot(pkg, timestamp = local_tmpfile, md5sum = TRUE, recursive = TRUE, full.names = TRUE)
  scratch_shot <- utils::fileSnapshot(scratch_dir, timestamp = scratch_tmpfile, md5sum = TRUE, recursive = TRUE, full.names = TRUE)
  # home <- utils::fileSnapshot ("~", timestamp = tempfile("timestamp"), md5sum = TRUE)

  # Verify test do not leave files ----
  is.test <- list.files(file.path(pkg, "tests"))
  if (length(is.test) != 0) {
    cli::cli_rule("Unit tests")
    devtools::test(pkg = pkg, stop_on_failure = FALSE)
    all_files <- what_changed(local_shot, scratch_shot, source = "Unit tests", all_files, check_output = check_output)
  }

  # Update shots
  local_shot <- utils::fileSnapshot(pkg, timestamp = local_tmpfile, md5sum = TRUE, recursive = TRUE, full.names = TRUE)
  scratch_shot <- utils::fileSnapshot(scratch_dir, timestamp = scratch_tmpfile, md5sum = TRUE, recursive = TRUE, full.names = TRUE)

  # Verify examples do not leave files ----
  cli::cli_rule("Run examples")
  devtools::run_examples(pkg = pkg, run_donttest = FALSE, run_dontrun = FALSE, fresh = FALSE, document = FALSE)
  all_files <- what_changed(local_shot, scratch_shot, source = "Run examples", all_files, check_output)
  if (any(all_files$source == "Run examples")) {
    warning("One of the 'Run examples' .R file was created to run examples. You should not bother about it")
  }

  # Update shots
  local_shot <- utils::fileSnapshot(pkg, timestamp = local_tmpfile, md5sum = TRUE, recursive = TRUE, full.names = TRUE)
  scratch_shot <- utils::fileSnapshot(scratch_dir, timestamp = scratch_tmpfile, md5sum = TRUE, recursive = TRUE, full.names = TRUE)

  # Verify Full check ----
  cli::cli_rule("Full check")
  rcmdcheck::rcmdcheck(path = pkg, check_dir = check_output, args = c("--no-manual", "--as-cran"), quiet = TRUE)
  # browseURL(dircheck)
  all_files <- what_changed(local_shot, scratch_shot, source = "Full check", all_files, check_output)

  # Verify Full check - check dir ----
  pkgname <- read.dcf(file.path(pkg, "DESCRIPTION"))[, "Package"]

  the_dir <- list.files(file.path(check_output), pattern = paste0(pkgname, ".Rcheck"), full.names = TRUE)
  # Same tests, no new files in test during check
  still_files <- list.files(file.path(the_dir, "00_pkg_src", pkgname, "tests", "testthat"), full.names = TRUE)[
    !list.files(file.path(the_dir, "00_pkg_src", pkgname, "tests", "testthat")) %in%
      list.files(file.path(pkg, "tests", "testthat"))
  ]

  if (length(still_files) != 0) {
    all_files <- all_files %>%
      rbind(
        tibble(
          source = "Tests in check dir",
          problem = "added",
          where = the_dir,
          file = still_files
        )
      )

    message("Some files were still in tests/testtthat dir after rcmdcheck: ", paste(still_files, collapse = ", "))
  }

  # Update shots
  local_shot <- utils::fileSnapshot(pkg, timestamp = local_tmpfile, md5sum = TRUE, recursive = TRUE, full.names = TRUE)
  scratch_shot <- utils::fileSnapshot(scratch_dir, timestamp = scratch_tmpfile, md5sum = TRUE, recursive = TRUE, full.names = TRUE)

  # After vignettes
  cli::cli_rule("Build Vignettes")
  the_v <- devtools::build_vignettes(pkg = pkg)
  if (!all(is.null(the_v))) {
    devtools::clean_vignettes(pkg = pkg)
    all_files <- what_changed(local_shot, scratch_shot, source = "Build Vignettes", all_files, check_output)
  }

  return(all_files)
}


#' @noRd
what_changed <- function(local_shot, scratch_shot, source, all_files, check_output) {
  # Ignore files issued from checks themselves
  file.no.problem <- paste0(
    normalizePath(check_output, winslash = "/"),
    "|[.]Rcheck/|",
    normalizePath(file.path(tempdir(), "callr-"), winslash = "/", mustWork = FALSE),
    "|",
    normalizePath(file.path(tempdir(), "test.*[.](o|c|so)$"), winslash = "/", mustWork = FALSE),
    "|",
    normalizePath(file.path(tempdir(), "foo[.]o$"), winslash = "/", mustWork = FALSE)
  )

  for (w.shot in c("local_shot", "scratch_shot")) {
    the_shot <- get(w.shot)
    # File changed
    all_local <- utils::changedFiles(the_shot, md5sum = TRUE, recursive = TRUE, full.names = TRUE)

    for (what in c("added", "deleted", "changed")) {
      if (length(all_local[[what]]) != 0) {
        # Not those in checkdir
        # grepl(normalizePath(file.path(tempdir(), "callr-"), winslash = "/"),
        #       normalizePath(all_local[[what]], winslash = "/"))
        all_local[[what]] <- normalizePath(all_local[[what]], winslash = "/")
        all_local[[what]] <- all_local[[what]][!grepl(file.no.problem, all_local[[what]])]
        if (length(all_local[[what]]) != 0) {
          all_files <- all_files %>%
            rbind(
              tibble(
                source = source,
                problem = what,
                where = the_shot$path,
                file = all_local[[what]]
              )
            )
          message(
            "Some files were ", what, " in ", the_shot$path, " after ", source, ": ",
            paste(all_local[[what]], collapse = ", ")
          )
        }
      }
    }
  }

  all_files
}