Add pkgchk_uses_dontrun() as a watch check

DESCRIPTION

@@ -7,12 +7,14 @@ Authors@R: c(
     person("Maëlle", "Salmon", role = "aut"),
     person("Jacob", "Wujciak-Jens", , "[email protected]", role = "aut",
            comment = c(ORCID = "0000-0002-7281-3989")),
-    person(c("Kelli", "F."), "Johnson", , "[email protected]",
-           role = "ctb", comment = c(ORCID = "0000-0002-5149-451X")),
+    person(c("Kelli", "F."), "Johnson", , "[email protected]", role = "ctb",
+           comment = c(ORCID = "0000-0002-5149-451X")),
     person("Eunseop", "Kim", , "[email protected]", role = "aut",
            comment = c(ORCID = "0009-0000-2138-788X")),
-    person("Katrina", "Brock", , "[email protected]",
-           role = "ctb", comment = c(ORCID = "0009-0003-4678-9545"))
+    person("Katrina", "Brock", , "[email protected]", role = "ctb",
+           comment = c(ORCID = "0009-0003-4678-9545")),
+    person("Andy", "Teucher", , "[email protected]", role = "aut",
+           comment = c(ORCID = "0000-0002-7840-692X"))
   )
 Description: Check whether a package is ready for submission to rOpenSci's
     peer review system.

R/check-fns-have-exs.R

@@ -9,9 +9,37 @@ pkgchk_fns_have_exs <- function (checks) {
 
     rd <- list_rd_files (checks$pkg$path) # utils.R
 
-    # don't check for examples in datasets (#103), identified by keyword
+    fns_have_exs(rd)
+}
+
+output_pkgchk_fns_have_exs <- function (checks) {
+
+    no_ex <- which (!checks$checks$fns_have_exs)
+    no_ex_fns <- names (checks$checks$fns_have_exs) [no_ex]
+
+    out <- list (
+        check_pass = length (no_ex) == 0L,
+        summary = "",
+        print = ""
+    ) # no print method
+
+    out$summary <- ifelse (out$check_pass,
+        "All functions have examples.",
+        paste0 (
+            "These functions do not have ",
+            "examples: [",
+            paste0 (no_ex_fns, collapse = ", "),
+            "]."
+        )
+    )
+
+    return (out)
+}
+
+fns_have_exs <- function(rd_files) {
+  # don't check for examples in datasets (#103), identified by keyword
     what <- c ("name", "docType", "keyword", "examples")
-    rd_dat <- vapply (rd, function (i) {
+    rd_dat <- vapply (rd_files, function (i) {
         rd_i <- tools::parse_Rd (i, permissive = TRUE)
         dat <- lapply (what, function (j) {
             get_Rd_meta (rd_i, j)
@@ -44,27 +72,3 @@ pkgchk_fns_have_exs <- function (checks) {
 
     return (has_ex)
 }
-
-output_pkgchk_fns_have_exs <- function (checks) {
-
-    no_ex <- which (!checks$checks$fns_have_exs)
-    no_ex_fns <- names (checks$checks$fns_have_exs) [no_ex]
-
-    out <- list (
-        check_pass = length (no_ex) == 0L,
-        summary = "",
-        print = ""
-    ) # no print method
-
-    out$summary <- ifelse (out$check_pass,
-        "All functions have examples.",
-        paste0 (
-            "These functions do not have ",
-            "examples: [",
-            paste0 (no_ex_fns, collapse = ", "),
-            "]."
-        )
-    )
-
-    return (out)
-}

R/check-uses-dontrun.R

@@ -0,0 +1,141 @@
+#' Check if examples use `\dontrun{}`
+#'
+#' This check identifies functions in the package documentation that have
+#' examples using `\dontrun{}`. The use of `\dontrun{}` is discouraged by
+#' CRAN and should only be used the example really cannot be executed
+#' (e.g. because of missing additional software, missing API keys, ...) by
+#' the user. Instead use methods to run the examples conditionally, such as
+#' with the `@examplesIf()` roxygen tag.
+#'
+#' @param checks A 'pkgcheck' object with full \pkg{pkgstats} summary and
+#' \pkg{goodpractice} results.
+#' @return character vector of function names that have examples using `\dontrun{}`.
+#' @noRd
+pkgchk_uses_dontrun <- function(checks) {
+  rd_files <- list.files(
+    fs::path(
+      checks$pkg$path,
+      "man"
+    ),
+    pattern = "\\.Rd$",
+    full.names = TRUE
+  )
+
+  rd_files_use_dontrun(rd_files)
+}
+
+output_pkgchk_uses_dontrun <- function(checks) {
+
+  out <- list(
+    check_pass = all(checks$checks$uses_dontrun == "none"),
+    summary = "",
+    print = ""
+  )
+
+  # This is set up so that if all examples use dontrun, it is a failure (red X),
+  # if no examples use dontrun, it is a pass (green check), and if some examples
+  # use dontrun, it is a watch (:eyes:)
+  if (!out$check_pass) {
+    out$print <- "'.\nConsider using `@examplesIf()` to conditionally run examples instead."
+    if (all(checks$checks$uses_dontrun == "all")) {
+      out$summary <- "All examples use `\\dontrun{}`."
+      out$print <- paste0(
+      "All of your functions' examples use `\\dontrun{}`:\n'",
+      out$print
+      )
+    } else {
+      out$summary <- "Examples should not use `\\dontrun{}` unless really necessary."
+      out$print <- paste0(
+        "The following functions have examples that use `\\dontrun{}`:\n'",
+        paste(
+          names(checks$checks$uses_dontrun[checks$checks$uses_dontrun != "none"]),
+          collapse = "', '"
+        ),
+        out$print
+      )
+      out$check_type <- "none_watch"
+    }
+  }
+
+  return(out)
+}
+
+rd_files_use_dontrun <- function(rd_files) {
+  parsed_rds <- parse_rd_files(rd_files)
+
+  # Only check Rds that actually have examples
+  has_egs <- fns_have_exs(rd_files)
+
+  vapply(
+    parsed_rds[names(has_egs[has_egs])],
+    rd_has_dontrun_examples,
+    FUN.VALUE = character(1L)
+  )
+}
+
+## Utilities for parsing examples in Rd files
+get_Rd_section <- utils::getFromNamespace(".Rd_get_section", "tools")
+
+parse_rd_files <- function(rd_files) {
+  rds <- lapply(
+    rd_files,
+    function(f) {
+      tryCatch(
+        tools::parse_Rd(
+          f,
+          warningCalls = FALSE,
+          macros = FALSE,
+          permissive = TRUE
+        ),
+        error = function(e) {
+          warning(sprintf("Error parsing Rd file '%s': %s", file, e$message))
+          NULL
+        }
+      )
+    }
+  )
+  nms <- vapply(rds, get_Rd_meta, FUN.VALUE = character(1), "name")
+  stats::setNames(rds, nms)
+}
+
+rd_has_dontrun_examples <- function(rd) {
+
+  ex <- get_Rd_section(rd, "examples")
+  tags <- vapply(ex, function(exi) attr(exi, "Rd_tag"), character(1L))
+
+  # Code that is not wrapped in \dontrun has the attribute Rd_tag set to "RCODE"
+  # and is listed line-by-line in the examples section (i.e., each line has the
+  # Rd_tag "RCODE" attribute). Code that that is wrapped in \dontrun has the
+  # attribute Rd_tag set to "\\dontrun" and is nested in a list element, and
+  # within that list element the code lines have the Rd_tag attribute set to
+  # "VERB" (i.e. 'verbatim'; not run).
+
+  # Remove RCODE lines that are just whitespace or comments
+  bare_r_code <- grep(
+    "(^\\s+$)|(^#)", 
+    unlist(ex[tags == "RCODE"]), 
+    invert = TRUE, 
+    value = TRUE
+  )
+
+  dontrun_r_code <- grep(
+    "(^\\s+$)|(^#)", 
+    unlist(ex[tags == "\\dontrun"]),
+    invert = TRUE,
+    value = TRUE
+  )
+
+  any_bare_r_code <- length(bare_r_code) > 0
+  any_dont_run <- length(dontrun_r_code) > 0
+
+  # We could report how many lines are wrapped in \dontrun, but for now we just
+  # return a summary of whether there are any examples that use \dontrun.
+  if (any_bare_r_code && any_dont_run) {
+    return("some")
+  } else if (any_dont_run && !any_bare_r_code) {
+    return("all")
+  } else {
+    # Either no examples or no dontrun blocks
+    return("none")
+  }
+}

R/summarise-checks.R

@@ -162,7 +162,8 @@ order_checks <- function (fns) {
         # additionally explicitly listed below in `watch_checks()`:
         "obsolete_pkg_deps",
         "unique_fn_names",
-        "num_imports"
+        "num_imports",
+        "uses_dontrun"
     )
 
     fns <- fns [which (fns %in% ord)]

tests/testthat/_snaps/check-uses-dontrun.md

@@ -0,0 +1,7 @@
+# check examples dont use dontrun
+
+    Code
+      ci_out$print
+    Output
+      [1] "All of your functions' examples use `\\dontrun{}`:\n''.\nConsider using `@examplesIf()` to conditionally run examples instead."
+

tests/testthat/_snaps/extra-checks/checks-extra.html

@@ -33,6 +33,7 @@ <h2>Checks for <a href="https://github.com/ropensci-review-tools/pkgstats">pkgst
 <li>❌ Package contains unexpected files.</li>
 <li>❌ Default GitHub branch of ‘master’ is not acceptable.</li>
 <li>✅ This is a statistical package which complies with all applicable standards</li>
+<li>❌ All examples use <code>\dontrun{}</code>.</li>
 <li>👀 Some goodpractice linters failed.</li>
 <li>👀 Package depends on the following obsolete packages: [blah,sp]</li>
 </ul>

tests/testthat/_snaps/extra-checks/checks-extra.md

@@ -15,6 +15,7 @@ git hash: [](https://github.com/ropensci-review-tools/pkgstats/tree/)
 - :heavy_multiplication_x: Package contains unexpected files.
 - :heavy_multiplication_x: Default GitHub branch of 'master' is not acceptable.
 - :heavy_check_mark: This is a statistical package which complies with all applicable standards
+- :heavy_multiplication_x: All examples use `\dontrun{}`.
 - :eyes: Some goodpractice linters failed.
 - :eyes: Package depends on the following obsolete packages: [blah,sp]
 

tests/testthat/_snaps/extra-checks/checks-print.md

@@ -14,6 +14,7 @@ v Package has continuous integration checks, but no badges on README
 x Package contains unexpected files.
 x Default GitHub branch of 'master' is not acceptable.
 v This is a statistical package which complies with all applicable standards
+x All examples use `\dontrun`.
 i Some goodpractice linters failed.
 i Package depends on the following obsolete packages: [blah,sp]
 

tests/testthat/test-check-uses-dontrun.R

@@ -0,0 +1,54 @@
+test_that ("check examples dont use dontrun", {
+
+  checks <- make_check_data ()
+
+  # All examples use `\dontrun{}`
+  ci_out <- output_pkgchk_uses_dontrun (checks)
+
+  expect_type (ci_out, "list")
+  expect_length (ci_out, 3L)
+  expect_named (ci_out, c ("check_pass", "summary", "print"))
+  expect_false (ci_out$check_pass)
+  expect_equal (
+      ci_out$summary,
+      "All examples use `\\dontrun{}`."
+  )
+  expect_length (ci_out$print, 1L)
+  expect_snapshot (ci_out$print)
+
+  # Some examples use `\dontrun{}`
+  checks$checks$uses_dontrun ["pkgstats_summary"] <- "some"
+  ci_out <- output_pkgchk_uses_dontrun (checks)
+
+  expect_false (ci_out$check_pass)
+  expect_equal (
+    ci_out$summary, 
+    "Examples should not use `\\dontrun{}` unless really necessary."
+  )
+  expect_equal(ci_out$check_type, "none_watch")
+  expect_match(
+    ci_out$print, 
+    "The following functions have examples that use `\\dontrun{}`", 
+    fixed = TRUE
+  )
+
+  # No examples using `\dontrun{}`
+  checks$checks$uses_dontrun[] <- "none"
+  ci_out <- output_pkgchk_uses_dontrun (checks)
+
+  expect_true (ci_out$check_pass)
+  expect_equal (ci_out$summary, "")
+  expect_equal (ci_out$print, "")
+})
+
+test_that ("uses_dontrun works", {
+
+  rd_files <- system.file("Rd-for-testing-dontrun.Rd", package = "pkgcheck")
+
+  uses_dontrun_output <- rd_files_use_dontrun (rd_files)
+
+  expect_type (uses_dontrun_output, "character")
+  expect_length (uses_dontrun_output, 1L)
+  expect_named (uses_dontrun_output, "example_function")
+  expect_equal (uses_dontrun_output, c(example_function = "some"))
+})

tests/testthat/test-extra-checks.R

@@ -90,6 +90,7 @@ test_that ("extra checks", {
     ex [which (!ex)] <- TRUE
     checks$checks$fns_have_exs <- ex
     checks$checks$branch_is_master <- FALSE
+    checks$checks$uses_dontrun[] <- "none"
 
     set.seed (1L)
     x <- capture.output (summary (checks), type = "message")

tests/testthat/test-list-checks.R

@@ -3,7 +3,7 @@ test_that ("list-checks", {
         chks <- list_pkgchecks (),
         "The following checks are currently implemented"
     )
-    expect_length (chks, 22L)
+    expect_length (chks, 23L)
 
     expect_silent (
         chks2 <- list_pkgchecks (quiet = TRUE)