R/env.R

In r-lib/rcmdcheck: Run 'R CMD check' from 'R' and Capture Results

set_env <- function(path, targz, desc, envir = parent.frame()) {
  pkg <- desc$get("Package")
  ign <- as_flag(desc$get("Config/rcmdcheck/ignore-inconsequential-notes"))
  if (ign) ignore_env(envir = envir)
  load_env(path, targz, pkg, envir = envir)
}

ignore_env_config <- function() {
  data_literal(
    "docs" | "envvar" | "value",
    # ---------------------------------------------------------------------
    "report large package sizes" | "_R_CHECK_PKG_SIZES_" | FALSE,
    "check cross-references in Rd files" | "_R_CHECK_RD_XREFS_" | FALSE,
    "NOTE if package requires GNU make" |
      "_R_CHECK_CRAN_INCOMING_NOTE_GNU_MAKE_" |
      FALSE,
    "report marked non-ASCII strings in datasets" |
      "_R_CHECK_PACKAGE_DATASETS_SUPPRESS_NOTES_" |
      TRUE
  )
}

format_env_docs <- function() {
  envs <- ignore_env_config()
  paste0(
    "* ",
    envs$docs,
    " (`",
    envs$envvar,
    " = ",
    envs$value,
    "`)",
    collapse = ",\n"
  )
}

ignore_env <- function(to_ignore = NULL, envir = parent.frame()) {
  if (is.null(to_ignore)) {
    conf <- ignore_env_config()
    to_ignore <- structure(conf$value, names = conf$envvar)
  }
  withr::local_envvar(to_ignore, .local_envir = envir)
}

load_env <- function(path, targz, package, envir = parent.frame()) {
  should_load <- as_flag(Sys.getenv("RCMDCHECK_LOAD_CHECK_ENV"), TRUE)
  if (!should_load) return()

  env <- NULL
  if (file.info(path)$isdir) {
    env_path <- file.path(path, "tools", "check.env")
  } else {
    dir.create(tmp <- tempfile())
    on.exit(unlink(tmp, recursive = TRUE), add = TRUE)
    utils::untar(
      targz,
      file.path(package, "tools", "check.env"),
      exdir = tmp,
      tar = "internal"
    )
    env_path <- file.path(tmp, package, "tools", "check.env")
  }

  if (file.exists(env_path)) {
    load_env_file(env_path, envir = envir)
  }
}

load_env_file <- function(path, envir = parent.frame()) {
  env <- readLines(path, warn = FALSE)
  env <- ignore_comments(env)
  env <- ignore_empty_lines(env)
  if (length(env) == 0) return(invisible())

  env <- lapply(env, parse_dot_line)
  envc <- structure(
    vapply(env, "[[", character(1), "value"),
    names = vapply(env, "[[", character(1), "key")
  )
  withr::local_envvar(envc, .local_envir = envir)
}

ignore_comments <- function(lines) {
  grep("^#", lines, invert = TRUE, value = TRUE)
}

ignore_empty_lines <- function(lines) {
  grep("^\\s*$", lines, invert = TRUE, value = TRUE)
}

line_regex <- paste0(
  "^\\s*", # leading whitespace
  "(?<export>export\\s+)?", # export, if given
  "(?<key>[^=]+)", # variable name
  "=", # equals sign
  "(?<q>['\"]?)", # quote if present
  "(?<value>.*)", # value
  "\\g{q}", # the same quote again
  "\\s*", # trailing whitespace
  "$" # end of line
)

parse_dot_line <- function(line) {
  match <- regexpr(line_regex, line, perl = TRUE)
  if (match == -1) {
    stop("Cannot parse check.env: ", substr(line, 1, 40), call. = FALSE)
  }
  as.list(extract_match(line, match)[c("key", "value")])
}

extract_match <- function(line, match) {
  tmp <- mapply(
    attr(match, "capture.start"),
    attr(match, "capture.length"),
    FUN = function(start, length) {
      tmp <- substr(line, start, start + length - 1)
    }
  )
  names(tmp) <- attr(match, "capture.names")
  tmp
}