Improve expect_setequal() feedback (#1745)

Fixes #1657

Author: hadley

NEWS.md

@@ -1,5 +1,7 @@
 # testthat (development version)
 
+* `expect_setequal()` gives more actionable feedback (#1657).
+
 * `expect_snapshot()` no longer elides new lines when run interactively (#1726).
 
 * Experimental new `with_mocked_bindings()` and `local_mocked_bindings()` 

R/expect-setequal.R

@@ -32,41 +32,40 @@ expect_setequal <- function(object, expected) {
   }
 
   act_miss <- !act$val %in% exp$val
-  if (any(act_miss)) {
-    fail(
-      paste0(act$lab, "[", locations(act_miss), "] absent from ", exp$lab)
-    )
-  }
-
   exp_miss <- !exp$val %in% act$val
-  if (any(exp_miss)) {
-    fail(
-      paste0(exp$lab, "[", locations(exp_miss), "] absent from ", act$lab)
-    )
-  }
 
-  if (!any(exp_miss) && !any(act_miss)) {
+  if (any(exp_miss) || any(act_miss)) {
+    fail(paste0(
+      act$lab, " (`actual`) and ", exp$lab, " (`expected`) don't have the same values.\n",
+      if (any(exp_miss))
+        paste0("* Only in `actual`:   ",  values(act$val[act_miss]), "\n"),
+      if (any(act_miss))
+        paste0("* Only in `expected`: ",  values(exp$val[exp_miss]), "\n")
+    ))
+  } else {
     succeed()
   }
 
   invisible(act$val)
 }
 
-is_vector <- function(x) is.list(x) || (is.atomic(x) && !is.null(x))
-
-locations <- function(i) {
-  loc <- which(i)
-  if (length(loc) == 1) {
-    return(loc)
+values <- function(x) {
+  has_extra <- length(x) > 10
+  if (has_extra) {
+    x <- x[1:9]
   }
-
-  if (length(loc) > 10) {
-    loc <- c(loc[1:9], "...")
+  if (is.character(x)) {
+    x <- encodeString(x, quote = '"')
   }
 
-  paste0("c(", paste0(loc, collapse = ", "), ")")
+  out <- paste0(x, collapse = ", ")
+  if (has_extra) {
+    out <- paste0(out, ", ...")
+  }
+  out
 }
 
+is_vector <- function(x) is.list(x) || (is.atomic(x) && !is.null(x))
 
 #' @export
 #' @rdname expect_setequal

tests/testthat/_snaps/expect-setequal.md

@@ -0,0 +1,14 @@
+# useful message on faillure
+
+    `x1` (`actual`) and `x2` (`expected`) don't have the same values.
+    * Only in `actual`:   "a"
+    * Only in `expected`: "c"
+    
+
+---
+
+    `y1` (`actual`) and `y2` (`expected`) don't have the same values.
+    * Only in `actual`:   1
+    * Only in `expected`: 4, 5, 6, 7, 8, 9, 10, 11, 12, ...
+    
+

tests/testthat/test-expect-setequal.R

@@ -23,6 +23,16 @@ test_that("error for non-vectors", {
   expect_error(expect_setequal(sum, sum), "be vectors")
 })
 
+test_that("useful message on faillure", {
+  x1 <- c("a", "b")
+  x2 <- c("b", "c")
+  y1 <- 1:3
+  y2 <- 2:50
+
+  expect_snapshot_failure(expect_setequal(x1, x2))
+  expect_snapshot_failure(expect_setequal(y1, y2))
+})
+
 # mapequal ----------------------------------------------------------------
 
 test_that("ignores order", {