Don't show code in \dontshow{} or \testonly{} (#2629)

Fixes #2188

DESCRIPTION

@@ -44,7 +44,7 @@ Imports:
 Suggests:
     covr,
     diffviewer,
-    evaluate,
+    evaluate (>= 0.23.0.9000),
     gert,
     gt,
     htmltools,
@@ -71,3 +71,4 @@ Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.3.1
 SystemRequirements: pandoc
+Remotes: r-lib/evaluate

NEWS.md

@@ -1,5 +1,6 @@
 # pkgdown (development version)
 
+* `build_reference()` no longer displays `\dontshow{}` or `\testonly{}` blocks in examples. It will run the code in `\dontshow{}`; it won't run the code in `\testonly{}`(#2188).
 * `build_article()` no long has a `data` argument. This is technically a breaking change, but I can't figure out why anyone would have ever used it.
 * `build_reference()` does a better job of parsing `\value{}` blocks (#2371).
 * When built on GitHub, source urls now use the name of the current upstream branch (rather than `HEAD`), which is more likely to generate correct links (#2597).

R/highlight.R

@@ -28,11 +28,23 @@ highlight_examples <- function(code, topic, env = globalenv()) {
     do.call(fig_save, c(list(plot, name), fig_settings()))
   }
 
+  hide_dontshow <- function(src, call) {
+    if (is_call(call, c("DONTSHOW", "TESTONLY"))) NULL else src
+  }
+  handler <- evaluate::new_output_handler(
+    value = pkgdown_print,
+    source = hide_dontshow
+  )
+
+  eval_env <- child_env(env)
+  eval_env$DONTSHOW <- function(x) invisible(x)
+  eval_env$TESTONLY <- function(x) invisible()
+
   out <- downlit::evaluate_and_highlight(
     code,
     fig_save = fig_save_topic,
-    env = child_env(env),
-    output_handler = evaluate::new_output_handler(value = pkgdown_print)
+    env = eval_env,
+    output_handler = handler
   )
   structure(
     sourceCode(pre(out, r_code = TRUE)),

R/rd-example.R

@@ -129,9 +129,9 @@ as_example.tag_dontrun <- function(x, run_dont_run = FALSE) {
   } else {
     ex <- flatten_ex(x, run_dont_run = run_dont_run)
     if (is_newline(x[[1]], trim = TRUE)) {
-      paste0("if (FALSE) {", ex, "}")
+      paste0("if (FALSE) { # \\dontrun{", ex, "} # }")
     } else {
-      paste0("if (FALSE) ", ex, "")
+      paste0("if (FALSE) ", ex, " # \\dontrun{}")
     }
   }
 }
@@ -142,19 +142,24 @@ as_example.tag_donttest <- function(x, run_dont_run = FALSE) {
 }
 #' @export
 as_example.tag_dontshow <- function(x, run_dont_run = FALSE) {
-  block_tag_to_comment("\\dontshow", x, run_dont_run = run_dont_run)
+  ex <- flatten_ex(x, run_dont_run = run_dont_run)
+  paste0("DONTSHOW({", ex, "})")
 }
 #' @export
 as_example.tag_testonly <- function(x, run_dont_run = FALSE) {
-  block_tag_to_comment("\\testonly", x, run_dont_run = run_dont_run)
+  ex <- flatten_ex(x, run_dont_run = run_dont_run)
+  paste0("TESTONLY({", ex, "})")
 }
 
 block_tag_to_comment <- function(tag, x, run_dont_run = FALSE) {
+  ex <- flatten_ex(x, run_dont_run = run_dont_run)
+
+  # Not easy to strip leading whitespace because it's attached to the previous
+  # tag. So instead we add a comment to occupy that space
   if (is_newline(x[[1]], trim = TRUE)) {
-    paste0("# ", tag, "{", flatten_ex(x, run_dont_run = run_dont_run), "# }")
-  } else {
-    flatten_ex(x, run_dont_run = run_dont_run)
+    ex <- paste0("# ", tag, "{", ex, "# }")
   }
+  ex
 }
 
 #' @export

R/test.R

@@ -97,44 +97,61 @@ NULL
 #' @keywords internal
 #' @family tests
 #' @examples
+#' # \dontrun{} --------------------------------------------------------
+#' # always shown; never run
+#'
+#' x <- 1
+#' \dontrun{x <- 2}
 #' \dontrun{
-#'   abort("This is an error!")
+#'   x <- 3
+#'   x <- 4
 #' }
+#' x # should be 1
 #'
-#' # Inline \donttest is silently ommitted
-#' \donttest{message("Hi!")}
+#' # \donttest{} -------------------------------------------------------
+#' # only multiline are shown; always run
 #'
-#' # Block \donttest indicated with comments
+#' x <- 1
+#' \donttest{x <- 2}
 #' \donttest{
-#' # This is a comment
-#' 1 + 3
+#'   x <- 3
+#'   x <- 4
 #' }
+#' x # should be 4
 #'
-#' # And works even when not at the top level
-#' if (TRUE) {
-#'   \donttest{
-#'   1 + 2
-#'   }
+#' # \testonly{} -----------------------------------------------------
+#' # never shown, never run
+#'
+#' x <- 1
+#' \testonly{x <- 2}
+#' \testonly{
+#'   x <- 3
+#'   x <- 4
 #' }
+#' x # should be 1
+#' 
+#' # \dontshow{} -------------------------------------------------------
+#' # never shown, always run
 #'
-#' answer <- 1
+#' x <- 1
+#' \dontshow{x <- 2}
 #' \dontshow{
-#' answer <- 42
+#'   x <- 3
+#'   x <- 4
 #' }
-#' answer # should be 42
-#'
-#' # To hide the \dontshow part, for conditional examples
-#' \dontshow{if (FALSE) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf}
-#' answer <- 43
-#' \dontshow{\}) # examplesIf}
-#' answer # should be still 42
-#'
-#' # But this one runs, and the condition is hidden
-#' \dontshow{if (TRUE) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf}
-#' answer <- 43
-#' \dontshow{\}) # examplesIf}
-#' answer
-
+#' x # should be 4
+#'
+#' # @examplesIf ------------------------------------------------------
+#' # If FALSE, wrapped in if; if TRUE, not seen
+#'
+#' x <- 1
+#' 
+#' @examplesIf FALSE
+#' x <- 2
+#' @examplesIf TRUE
+#' x <- 3
+#' @examples
+#' x # should be 3
 NULL
 
 #' Test case: params

tests/testthat/_snaps/highlight.md

@@ -1,3 +1,11 @@
+# highlight_examples runs and hides DONTSHOW calls()
+
+    Code
+      cat(strip_html_tags(out))
+    Output
+      x
+      #> [1] 1
+
 # pre() can produce needed range of outputs
 
     Code

tests/testthat/test-highlight.R

@@ -9,6 +9,12 @@ test_that("highlight_examples captures dependencies", {
   expect_equal(attr(out, "dependencies")[-1], list(dummy_dep))
 })
 
+
+test_that("highlight_examples runs and hides DONTSHOW calls()", {
+  out <- highlight_examples("DONTSHOW(x <- 1)\nx")
+  expect_snapshot(cat(strip_html_tags(out)))
+})
+
 test_that("highlight_text & highlight_examples include sourceCode div", {
   withr::defer(file_delete(test_path("Rplot001.png")))
 

tests/testthat/test-rd-example.R

@@ -9,27 +9,47 @@ test_that("warns if unparseable", {
 
 # as_example() ------------------------------------------------------------
 
-test_that("inline tags are stripped", {
-  expect_equal(rd2ex("\\donttest{1}"), "1")
-  expect_equal(rd2ex("\\dontshow{1}"), "1")
-  expect_equal(rd2ex("\\testonly{1}"), "1")
-  expect_equal(rd2ex("\\dontrun{1}"), "if (FALSE) 1")
+test_that("dontrun{} wrapped in if(FALSE)", {
+  expect_equal(rd2ex("\\dontrun{1}"), "if (FALSE) 1 # \\dontrun{}")
+  expect_equal(
+    rd2ex("\\dontrun{\n  1\n}"),
+    c("if (FALSE) { # \\dontrun{", "  1", "} # }")
+  )
+
+  # unless run_dont_run is true
   expect_equal(rd2ex("\\dontrun{1}", run_dont_run = TRUE), "1")
+  expect_equal(
+    rd2ex("\\dontrun{\n  1\n}", run_dont_run = TRUE),
+    c("# \\dontrun{", "  1", "# }")
+  )
+})
+
+test_that("block donttest{} gets a comment to preserve spacing", {
+  expect_equal(rd2ex("\\donttest{1}"), "1")
+  expect_equal(
+    rd2ex("\\donttest{\n  1\n}"),
+    c("# \\donttest{", "  1", "# }")
+  )
+})
+
+test_that("dontshow{} becomes DONTSHOW", {
+  expect_equal(rd2ex("\\dontshow{1}"), "DONTSHOW({1})")
+  expect_equal(rd2ex("\\dontshow{\n  1\n}"), c("DONTSHOW({", "  1", "})"))
 })
 
-test_that("blocks get fillers to preserve spacing", {
-  expect_equal(rd2ex("\\donttest{\n  1\n}"), c("# \\donttest{", "  1", "# }"))
-  expect_equal(rd2ex("\\dontrun{\n  1\n}"), c("if (FALSE) {", "  1", "}"))
+test_that("testonly{} becomes TESTONLY", {
+  expect_equal(rd2ex("\\testonly{1}"), "TESTONLY({1})")
+  expect_equal(rd2ex("\\testonly{\n  1\n}"), c("TESTONLY({", "  1", "})"))
 })
 
 test_that("handles nested tags", {
   expect_equal(
     rd2ex("if(TRUE {\n  \\dontrun{\n    1 + 2\n  }\n}"),
     c(
       "if(TRUE {",
-      "  if (FALSE) {",
+      "  if (FALSE) { # \\dontrun{",
       "    1 + 2",
-      "  }",
+      "  } # }",
       "}"
     )
   )