Merged origin/main into snap-test-path

Author: hadley

CLAUDE.md

@@ -12,18 +12,23 @@ General advice:
 * When running R from the console, always run it with `--quiet --vanilla`
 * Always run `air format .` after generating code
 
-### Development tools
+### Testing
 
-- `devtools::test()` - Run all tests
-- `devtools::test_file("tests/testthat/test-filename.R")` - Run tests in a specific file
+- Use `devtools::test()` to run all tests
+- Use `devtools::test_file("tests/testthat/test-filename.R")` to run tests in a specific file
 - DO NOT USE `devtools::test_active_file()`
-- `devtools::load_all()` - Load package for development
-- `devtools::check()` - Run R CMD check
-- `devtools::install()` - Install package locally
+- All testing functions automatically load code; you don't needs to.
+
+- All new code should have an accompanying test.
+- Tests for `R/{name}.R` go in `tests/testthat/test-{name}.R`. 
+- If there are existing tests, place new tests next to similar existing tests.
 
 ### Documentation
 
 - Always run `devtools::document()` after changing any roxygen2 docs.
+- Every user facing function should be exported and have roxygen2 documentation.
+- Whenever you add a new documentation file, make sure to also add the topic name to `_pkgdown.yml`. 
+- Run `pkgdown::check_pkgdown()` to check that all topics are included in the reference index.
 
 ## Core Architecture
 

NEWS.md

@@ -1,5 +1,9 @@
 # testthat (development version)
 
+* `expect_snapshot_file()` now considers `.json` to be a text file (#1593).
+* `expect_snapshot_file()` now shows differences for text files (#1593).
+* The failure messages for all `expect_` functions have been rewritten to first state what was expected and then what was actually received (#2142).
+* `test_file(desc = ...)` no longer loses snapshot results (#2066).
 * In `R CMD check`, snapshots now only advise on how to resolve failures once (#2207).
 * `snapshot_review()` includes a reject button and only displays the file navigation and the skip button if there are multiple files to review (#2025).
 * New `snapshot_download_gh()` makes it easy to get snapshots off GitHub and into your local package (#1779).

R/expect-comparison.R

@@ -28,14 +28,7 @@ expect_compare_ <- function(
   operator <- match.arg(operator)
   op <- match.fun(operator)
 
-  msg <- c(
-    "<" = "not strictly less than",
-    "<=" = "not less than",
-    ">" = "not strictly greater than",
-    ">=" = "not greater than"
-  )[[operator]]
-
-  negated_op <- switch(operator, "<" = ">=", "<=" = ">", ">" = "<=", ">=" = "<")
+  actual_op <- switch(operator, "<" = ">=", "<=" = ">", ">" = "<=", ">=" = "<")
 
   cmp <- op(act$val, exp$val)
   if (length(cmp) != 1 || !is.logical(cmp)) {
@@ -45,22 +38,32 @@ expect_compare_ <- function(
     )
   }
   if (!isTRUE(cmp)) {
+    diff <- act$val - exp$val
+    msg_exp <- sprintf("Expected %s %s %s.", act$lab, operator, exp$lab)
+
     digits <- max(
       digits(act$val),
       digits(exp$val),
       min_digits(act$val, exp$val)
     )
-    msg <- sprintf(
-      "%s is %s %s.\n%s - %s = %s %s 0",
-      act$lab,
-      msg,
-      exp$lab,
+
+    msg_act <- sprintf(
+      "Actual comparison: %s %s %s",
       num_exact(act$val, digits),
-      num_exact(exp$val, digits),
-      num_exact(act$val - exp$val, digits),
-      negated_op
+      actual_op,
+      num_exact(exp$val, digits)
     )
-    return(fail(msg, trace_env = trace_env))
+
+    if (is.na(diff)) {
+      msg_diff <- NULL
+    } else {
+      msg_diff <- sprintf(
+        "Difference: %s %s 0",
+        num_exact(diff, digits),
+        actual_op
+      )
+    }
+    return(fail(c(msg_exp, msg_act, msg_diff), trace_env = trace_env))
   }
   pass(act$val)
 }

R/expect-condition.R

@@ -440,10 +440,10 @@ compare_condition_3e <- function(cond_type, cond_class, cond, lab, expected) {
   if (expected) {
     if (is.null(cond)) {
       if (is.null(cond_class)) {
-        sprintf("%s did not throw the expected %s.", lab, cond_type)
+        sprintf("Expected %s to throw a %s.", lab, cond_type)
       } else {
         sprintf(
-          "%s did not throw a %s with class <%s>.",
+          "Expected %s to throw a %s with class <%s>.",
           lab,
           cond_type,
           cond_class
@@ -454,12 +454,9 @@ compare_condition_3e <- function(cond_type, cond_class, cond, lab, expected) {
     }
   } else {
     if (!is.null(cond)) {
-      sprintf(
-        "%s threw an unexpected %s.\nMessage: %s\nClass:   %s",
-        lab,
-        cond_type,
-        cnd_message(cond),
-        paste(class(cond), collapse = "/")
+      c(
+        sprintf("Expected %s not to throw any %ss.", lab, cond_type),
+        actual_condition(cond)
       )
     } else {
       NULL
@@ -493,7 +490,7 @@ compare_condition_2e <- function(
 
   # Otherwise we're definitely expecting a condition
   if (is.null(cond)) {
-    return(sprintf("%s did not throw an %s.", lab, cond_type))
+    return(sprintf("Expected %s to throw a %s.", lab, cond_type))
   }
 
   matches <- cnd_matches_2e(cond, class, regexp, inherit, ...)
@@ -562,15 +559,20 @@ compare_messages <- function(
   # Expecting no messages
   if (identical(regexp, NA)) {
     if (length(messages) > 0) {
-      return(sprintf("%s generated %s:\n%s", lab, cond_type, bullets))
+      return(sprintf(
+        "Expected %s not to generate %s.\nActually generated:\n%s",
+        lab,
+        cond_type,
+        bullets
+      ))
     } else {
       return()
     }
   }
 
   # Otherwise we're definitely expecting messages
   if (length(messages) == 0) {
-    return(sprintf("%s did not produce any %s.", lab, cond_type))
+    return(sprintf("Expected %s to produce %s.", lab, cond_type))
   }
 
   if (is.null(regexp)) {
@@ -625,3 +627,12 @@ check_condition_dots <- function(
     call = error_call
   )
 }
+
+actual_condition <- function(cond) {
+  paste0(
+    "Actually got a <",
+    class(cond)[[1]],
+    "> with message:\n",
+    indent_lines(cnd_message(cond))
+  )
+}

R/expect-constant.R

@@ -31,15 +31,15 @@ NULL
 expect_true <- function(object, info = NULL, label = NULL) {
   act <- quasi_label(enquo(object), label)
   exp <- labelled_value(TRUE, "TRUE")
-  expect_waldo_equal_("equal", act, exp, info = info, ignore_attr = TRUE)
+  expect_waldo_constant_(act, exp, info = info, ignore_attr = TRUE)
 }
 
 #' @export
 #' @rdname logical-expectations
 expect_false <- function(object, info = NULL, label = NULL) {
   act <- quasi_label(enquo(object), label)
   exp <- labelled_value(FALSE, "FALSE")
-  expect_waldo_equal_("equal", act, exp, info = info, ignore_attr = TRUE)
+  expect_waldo_constant_(act, exp, info = info, ignore_attr = TRUE)
 }
 
 #' Do you expect `NULL`?
@@ -58,6 +58,31 @@ expect_false <- function(object, info = NULL, label = NULL) {
 #' show_failure(expect_null(y))
 expect_null <- function(object, info = NULL, label = NULL) {
   act <- quasi_label(enquo(object), label)
-  exp <- labelled_value(NULL, "FALSE")
-  expect_waldo_equal_("equal", act, exp, info = info)
+  exp <- labelled_value(NULL, "NULL")
+  expect_waldo_constant_(act, exp, info = info)
+}
+
+expect_waldo_constant_ <- function(
+  act,
+  exp,
+  ...,
+  info = NULL,
+  trace_env = caller_env()
+) {
+  comp <- waldo_compare(
+    act$val,
+    exp$val,
+    ...,
+    x_arg = "actual",
+    y_arg = "expected"
+  )
+  if (length(comp) != 0) {
+    msg <- c(
+      sprintf("Expected %s to be %s.", act$lab, exp$lab),
+      "Differences:",
+      paste0(comp, collpase = "\n")
+    )
+    return(fail(msg, info = info, trace_env = trace_env))
+  }
+  pass(act$val)
 }

R/expect-equality.R

@@ -77,13 +77,18 @@ expect_equal <- function(
     }
 
     if (!comp$equal) {
-      msg <- sprintf("%s not equal to %s.\n%s", act$lab, exp$lab, comp$message)
+      msg <- c(
+        sprintf("Expected %s to equal %s.", act$lab, exp$lab),
+        "Differences:",
+        comp$message
+      )
       return(fail(msg, info = info))
     }
     pass(act$val)
   }
 }
 
+
 #' @export
 #' @rdname equality-expectations
 expect_identical <- function(
@@ -102,18 +107,22 @@ expect_identical <- function(
   } else {
     ident <- identical(act$val, exp$val, ...)
     if (ident) {
-      msg <- ""
+      msg_act <- NULL
     } else {
       compare <- compare(act$val, exp$val)
       if (compare$equal) {
-        msg <- "Objects equal but not identical"
+        msg_act <- "Objects equal but not identical"
       } else {
-        msg <- compare$message
+        msg_act <- compare$message
       }
     }
 
     if (!ident) {
-      msg <- sprintf("%s not identical to %s.\n%s", act$lab, exp$lab, msg)
+      msg <- c(
+        sprintf("Expected %s to be identical to %s.", act$lab, exp$lab),
+        "Differences:",
+        msg_act
+      )
       return(fail(msg, info = info))
     }
     pass(act$val)
@@ -126,8 +135,7 @@ expect_waldo_equal_ <- function(
   exp,
   info = NULL,
   ...,
-  trace_env = caller_env(),
-  error_prefix = NULL
+  trace_env = caller_env()
 ) {
   comp <- waldo_compare(
     act$val,
@@ -137,16 +145,11 @@ expect_waldo_equal_ <- function(
     y_arg = "expected"
   )
   if (length(comp) != 0) {
-    msg <- sprintf(
-      "%s (%s) is not %s to %s (%s).\n\n%s",
-      act$lab,
-      "`actual`",
-      type,
-      exp$lab,
-      "`expected`",
-      paste0(comp, collapse = "\n\n")
+    msg <- c(
+      sprintf("Expected %s to be %s to %s.", act$lab, type, exp$lab),
+      "Differences:",
+      paste0(comp, collpase = "\n")
     )
-    msg <- paste0(error_prefix, msg)
     return(fail(msg, info = info, trace_env = trace_env))
   }
   pass(act$val)
@@ -195,7 +198,7 @@ expect_equivalent <- function(
   comp <- compare(act$val, exp$val, ..., check.attributes = FALSE)
   if (!comp$equal) {
     msg <- sprintf(
-      "%s not equivalent to %s.\n%s",
+      "Expected %s to be equivalent to %s.\n%s",
       act$lab,
       exp$lab,
       comp$message