Retain rlang errors / traces (#306)

* Add aspirational test re: restoration of rlang::last_error() and last_trace() inside knitr Also make some input more humane * Add a failing test Also remove the rlang version requirement. We're going to solve this here in reprex (for now ... maybe later in evaluate). * Set more options re: rlang; use them regardless of new_session
tidyverse · Jan 17, 2020 · 240515d · 240515d
1 parent 9639e88
commit 240515d
Show file tree

Hide file tree

Showing 2 changed files with 40 additions and 12 deletions.
diff --git a/R/reprex_render.R b/R/reprex_render.R
@@ -81,20 +81,23 @@ reprex_render_impl <- function(input,
   std_out_err <- new_session && (yaml_opts[["std_out_err"]] %||% FALSE)
   std_file <- std_out_err_path(input, std_out_err)
 
+  render_options <- list(
+    keep.source = TRUE,
+    rlang_trace_top_env = globalenv(),
+    rlang_force_unhandled_error = TRUE,
+    rlang_backtrace_on_error = "full",
+    crayon.enabled = FALSE
+  )
   if (new_session) {
     md_file <- callr::r(
-      function(input) {
-        options(
-          keep.source = TRUE,
-          rlang_trace_top_env = globalenv(),
-          crayon.enabled = FALSE
-        )
+      function(input, opts) {
+        options(opts)
         rmarkdown::render(
           input,
           quiet = TRUE, envir = globalenv(), encoding = "UTF-8"
         )
       },
-      args = list(input = input),
+      args = list(input = input, opts = render_options),
       spinner = is_interactive(),
       stdout = std_file,
       stderr = std_file
@@ -104,10 +107,13 @@ reprex_render_impl <- function(input,
       inject_file(md_file, std_file)
     }
   } else {
-    md_file <- rmarkdown::render(
-      input,
-      quiet = TRUE, envir = globalenv(), encoding = "UTF-8",
-      knit_root_dir = getwd()
+    withr::with_options(
+      render_options,
+      md_file <- rmarkdown::render(
+        input,
+        quiet = TRUE, envir = globalenv(), encoding = "UTF-8",
+        knit_root_dir = getwd()
+      )
     )
   }
 

diff --git a/tests/testthat/test-reprex.R b/tests/testthat/test-reprex.R
@@ -24,14 +24,36 @@ test_that("reprex() doesn't leak files by default", {
 
 test_that("rmarkdown::render() context is trimmed from rlang backtrace", {
   skip_on_cran()
-  input <- "f <- function() g(); g <- function() h(); h <- function() rlang::abort('foo'); f()\n"
+  input <- c(
+    "f <- function() rlang::abort('foo')",
+    "f()",
+    "rlang::last_error()",
+    "rlang::last_trace()"
+  )
   ret <- reprex(input = input, advertise = FALSE)
   expect_false(any(grepl("tryCatch", ret)))
   expect_false(any(grepl("rmarkdown::render", ret)))
 })
 
+test_that("rlang::last_error() and last_trace() work", {
+  skip_on_cran()
+
+  input <- c(
+    "f <- function() rlang::abort('foo')",
+    "f()",
+    "rlang::last_error()",
+    "rlang::last_trace()"
+  )
+  ret <- reprex(input = input, advertise = FALSE)
+  m <- match("rlang::last_error()", ret)
+  expect_false(grepl("Error", ret[m + 1]))
+  m <- match("rlang::last_trace()", ret)
+  expect_false(grepl("Error", ret[m + 1]))
+})
+
 test_that("reprex() works even if user uses fancy quotes", {
   skip_on_cran()
   withr::local_options(list(useFancyQuotes = TRUE))
+  # use non-default venue to force some quoted yaml to be written
   expect_error_free(reprex(1, venue = "R"))
 })