diff --git a/NEWS.md b/NEWS.md index 68ec2564f8..80117fa44b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,6 @@ # pkgdown (development version) +* `build_article()` gains a new `new_process` argument which allows to build a vignette in the current process for debugging purposes. We've also improved the error messages and tracebacks if an article fails to build, hopefully also making debugging easier (#2438). * Preview links now work once again (#2435). * `build_home()` no longer renders Github issue and pull request templates (@hsloot, #2362) * It is now easier to preview parts of the website locally interactively. `build_reference_index()` and friends will call `init_site()` internally instead of erroring (@olivroy, #2329). diff --git a/R/build-articles.R b/R/build-articles.R index 7693a5a25b..d634eac0da 100644 --- a/R/build-articles.R +++ b/R/build-articles.R @@ -200,11 +200,15 @@ build_articles <- function(pkg = ".", #' @param name Name of article to render. This should be either a path #' relative to `vignettes/` without extension, or `index` or `README`. #' @param data Additional data to pass on to template. +#' @param new_process Build the article in a clean R process? The default, +#' `TRUE`, ensures that every article is build in a fresh environment, but +#' you may want to set it to `FALSE` to make debugging easier. build_article <- function(name, pkg = ".", data = list(), lazy = FALSE, seed = 1014L, + new_process = TRUE, quiet = TRUE) { pkg <- as_pkgdown(pkg) @@ -293,6 +297,7 @@ build_article <- function(name, output_format = format, output_options = options, seed = seed, + new_process = new_process, quiet = quiet ) } diff --git a/R/rmarkdown.R b/R/rmarkdown.R index 1dd09d73df..fc22fc66de 100644 --- a/R/rmarkdown.R +++ b/R/rmarkdown.R @@ -1,7 +1,7 @@ #' Render RMarkdown document in a fresh session #' #' @noRd -render_rmarkdown <- function(pkg, input, output, ..., seed = NULL, copy_images = TRUE, quiet = TRUE) { +render_rmarkdown <- function(pkg, input, output, ..., seed = NULL, copy_images = TRUE, new_process = TRUE, quiet = TRUE, call = caller_env()) { input_path <- path_abs(input, pkg$src_path) output_path <- path_abs(output, pkg$dst_path) @@ -19,48 +19,39 @@ render_rmarkdown <- function(pkg, input, output, ..., seed = NULL, copy_images = output_dir = path_dir(output_path), intermediates_dir = tempdir(), encoding = "UTF-8", - envir = globalenv(), seed = seed, ..., quiet = quiet ) - path <- tryCatch( - callr::r_safe( - function(seed, envir, ...) { - if (!is.null(seed)) { - # since envir is copied from the parent fn into callr::r_safe(), - # set.seed() sets the seed in the wrong global env and we have to - # manually copy it over - set.seed(seed) - envir$.Random.seed <- .GlobalEnv$.Random.seed - if (requireNamespace("htmlwidgets", quietly = TRUE)) { - htmlwidgets::setWidgetIdSeed(seed) - } - } - rmarkdown::render(envir = envir, ...) - }, - args = args, - show = !quiet, - env = c( - callr::rcmd_safe_env(), - BSTINPUTS = bst_paths(input_path), - TEXINPUTS = tex_paths(input_path), - BIBINPUTS = bib_paths(input_path), - R_CLI_NUM_COLORS = 256 - ) - ), - error = function(cnd) { - cli::cli_abort( - c( - "Failed to render RMarkdown document.", - x = gsub("\r", "", cnd$stderr, fixed = TRUE) - ), - parent = cnd - ) - } + withr::local_envvar( + callr::rcmd_safe_env(), + BSTINPUTS = bst_paths(input_path), + TEXINPUTS = tex_paths(input_path), + BIBINPUTS = bib_paths(input_path), + R_CLI_NUM_COLORS = 256 ) + if (new_process) { + path <- withCallingHandlers( + callr::r_safe(rmarkdown_render_with_seed, args = args, show = !quiet), + error = function(cnd) { + lines <- strsplit(cnd$stderr, "\r?\n")[[1]] + cli::cli_abort( + c( + x = "Failed to render RMarkdown document.", + set_names(lines, " ") + ), + parent = cnd$parent %||% cnd, + trace = cnd$parent$trace, + call = call + ) + } + ) + } else { + path <- inject(rmarkdown_render_with_seed(!!!args)) + } + if (identical(path_ext(path)[[1]], "html")) { update_html( path, @@ -102,6 +93,25 @@ render_rmarkdown <- function(pkg, input, output, ..., seed = NULL, copy_images = invisible(path) } + +rmarkdown_render_with_seed <- function(..., seed = NULL) { + if (!is.null(seed)) { + set.seed(seed) + if (requireNamespace("htmlwidgets", quietly = TRUE)) { + htmlwidgets::setWidgetIdSeed(seed) + } + + # since envir is copied from the parent fn into callr::r_safe(), + # set.seed() sets the seed in the wrong global env and we have to + # manually copy it over + # if (!identical(envir, globalenv())) { + # envir$.Random.seed <- .GlobalEnv$.Random.seed + # } + } + + rmarkdown::render(envir = globalenv(), ...) +} + # adapted from tools::texi2dvi bst_paths <- function(path) { paths <- c( @@ -125,5 +135,4 @@ bib_paths <- function(path) { tex_paths(path) ) paste(paths, collapse = .Platform$path.sep) - } diff --git a/man/build_articles.Rd b/man/build_articles.Rd index 3f5b9c072f..c1753785e5 100644 --- a/man/build_articles.Rd +++ b/man/build_articles.Rd @@ -21,6 +21,7 @@ build_article( data = list(), lazy = FALSE, seed = 1014L, + new_process = TRUE, quiet = TRUE ) @@ -48,6 +49,10 @@ freshly generated section in browser.} relative to \verb{vignettes/} without extension, or \code{index} or \code{README}.} \item{data}{Additional data to pass on to template.} + +\item{new_process}{Build the article in a clean R process? The default, +\code{TRUE}, ensures that every article is build in a fresh environment, but +you may want to set it to \code{FALSE} to make debugging easier.} } \description{ \code{build_articles()} renders each R Markdown file underneath \verb{vignettes/} and diff --git a/tests/testthat/_snaps/rmarkdown.md b/tests/testthat/_snaps/rmarkdown.md index aa84604f5e..7ed6b9cef2 100644 --- a/tests/testthat/_snaps/rmarkdown.md +++ b/tests/testthat/_snaps/rmarkdown.md @@ -6,22 +6,50 @@ Reading assets/vignette-with-img.Rmd Writing `test.html` -# render_rmarkdown yields useful error +# render_rmarkdown yields useful error if pandoc fails Code - render_rmarkdown(pkg, "assets/pandoc-fail.Rmd", "test.html", output_format = rmarkdown::html_document( - pandoc_args = "--fail-if-warnings")) + render_rmarkdown(pkg, "assets/pandoc-fail.Rmd", "test.html", output_format = format) Message Reading assets/pandoc-fail.Rmd Condition - Error in `render_rmarkdown()`: - ! Failed to render RMarkdown document. - x [WARNING] Could not fetch resource path-to-image.png Failing because there were warnings. - Caused by error: - ! in callr subprocess. + Error: + x Failed to render RMarkdown document. + [WARNING] Could not fetch resource path-to-image.png + Failing because there were warnings. Caused by error: ! pandoc document conversion failed with error 3 +# render_rmarkdown yields useful error if R fails + + Code + # Test traceback + summary(expect_error(render_rmarkdown(pkg, "assets/r-fail.Rmd", "test.html"))) + Message + Reading assets/r-fail.Rmd + Output + + Error: + x Failed to render RMarkdown document. + + Quitting from lines 6-13 [unnamed-chunk-1] (r-fail.Rmd) + Caused by error: + ! Error! + --- + Backtrace: + x + 1. \-global f() + 2. \-global g() + 3. \-global h() + Code + # Just test that it works; needed for browser() etc + expect_error(render_rmarkdown(pkg, "assets/r-fail.Rmd", "test.html", + new_process = FALSE)) + Message + Reading assets/r-fail.Rmd + + Quitting from lines 6-13 [unnamed-chunk-1] (r-fail.Rmd) + # render_rmarkdown styles ANSI escapes Code diff --git a/tests/testthat/assets/r-fail.Rmd b/tests/testthat/assets/r-fail.Rmd new file mode 100644 index 0000000000..101dc46a0f --- /dev/null +++ b/tests/testthat/assets/r-fail.Rmd @@ -0,0 +1,13 @@ +--- +title: "r-fail" +--- + +```{r} +f <- function() g() +g <- function() h() +h <- function() { + rlang::abort("Error!") +} + +f() +``` \ No newline at end of file diff --git a/tests/testthat/test-rmarkdown.R b/tests/testthat/test-rmarkdown.R index 24b3af222c..8e618c1c90 100644 --- a/tests/testthat/test-rmarkdown.R +++ b/tests/testthat/test-rmarkdown.R @@ -13,7 +13,7 @@ test_that("render_rmarkdown copies image files in subdirectories", { ) }) -test_that("render_rmarkdown yields useful error", { +test_that("render_rmarkdown yields useful error if pandoc fails", { local_edition(3) skip_on_cran() # fragile due to pandoc dependency skip_if_no_pandoc("2.18") @@ -21,10 +21,31 @@ test_that("render_rmarkdown yields useful error", { tmp <- dir_create(file_temp()) pkg <- list(src_path = test_path("."), dst_path = tmp, bs_version = 3) - expect_snapshot(error = TRUE, { - render_rmarkdown(pkg, "assets/pandoc-fail.Rmd", "test.html", - output_format = rmarkdown::html_document(pandoc_args = "--fail-if-warnings")) - }) + format <- rmarkdown::html_document(pandoc_args = "--fail-if-warnings") + expect_snapshot( + render_rmarkdown(pkg, "assets/pandoc-fail.Rmd", "test.html", output_format = format), + error = TRUE + ) +}) + +test_that("render_rmarkdown yields useful error if R fails", { + local_edition(3) + skip_if_no_pandoc() + + tmp <- dir_create(file_temp()) + pkg <- list(src_path = test_path("."), dst_path = tmp, bs_version = 3) + + expect_snapshot( + { + "Test traceback" + summary(expect_error(render_rmarkdown(pkg, "assets/r-fail.Rmd", "test.html"))) + + "Just test that it works; needed for browser() etc" + expect_error(render_rmarkdown(pkg, "assets/r-fail.Rmd", "test.html", new_process = FALSE)) + }, + # work around xfun bug + transform = function(x) gsub("lines ?at lines", "lines", x) + ) }) test_that("render_rmarkdown styles ANSI escapes", {