Don't use a restart to handle stop_on_error = 2L

DESCRIPTION

@@ -25,11 +25,14 @@ BugReports: https://github.com/r-lib/evaluate/issues
 Depends:
     R (>= 3.6.0)
 Suggests:
+    callr,
     covr,
     ggplot2 (>= 3.3.6),
     lattice,
     methods,
+    pkgload,
     rlang,
+    rmarkdown,
     testthat (>= 3.0.0),
     withr
 Config/Needs/website: tidyverse/tidytemplate

R/conditions.R

@@ -34,7 +34,8 @@ condition_handlers <- function(watcher, on_error, on_warning, on_message) {
       switch(on_error,
         continue = invokeRestart("eval_continue"),
         stop = invokeRestart("eval_stop"),
-        error = invokeRestart("eval_error", cnd)
+        # No need to invoke a restart as we want the error to be thrown in this case.
+        error = NULL
       )
     }
   )

R/evaluate.R

@@ -151,8 +151,7 @@ evaluate <- function(input,
         handlers
       ),
       eval_continue = function() TRUE,
-      eval_stop = function() FALSE,
-      eval_error = function(cnd) {signalCondition(cnd); stop(cnd)}
+      eval_stop = function() FALSE
     )
     watcher$check_devices()
 

tests/testthat/_snaps/conditions.md

@@ -6,10 +6,10 @@
       Warning in `f()`:
       Hi!
 
-# all three starts of stop_on_error work as expected
+# all three values of stop_on_error work as expected
 
     Code
-      evaluate("stop(\"1\")\n2", stop_on_error = 2L)
+      ev <- evaluate("stop(\"1\")\n2", stop_on_error = 2L)
     Condition
       Error:
       ! 1

tests/testthat/_snaps/conditions/abort-error.txt

@@ -0,0 +1,12 @@
+
+
+processing file: with-abort-error.Rmd
+Error in `h()`:
+! !
+Backtrace:
+ 1. global f()
+ 2. global g()
+ 3. global h()
+
+Quitting from lines 11-15 [unnamed-chunk-2] (with-abort-error.Rmd)
+Execution halted

tests/testthat/_snaps/conditions/stop-error.txt

@@ -0,0 +1,12 @@
+
+
+processing file: with-stop-error.Rmd
+Error in `h()`:
+! !
+Backtrace:
+ 1. global f()
+ 2. global g()
+ 3. global h()
+
+Quitting from lines 11-15 [unnamed-chunk-2] (with-stop-error.Rmd)
+Execution halted

tests/testthat/helper.R

@@ -2,3 +2,20 @@ expect_output_types <- function(x, types) {
   output_types <- vapply(x, output_type, character(1))
   expect_equal(output_types, types)
 }
+
+quick_install <- function(package, lib, quiet = TRUE) {
+  opts <- c(
+    "--data-compress=none",
+    "--no-byte-compile",
+    "--no-data",
+    "--no-demo",
+    "--no-docs",
+    "--no-help",
+    "--no-html",
+    "--no-libs",
+    "--use-vanilla",
+    sprintf("--library=%s", lib),
+    package
+  )
+  invisible(callr::rcmd("INSTALL", opts, show = !quiet, fail_on_status = TRUE))
+}

tests/testthat/ressources/with-abort-error.Rmd

@@ -0,0 +1,15 @@
+---
+title: document with error
+---
+
+```{r}
+rlang::global_entrace()
+options(rlang_backtrace_on_error_report = "full")
+```
+
+```{r}
+f <- function() g()
+g <- function() h()
+h <- function() rlang::abort("!")
+f()
+```

tests/testthat/ressources/with-stop-error.Rmd

@@ -0,0 +1,15 @@
+---
+title: document with error
+---
+
+```{r}
+rlang::global_entrace()
+options(rlang_backtrace_on_error_report = "full")
+```
+
+```{r}
+f <- function() g()
+g <- function() h()
+h <- function() stop("!")
+f()
+```

tests/testthat/test-conditions.R

@@ -118,14 +118,14 @@ test_that("an error terminates evaluation of multi-expression input", {
   expect_output_types(ev, c("source", "error"))
 })
 
-test_that("all three starts of stop_on_error work as expected", {
+test_that("all three values of stop_on_error work as expected", {
   ev <- evaluate('stop("1")\n2', stop_on_error = 0L)
   expect_output_types(ev, c("source", "error", "source", "text"))
 
   ev <- evaluate('stop("1")\n2', stop_on_error = 1L)
   expect_output_types(ev, c("source", "error"))
 
-  expect_snapshot(evaluate('stop("1")\n2', stop_on_error = 2L), error = TRUE)
+  expect_snapshot(ev <- evaluate("stop(\"1\")\n2", stop_on_error = 2L), error = TRUE)
 })
 
 test_that("errors during printing are captured", {
@@ -136,3 +136,24 @@ test_that("errors during printing are captured", {
   ev <- evaluate("a")
   expect_output_types(ev, c("source", "error"))
 })
+
+test_that("Entraced error does not loose their backtrace when render errors", {
+  skip_if_not_installed("rlang")
+  skip_if_not_installed("rmarkdown")
+  skip_if_not_installed("callr")
+  skip_on_cran()
+  # install dev version of package in temp directory
+  withr::local_temp_libpaths()
+  quick_install(pkgload::pkg_path("."), lib = .libPaths()[1])
+
+  out <- withr::local_tempfile(fileext = "txt")
+
+  rscript <- withr::local_tempfile(fileext = "R")
+  writeLines(sprintf("rmarkdown::render(%s)", dQuote(test_path("ressources/with-stop-error.Rmd"), FALSE)), con = rscript)
+  callr::rscript(rscript, fail_on_status = FALSE, show = FALSE, stderr = out)
+  expect_snapshot_file(out, name = 'stop-error.txt')
+
+  writeLines(sprintf("rmarkdown::render(%s)", dQuote(test_path("ressources/with-abort-error.Rmd"), FALSE)), con = rscript)
+  callr::rscript(rscript, fail_on_status = FALSE, show = FALSE, stderr = out)
+  expect_snapshot_file(out, name = 'abort-error.txt')
+})