Use testthat_print() instead of cnd_cat() for error snapshots

See r-lib/testthat#1200

Author: lionel-

R/aaa.R

@@ -0,0 +1,16 @@
+
+on_load <- function(expr, env = topenv(parent.frame())) {
+  callback <- function() eval_bare(expr, env)
+  env$.__rlang_hook__. <- c(env$.__rlang_hook__., list(callback))
+}
+
+run_on_load <- function(env = topenv(caller_env())) {
+  hook <- env$.__rlang_hook__.
+  env_unbind(env, ".__rlang_hook__.")
+
+  for (callback in hook) {
+    callback()
+  }
+
+  env$.__rlang_hook__. <- NULL
+}

R/cnd-error.R

@@ -34,7 +34,7 @@ print.rlang_error <- function(x,
                               simplify = c("branch", "collapse", "none"),
                               fields = FALSE) {
   simplify <- arg_match(simplify)
-  cat_line(format(x, simplify = simplify, fields = fields))
+  cat_line(format(x, simplify = simplify, fields = fields, ...))
   invisible(x)
 }
 
@@ -45,6 +45,7 @@ is_rlang_error <- function(x) {
 #' @export
 format.rlang_error <- function(x,
                                ...,
+                               backtrace = TRUE,
                                child = NULL,
                                simplify = c("branch", "collapse", "none"),
                                fields = FALSE) {
@@ -109,7 +110,7 @@ format.rlang_error <- function(x,
 
   simplify <- arg_match(simplify)
 
-  if (!is_null(trace) && trace_length(trace)) {
+  if (backtrace && !is_null(trace) && trace_length(trace)) {
     out <- paste_line(out, bold("Backtrace:"))
     trace_lines <- format(trace, ..., simplify = simplify)
     out <- paste_line(out, trace_lines)
@@ -188,3 +189,7 @@ rlang_error_header <- function(cnd, child = NULL) {
     bold(sprintf("<parent: %s>", class))
   }
 }
+
+on_load(s3_register("testthat::testthat_print", "rlang_error", function(x) {
+  print(x, backtrace = FALSE)
+}))

R/rlang.R

@@ -28,6 +28,8 @@ base_pkg_env <- NULL
   .Call(r_init_library)
   .Call(rlang_library_load, ns_env("rlang"))
 
+  run_on_load()
+
   s3_register("pillar::pillar_shaft", "quosures", pillar_shaft.quosures)
   s3_register("pillar::type_sum", "quosures", type_sum.quosures)
 

tests/testthat/_snaps/arg.md

@@ -1,38 +1,45 @@
 # `arg_match()` has informative error messages
 
     Code
-      cnd_cat(expect_error(arg_match0("continuuos", c("discrete", "continuous"))))
+      (expect_error(arg_match0("continuuos", c("discrete", "continuous"))))
     Output
+      <error/rlang_error>
       `"continuuos"` must be one of "discrete" or "continuous".
       Did you mean "continuous"?
     Code
-      cnd_cat(expect_error(arg_match0("fou", c("bar", "foo"))))
+      (expect_error(arg_match0("fou", c("bar", "foo"))))
     Output
+      <error/rlang_error>
       `"fou"` must be one of "bar" or "foo".
       Did you mean "foo"?
     Code
-      cnd_cat(expect_error(arg_match0("fu", c("ba", "fo"))))
+      (expect_error(arg_match0("fu", c("ba", "fo"))))
     Output
+      <error/rlang_error>
       `"fu"` must be one of "ba" or "fo".
       Did you mean "fo"?
     Code
-      cnd_cat(expect_error(arg_match0("baq", c("foo", "baz", "bas"), arg_nm = "arg")))
+      (expect_error(arg_match0("baq", c("foo", "baz", "bas"), arg_nm = "arg")))
     Output
+      <error/rlang_error>
       `arg` must be one of "foo", "baz", or "bas".
       Did you mean "baz"?
     Code
-      cnd_cat(expect_error(arg_match0("", character())))
+      (expect_error(arg_match0("", character())))
     Output
+      <error/rlang_error>
       `values` must have at least one element.
 
 # `arg_match()` provides no suggestion when the edit distance is too large
 
     Code
-      cnd_cat(expect_error(arg_match0("foobaz", c("fooquxs", "discrete"))))
+      (expect_error(arg_match0("foobaz", c("fooquxs", "discrete"))))
     Output
+      <error/rlang_error>
       `"foobaz"` must be one of "fooquxs" or "discrete".
     Code
-      cnd_cat(expect_error(arg_match0("a", c("b", "c"))))
+      (expect_error(arg_match0("a", c("b", "c"))))
     Output
+      <error/rlang_error>
       `"a"` must be one of "b" or "c".
 

tests/testthat/_snaps/operators.md

@@ -1,34 +1,41 @@
 # %|% fails with wrong types
 
     Code
-      cnd_cat(expect_error(c(1L, NA) %|% 2))
+      (expect_error(c(1L, NA) %|% 2))
     Output
+      <error/rlang_error>
       Replacement values must have type integer, not type double
     Code
-      cnd_cat(expect_error(c(1, NA) %|% ""))
+      (expect_error(c(1, NA) %|% ""))
     Output
+      <error/rlang_error>
       Replacement values must have type double, not type character
     Code
-      cnd_cat(expect_error(c(1, NA) %|% call("fn")))
+      (expect_error(c(1, NA) %|% call("fn")))
     Output
+      <error/rlang_error>
       Replacement values must have type double, not type language
     Code
-      cnd_cat(expect_error(call("fn") %|% 1))
+      (expect_error(call("fn") %|% 1))
     Output
+      <error/rlang_error>
       Cannot replace missing values in an object of type language
 
 # %|% fails with wrong length
 
     Code
-      cnd_cat(expect_error(c(1L, NA) %|% 1:3))
+      (expect_error(c(1L, NA) %|% 1:3))
     Output
+      <error/rlang_error>
       The replacement values must have size 1 or 2, not 3
     Code
-      cnd_cat(expect_error(1:10 %|% 1:4))
+      (expect_error(1:10 %|% 1:4))
     Output
+      <error/rlang_error>
       The replacement values must have size 1 or 10, not 4
     Code
-      cnd_cat(expect_error(1L %|% 1:4))
+      (expect_error(1L %|% 1:4))
     Output
+      <error/rlang_error>
       The replacement values must have size 1, not 4
 

tests/testthat/test-arg.R

@@ -52,18 +52,18 @@ test_that("informative error message on partial match", {
 
 test_that("`arg_match()` has informative error messages", {
   expect_snapshot({
-    cnd_cat(expect_error(arg_match0("continuuos", c("discrete", "continuous"))))
-    cnd_cat(expect_error(arg_match0("fou", c("bar", "foo"))))
-    cnd_cat(expect_error(arg_match0("fu", c("ba", "fo"))))
-    cnd_cat(expect_error(arg_match0("baq", c("foo", "baz", "bas"), arg_nm = "arg")))
-    cnd_cat(expect_error(arg_match0("", character())))
+    (expect_error(arg_match0("continuuos", c("discrete", "continuous"))))
+    (expect_error(arg_match0("fou", c("bar", "foo"))))
+    (expect_error(arg_match0("fu", c("ba", "fo"))))
+    (expect_error(arg_match0("baq", c("foo", "baz", "bas"), arg_nm = "arg")))
+    (expect_error(arg_match0("", character())))
   })
 })
 
 test_that("`arg_match()` provides no suggestion when the edit distance is too large", {
   expect_snapshot({
-    cnd_cat(expect_error(arg_match0("foobaz", c("fooquxs", "discrete"))))
-    cnd_cat(expect_error(arg_match0("a", c("b", "c"))))
+    (expect_error(arg_match0("foobaz", c("fooquxs", "discrete"))))
+    (expect_error(arg_match0("a", c("b", "c"))))
   })
 })
 

tests/testthat/test-operators.R

@@ -34,18 +34,18 @@ test_that("%|% also works when y is of same length as x", {
 
 test_that("%|% fails with wrong types", {
   expect_snapshot({
-    cnd_cat(expect_error(c(1L, NA) %|% 2))
-    cnd_cat(expect_error(c(1, NA) %|% ""))
-    cnd_cat(expect_error(c(1, NA) %|% call("fn")))
-    cnd_cat(expect_error(call("fn") %|% 1))
+    (expect_error(c(1L, NA) %|% 2))
+    (expect_error(c(1, NA) %|% ""))
+    (expect_error(c(1, NA) %|% call("fn")))
+    (expect_error(call("fn") %|% 1))
   })
 })
 
 test_that("%|% fails with wrong length", {
   expect_snapshot({
-    cnd_cat(expect_error(c(1L, NA) %|% 1:3))
-    cnd_cat(expect_error(1:10 %|% 1:4))
-    cnd_cat(expect_error(1L %|% 1:4))
+    (expect_error(c(1L, NA) %|% 1:3))
+    (expect_error(1:10 %|% 1:4))
+    (expect_error(1L %|% 1:4))
   })
 })