Add more test cases for complete coverage and example of stop_on_erro…

…r = 2L behavior

- Using evaluate only
- In rmarkdown + knitr context

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

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

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

@@ -0,0 +1,3 @@
+Error in h() : !
+Calls: <Anonymous> ... withCallingHandlers -> withVisible -> eval -> eval -> f -> g -> h
+Execution halted

tests/testthat/_snaps/conditions/stop-error-trace-calling-handler.txt

@@ -0,0 +1,23 @@
+Error in `h()`:
+! !
+Backtrace:
+     ▆
+  1. ├─evaluate::evaluate(...)
+  2. │ ├─base::withRestarts(...)
+  3. │ │ └─base (local) withRestartList(expr, restarts)
+  4. │ │   ├─base (local) withOneRestart(withRestartList(expr, restarts[-nr]), restarts[[nr]])
+  5. │ │   │ └─base (local) doWithOneRestart(return(expr), restart)
+  6. │ │   └─base (local) withRestartList(expr, restarts[-nr])
+  7. │ │     └─base (local) withOneRestart(expr, restarts[[1L]])
+  8. │ │       └─base (local) doWithOneRestart(return(expr), restart)
+  9. │ ├─evaluate:::with_handlers(...)
+ 10. │ │ ├─base::eval(call)
+ 11. │ │ │ └─base::eval(call)
+ 12. │ │ └─base::withCallingHandlers(...)
+ 13. │ ├─base::withVisible(eval(expr, envir))
+ 14. │ └─base::eval(expr, envir)
+ 15. │   └─base::eval(expr, envir)
+ 16. └─global f()
+ 17.   └─global g()
+ 18.     └─global h()
+Execution halted

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

@@ -0,0 +1,8 @@
+Error in `h()`:
+! !
+Backtrace:
+    ▆
+ 1. └─global f()
+ 2.   └─global g()
+ 3.     └─global h()
+Execution halted

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

@@ -0,0 +1,22 @@
+Error in `g()`:
+! could not find function "g"
+Backtrace:
+     ▆
+  1. ├─base::withCallingHandlers(...)
+  2. ├─evaluate::evaluate(...)
+  3. │ ├─base::withRestarts(...)
+  4. │ │ └─base (local) withRestartList(expr, restarts)
+  5. │ │   ├─base (local) withOneRestart(withRestartList(expr, restarts[-nr]), restarts[[nr]])
+  6. │ │   │ └─base (local) doWithOneRestart(return(expr), restart)
+  7. │ │   └─base (local) withRestartList(expr, restarts[-nr])
+  8. │ │     └─base (local) withOneRestart(expr, restarts[[1L]])
+  9. │ │       └─base (local) doWithOneRestart(return(expr), restart)
+ 10. │ ├─evaluate:::with_handlers(...)
+ 11. │ │ ├─base::eval(call)
+ 12. │ │ │ └─base::eval(call)
+ 13. │ │ └─base::withCallingHandlers(...)
+ 14. │ ├─base::withVisible(eval(expr, envir))
+ 15. │ └─base::eval(expr, envir)
+ 16. │   └─base::eval(expr, envir)
+ 17. └─global f()
+Execution halted

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

@@ -0,0 +1,6 @@
+evaluate::evaluate(function() {
+  f <- function() g()
+  g <- function() h()
+  h <- function() rlang::abort("!")
+  f()
+}, stop_on_error = 2L)

tests/testthat/ressources/with-stop-error-no-trace.R

@@ -0,0 +1,6 @@
+evaluate::evaluate(function() {
+  f <- function() g()
+  g <- function() h()
+  h <- function() stop("!")
+  f()
+}, stop_on_error = 2L)

tests/testthat/ressources/with-stop-error-trace-trimmed.R

@@ -0,0 +1,10 @@
+handlers <- evaluate::new_output_handler(
+  calling_handlers = list(error = function(cnd) rlang::entrace(cnd))
+)
+options(rlang_trace_top_env = parent.frame())
+evaluate::evaluate(function() {
+  f <- function() g()
+  g <- function() h()
+  h <- function() stop("!")
+  f()
+}, stop_on_error = 2L, output_handler = handlers)

tests/testthat/ressources/with-stop-error-trace.R

@@ -0,0 +1,9 @@
+handlers <- evaluate::new_output_handler(
+  calling_handlers = list(error = function(cnd) rlang::entrace(cnd))
+)
+evaluate::evaluate(function() {
+  f <- function() g()
+  g <- function() h()
+  h <- function() stop("!")
+  f()
+}, stop_on_error = 2L, output_handler = handlers)

tests/testthat/ressources/with-stop-error-wch.R

@@ -0,0 +1,8 @@
+withCallingHandlers(
+  error = function(cnd) rlang::entrace(cnd),
+  evaluate::evaluate(function() {
+    f <- function() g()
+    h <- function() stop("!")
+    f()
+  }, stop_on_error = 2L)
+)

tests/testthat/test-conditions.R

@@ -137,7 +137,7 @@ test_that("errors during printing are captured", {
   expect_output_types(ev, c("source", "error"))
 })
 
-test_that("Entraced error does not loose their backtrace when render errors", {
+test_that("Error can be entraced and are shown correctly when stop_on_error = 2L.", {
   skip_if_not_installed("rlang")
   skip_if_not_installed("rmarkdown")
   skip_if_not_installed("callr")
@@ -147,11 +147,28 @@ test_that("Entraced error does not loose their backtrace when render errors", {
   quick_install(pkgload::pkg_path("."), lib = .libPaths()[1])
 
   out <- withr::local_tempfile(fileext = "txt")
-
+
+  # Checking different way to entrace with evaluate
+  callr::rscript(test_path("ressources/with-stop-error-no-trace.R"), fail_on_status = FALSE, show = FALSE, stderr = out)
+  expect_snapshot_file(out, name = 'stop-error-no-trace.txt')
+
+  callr::rscript(test_path("ressources/with-stop-error-trace.R"), fail_on_status = FALSE, show = FALSE, stderr = out)
+  expect_snapshot_file(out, name = 'stop-error-trace-calling-handler.txt')
+
+  callr::rscript(test_path("ressources/with-stop-error-wch.R"), fail_on_status = FALSE, show = FALSE, stderr = out)
+  expect_snapshot_file(out, name = 'stop-error-trace-wch.txt')
+
+  callr::rscript(test_path("ressources/with-stop-error-trace-trimmed.R"), fail_on_status = FALSE, show = FALSE, stderr = out)
+  expect_snapshot_file(out, name = 'stop-error-trace-trimmed.txt')
+
+  callr::rscript(test_path("ressources/with-abort-error.R"), fail_on_status = FALSE, show = FALSE, stderr = out)
+  expect_snapshot_file(out, name = 'abort-error.txt')
+
+  # Checking error in rmarkdown and knitr context
   rscript <- withr::local_tempfile(fileext = "R")
-  writeLines(sprintf("rmarkdown::render(%s)", dQuote(test_path("ressources/with-stop-error.Rmd"), FALSE)), con = rscript)
+  writeLines(sprintf("rmarkdown::render(%s)", dQuote(test_path("ressources/with-stop-error-auto-entrace.Rmd"), FALSE)), con = rscript)
   callr::rscript(rscript, fail_on_status = FALSE, show = FALSE, stderr = out)
-  expect_snapshot_file(out, name = 'stop-error.txt')
+  expect_snapshot_file(out, name = 'stop-error-auto-entrace.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)