Add call argument to throw()

king-of-poppk · Apr 13, 2023 · f7e7be7 · f7e7be7
1 parent a5928a4
commit f7e7be7
Show file tree

Hide file tree

Showing 3 changed files with 38 additions and 4 deletions.
diff --git a/R/standalone-errors.R b/R/standalone-errors.R
@@ -231,7 +231,10 @@ err <- local({
   #' @param frame The throwing context. Can be used to hide frames from
   #'   the backtrace.
 
-  throw <- throw_error <- function(cond, parent = NULL, frame = environment()) {
+  throw <- throw_error <- function(cond,
+                                   parent = NULL,
+                                   call = parent.frame(),
+                                   frame = environment()) {
     if (!inherits(cond, "condition")) {
       cond <- new_error(cond)
     }
@@ -240,7 +243,7 @@ err <- local({
     }
 
     if (isTRUE(cond[["call"]])) {
-      cond[["call"]] <- sys.call(-1) %||% sys.call()
+      cond[["call"]] <- frame_call(call)
     } else if (identical(cond[["call"]], FALSE)) {
       cond[["call"]] <- NULL
     } else if (is.environment(cond[["call"]])) {

diff --git a/tests/testthat/_snaps/standalone-errors.md b/tests/testthat/_snaps/standalone-errors.md
@@ -1,4 +1,19 @@
-# can pass frame as error call
+# can pass frame as error call in `new_error()`
+
+    Code
+      (expect_error(f()))
+    Output
+      <rlib_error_3_0/rlib_error/error>
+      Error in `f()`:
+      ! my message
+    Code
+      (expect_error(g()))
+    Output
+      <rlib_error_3_0/rlib_error/error>
+      Error in `g()`:
+      ! my message
+
+# can pass frame as error call in `throw()`
 
     Code
       (expect_error(f()))

diff --git a/tests/testthat/test-standalone-errors.R b/tests/testthat/test-standalone-errors.R
@@ -351,7 +351,7 @@ test_that("trace is printed on error in non-interactive sessions", {
   expect_true(any(grepl("Backtrace", selines)))
 })
 
-test_that("can pass frame as error call", {
+test_that("can pass frame as error call in `new_error()`", {
   check_bar <- function(call = parent.frame()) {
     check_foo(call = call)
   }
@@ -366,3 +366,19 @@ test_that("can pass frame as error call", {
     (expect_error(g()))
   })
 })
+
+test_that("can pass frame as error call in `throw()`", {
+  check_bar <- function(call = parent.frame()) {
+    check_foo(call = call)
+  }
+  check_foo <- function(call = parent.frame()) {
+    throw(new_error("my message"), call = call)
+  }
+  f <- function() check_bar()
+  g <- function() check_foo()
+
+  expect_snapshot({
+    (expect_error(f()))
+    (expect_error(g()))
+  })
+})