Print class of uncaught errors (#1439)

Fixes #1426

Author: hadley

NEWS.md

@@ -1,5 +1,7 @@
 # testthat (development version)
 
+* Uncaught errors now show their class (#1426).
+
 * `local_reproducible_output()` now sets the `max.print` option to 99999 
   (the default), so your tests are unaffected by any changes you might've
   made in your `.Rprofile` (1367).

R/expectation.R

@@ -192,15 +192,25 @@ as.expectation.expectation <- function(x, srcref = NULL) {
 
 #' @export
 as.expectation.error <- function(x, srcref = NULL) {
+
   if (is.null(x$call)) {
-    msg <- paste0("Error: ", cnd_message(x))
+    header <- paste0("Error: ")
   } else {
-    msg <- paste0("Error in `", as_label(x$call[1]), "`: ", cnd_message(x))
+    header <- paste0("Error in `", as_label(x$call[1]), "`: ")
   }
 
+  msg <- paste0(
+    if (!is_simple_error(x)) paste0("<", paste(class(x), collapse = "/"), ">\n"),
+    header, cnd_message(x)
+  )
+
   expectation("error", msg, srcref, trace = x[["trace"]])
 }
 
+is_simple_error <- function(x) {
+  class(x)[[1]] %in% c("simpleError", "rlang_error")
+}
+
 #' @export
 as.expectation.warning <- function(x, srcref = NULL) {
   expectation("warning", cnd_message(x), srcref, trace = x[["trace"]])

tests/testthat/_snaps/reporter-progress.md

@@ -203,6 +203,7 @@
      8. signaller() reporters/backtraces.R:32:7
 
     Error (backtraces.R:43:3): Errors are inspected with `conditionMessage()`
+    <foobar/rlang_error/error/condition>
     Error: dispatched
 
     Warning (backtraces.R:50:3): also get backtraces for warnings

tests/testthat/test-expectation.R

@@ -35,29 +35,14 @@ test_that("conditionMessage() is called during conversion", {
   expect_identical(as.expectation(wrn)$message, "dispatched")
 
   err <- error_cnd("foobar", message = "wrong")
-  expect_identical(as.expectation(err)$message, "Error: dispatched")
+  expect_match(as.expectation(err)$message, "Error: dispatched")
 
   err <- cnd(c("foobar", "skip"), message = "wrong")
   expect_identical(as.expectation(err)$message, "dispatched")
 })
 
 test_that("error message includes call", {
-
   f <- function() stop("Error!")
   cnd <- catch_cnd(f())
-  exp <- as.expectation(cnd)
-
-  local_bindings(
-    conditionMessage.foobar = function(...) "dispatched",
-    .env = global_env()
-  )
-
-  wrn <- warning_cnd("foobar", message = "wrong")
-  expect_identical(as.expectation(wrn)$message, "dispatched")
-
-  err <- error_cnd("foobar", message = "wrong")
-  expect_identical(as.expectation(err)$message, "Error: dispatched")
-
-  err <- cnd(c("foobar", "skip"), message = "wrong")
-  expect_identical(as.expectation(err)$message, "dispatched")
+  expect_equal(format(as.expectation(cnd)), "Error in `f()`: Error!")
 })