Support loading check.env

R/background.R

@@ -132,6 +132,8 @@ rcc_init <- function(self, private, super, path, args, build_args,
   private$check_dir <- check_dir
   private$targz <- targz
 
+  set_env(path, targz, private$description)
+
   private$session_output <- tempfile()
   profile <- make_fake_profile(session_output = private$session_output)
   private$tempfiles  <- c(private$session_output, profile)

R/env.R

@@ -0,0 +1,115 @@
+
+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
+}

R/options.R

@@ -26,6 +26,9 @@
 #' * `RCMDCHECK_DETAILS_URL`: URL to the root of the CRAN check output
 #'   page. Defaults to `https://www.r-project.org/nosvn/R.check/`.
 #'
+#' * `RCMDCHECK_ERROR_ON`: the default value for the `error_on` argument
+#'   of [rcmdcheck()].
+#'
 #' * `RCMDCHECK_FLAVOURS_URL` URL to the CRAN check flavours page.
 #'   You can use this to select an alternative CRAN mirror. Defaults to
 #'   `https://cran.r-project.org/web/checks/check_flavors.html`.
@@ -50,6 +53,10 @@
 #'   already available. RStudio's pandoc is detected via an `RSTUDIO_PANDOC`
 #'   environment variable.
 #'
+#' * `RCMDCHECK_LOAD_CHECK_ENV`: you can use this environment variable
+#'   suppress loading environment variables from the `tools/check.env` file.
+#'   See [rcmdcheck()] for details.
+#'
 #' * `RSTUDIO_PANDOC`: if set, rcmdcheck adds this environment variable
 #'   to the PATH if pandoc is not on the PATH already. It is usually set
 #'   in RStudio. See also the `RCMDCHECK_USE_RSTUDIO_PANDOC` environment

R/package.R

@@ -10,6 +10,58 @@ NULL
 
 #' Run `R CMD check` on a package or a directory
 #'
+#' Runs `R CMD check` as an external command, and parses its output and
+#' returns the check failures.
+#'
+#' See [rcmdcheck_process] if you need to run `R CMD check` in a background
+#' process.
+#'
+#' # Turning off package checks
+#'
+#' Sometimes it is useful to programmatically turn off some checks that
+#' may report check NOTEs.
+#' rcmdcehck provides two ways to do this.
+#'
+#' First, you may declare in `DESCRIPTION` that you don't want to see
+#' NOTEs that are accepted on CRAN, with this entry:
+#'
+#' ```
+#' Config/rcmdcheck/ignore-inconsequential-notes: true
+#' ```
+#'
+#' Currently, this will make rcmdcheck ignore the following notes:
+#' `r format_env_docs()`.
+#'
+#' The second way is more flexible, and lets you turn off individual checks
+#' via setting environment variables.
+#' You may provide a `tools/check.env` _environment file_ in your package
+#' with the list of environment variable settings that rcmdcheck will
+#' automatically use when checking the package.
+#' See [Startup] for the format of this file.
+#'
+#' Here is an example `tools/check.env` file:
+#' ```
+#' # Report if package size is larger than 10 megabytes
+#' _R_CHECK_PKG_SIZES_THRESHOLD_=10
+#'
+#' # Do not check Rd cross references
+#' _R_CHECK_RD_XREFS_=false
+#'
+#' # Do not report if package requires GNU make
+#' _R_CHECK_CRAN_INCOMING_NOTE_GNU_MAKE_=false
+#'
+#' # Do not check non-ASCII strings in datasets
+#' _R_CHECK_PACKAGE_DATASETS_SUPPRESS_NOTES_=true
+#' ```
+#'
+#' See the ["R internals" manual](https://cran.r-project.org/doc/manuals/r-devel/R-ints.html)
+#' and the [R source code](https://github.com/wch/r-source) for the
+#' environment variables that control the checks.
+#'
+#' Note that `Config/rcmdcheck/ignore-inconsequential-notes` and the
+#' `check.env` file are only supported by rcmdcheck, and running
+#' `R CMD check` from a shell (or GUI) will not use them.
+#'
 #' @param path Path to a package tarball or a directory.
 #' @param quiet Whether to print check output during checking.
 #' @param args Character vector of arguments to pass to `R CMD check`. Pass each
@@ -43,7 +95,8 @@ NULL
 #'   no errors are thrown. If `"error"`, then only `ERROR` failures
 #'   generate errors. If `"warning"`, then `WARNING` failures generate
 #'   errors as well. If `"note"`, then any check failure generated an
-#'   error.
+#'   error. Its default can be modified with the `RCMDCHECK_ERROR_ON`
+#'   environment variable. If that is not set, then `"never"` is used.
 #' @return An S3 object (list) with fields `errors`,
 #'   `warnings` and `notes`. These are all character
 #'   vectors containing the output for the failed check.
@@ -54,13 +107,21 @@ NULL
 #' @importFrom callr rcmd_safe
 #' @importFrom desc desc
 
-rcmdcheck <- function(path = ".", quiet = FALSE, args = character(),
-                      build_args = character(), check_dir = NULL,
-                      libpath = .libPaths(), repos = getOption("repos"),
-                      timeout = Inf, error_on =
-                        c("never", "error", "warning", "note")) {
-
-  error_on <- match.arg(error_on)
+rcmdcheck <- function(
+    path = ".",
+    quiet = FALSE,
+    args = character(),
+    build_args = character(),
+    check_dir = NULL,
+    libpath = .libPaths(),
+    repos = getOption("repos"),
+    timeout = Inf,
+    error_on = Sys.getenv(
+      "RCMDCHECK_ERROR_ON",
+      c("never", "error", "warning", "note")[1]
+    )) {
+
+  error_on <- match.arg(error_on, c("never", "error", "warning", "note"))
 
   if (file.info(path)$isdir) {
     path <- find_package_root_file(path = path)
@@ -85,6 +146,7 @@ rcmdcheck <- function(path = ".", quiet = FALSE, args = character(),
 
   start_time <- Sys.time()
   desc <- desc(targz)
+  set_env(path, targz, desc)
 
   out <- with_dir(
     dirname(targz),

R/parse.R

@@ -77,11 +77,11 @@ parse_checkdir <- function(entries) {
     perl = TRUE
   )
 }
-get_test_fail <- function(path) {
-  get_test_output(path, pattern = "\\.Rout\\.fail")
+get_test_fail <- function(path, encoding = "") {
+  get_test_output(path, pattern = "\\.Rout\\.fail", encoding = encoding)
 }
 
-get_test_output <- function(path, pattern) {
+get_test_output <- function(path, pattern, encoding = "") {
   test_path <- file.path(path, dir(path, pattern = "^tests"))
   paths <- dir(test_path, paste0(pattern, "$"), full.names = TRUE)
 
@@ -97,7 +97,7 @@ get_test_output <- function(path, pattern) {
     substr(x, first_gt, nchar(x))
   }
 
-  tests <- lapply(paths, read_char)
+  tests <- lapply(paths, read_char, encoding = encoding)
   tests <- lapply(tests, win2unix)
   lapply(tests, trim_header)
 }

R/utils.R

@@ -1,6 +1,7 @@
 
-read_char <- function(path, ...) {
-  readChar(path, nchars = file.info(path)$size, ...)
+read_char <- function(path, encoding = "", ...) {
+  txt <- readChar(path, nchars = file.info(path)$size, useBytes = TRUE, ...)
+  iconv(txt, encoding, "UTF-8", sub = "byte")
 }
 
 win2unix <- function(str) {
@@ -98,10 +99,10 @@ cat0 <- function(..., sep = "") {
   cat(..., sep = "")
 }
 
-get_install_out <- function(path) {
+get_install_out <- function(path, encoding = "") {
   install_out <- file.path(path, "00install.out")
   if (is_string(install_out) && file.exists(install_out)) {
-    win2unix(read_char(install_out))
+    win2unix(read_char(install_out, encoding = encoding))
   } else {
     "<00install.out file does not exist>"
   }
@@ -169,6 +170,7 @@ NO_WORDS  <- c("false", "no",  "off", "0", "nope", "nah")
 as_flag <- function(x, default = FALSE, name = "") {
   x1 <- trimws(tolower(x))
   if (is.na(x1)) return(default)
+  if (x1 == "") return(default)
   if (x1 %in% YES_WORDS) return(TRUE)
   if (x1 %in% NO_WORDS) return(FALSE)
   warning(
@@ -198,3 +200,15 @@ should_use_rs_pandoc <- function() {
     !nzchar(Sys.which("pandoc")) && nzchar(Sys.getenv("RSTUDIO_PANDOC"))
   }
 }
+
+data_literal <- function(...) {
+  cl <- match.call(expand.dots = FALSE)
+  rows <- vapply(cl$..., function(x) paste(deparse(x), collapse = " "), "")
+  utils::read.table(
+    textConnection(rows),
+    strip.white = TRUE,
+    sep = "|",
+    header = TRUE,
+    colClasses = "character"
+  )
+}