Revert expect_mapequal() changes

Reverts #2150 since it does actually break quite a few packages on CRAN. This change reverts the original behaviour (with more tests) making use of more new helpers.

Fixes #2245

Author: hadley

NEWS.md

@@ -28,7 +28,6 @@
 * Test filtering now works with `it()`, and the `desc` argument can take a character vector in order to recursively filter subtests (i.e. `it()` nested inside of `describe()`) (#2118).
 * New `snapshot_reject()` rejects all modified snapshots by deleting the `.new` variants (#1923).
 * New `SlowReporter` makes it easier to find the slowest tests in your package. The easiest way to run it is with `devtools::test(reporter = "slow")` (#1466).
-* Power `expect_mapequal()` with `waldo::compare(list_as_map = TRUE)` (#1521).
 * On CRAN, `test_that()` now automatically skips if a package is not installed (#1585). Practically, this means that you no longer need to check that suggested packages are installed. (We don't do this in the tidyverse because we think it has limited payoff, but other styles advise differently.)
 * `expect_snapshot()` no longer skips on CRAN, as that skips the rest of the test. Instead it just returns, neither succeeding nor failing (#1585).
 * Interrupting a test now prints the test name. This makes it easier to tell where a very slow test might be hanging (#1464).

R/expect-setequal.R

@@ -7,8 +7,8 @@
 #' * `expect_in(x, y)` tests every element of `x` is in `y`
 #'   (i.e. `x` is a subset of `y`).
 #' * `expect_mapequal(x, y)` treats lists as if they are mappings between names
-#'   and values. Concretely, this drops `NULL`s in both objects and sorts
-#'   named components.
+#'   and values. Concretely, checks that `x` and `y` have the same names, then
+#'   checks that `x[names(y)]` equals `y`.
 #'
 #' Note that `expect_setequal()` ignores names, and you will be warned if both
 #' `object` and `expected` have them.
@@ -89,7 +89,35 @@ expect_mapequal <- function(object, expected) {
   act <- quasi_label(enquo(object))
   exp <- quasi_label(enquo(expected))
 
-  expect_waldo_equal_("equal", act, exp, list_as_map = TRUE)
+  check_vector(act$val, error_arg = "object")
+  check_map_names(act$val, error_arg = "object")
+  check_vector(exp$val, error_arg = "expected")
+  check_map_names(exp$val, error_arg = "expected")
+
+  act_nms <- names(act$val)
+  exp_nms <- names(exp$val)
+
+  # Length-0 vectors are OK whether named or unnamed.
+  if (length(act$val) == 0 && length(exp$val) == 0) {
+    testthat_warn("`object` and `expected` are empty vectors.")
+    pass()
+  } else {
+    if (!setequal(act_nms, exp_nms)) {
+      act_names <- labelled_value(names(act$val), paste0("names of ", act$lab))
+      exp_names <- labelled_value(names(exp$val), paste0("names of ", exp$lab))
+      expect_setequal_(act_names, exp_names)
+    } else {
+      if (edition_get() >= 3) {
+        act <- labelled_value(act$val[exp_nms], act$lab)
+        expect_waldo_equal_("equal", act, exp)
+      } else {
+        # Packages depend on 2e behaviour, but the expectation isn't written
+        # to be reused, and we don't want to bother
+        expect_equal(act$val[exp_nms], exp$val)
+      }
+    }
+  }
+
   invisible(act$val)
 }
 
@@ -162,3 +190,27 @@ check_vector <- function(
     stop_input_type(x, "a vector", arg = error_arg, call = error_call)
   }
 }
+
+check_map_names <- function(x, error_arg, error_call = caller_env()) {
+  nms <- names2(x)
+  if (anyDuplicated(nms)) {
+    dups <- unique(nms[duplicated(nms)])
+    cli::cli_abort(
+      c(
+        "All elements in {.arg {error_arg}} must have unique names.",
+        x = "Duplicate names: {.str {dups}}"
+      ),
+      call = error_call
+    )
+  }
+  if (any(nms == "")) {
+    empty <- which(nms == "")
+    cli::cli_abort(
+      c(
+        "All elements in {.arg {error_arg}} must have names.",
+        x = "Empty names at position{?s}: {empty}"
+      ),
+      call = error_call
+    )
+  }
+}

tests/testthat/_snaps/expect-setequal.md

@@ -109,6 +109,84 @@
       Expected: 1, 2, 3, 4, 5, 6, 7, 8, 9, ...
       Absent: 3, 4, 5, 6, 7, 8, 9, 10, 11, ...
 
+# fails if names don't match
+
+    Code
+      expect_mapequal(x, y)
+    Condition
+      Error:
+      ! Expected names of `x` to have the same values as names of `y`.
+      Actual: "a", "b"
+      Expected: "a"
+      Needs: "b"
+
+---
+
+    Code
+      expect_mapequal(y, x)
+    Condition
+      Error:
+      ! Expected names of `y` to have the same values as names of `x`.
+      Actual: "a"
+      Expected: "a", "b"
+      Absent: "b"
+
+# fails if values don't match
+
+    Code
+      expect_mapequal(x, y)
+    Condition
+      Error:
+      ! Expected `x` to be equal to `y`.
+      Differences:
+        `actual$b`: 2.0
+      `expected$b`: 3.0
+
+# check inputs
+
+    Code
+      expect_mapequal(sum, named)
+    Condition
+      Error in `expect_mapequal()`:
+      ! `object` must be a vector, not a primitive function.
+    Code
+      expect_mapequal(named, sum)
+    Condition
+      Error in `expect_mapequal()`:
+      ! `expected` must be a vector, not a primitive function.
+    Code
+      expect_mapequal(unnamed, named)
+    Condition
+      Error in `expect_mapequal()`:
+      ! All elements in `object` must have names.
+      x Empty names at position: 1
+    Code
+      expect_mapequal(named, unnamed)
+    Condition
+      Error in `expect_mapequal()`:
+      ! All elements in `expected` must have names.
+      x Empty names at position: 1
+    Code
+      expect_mapequal(named, duplicated)
+    Condition
+      Error in `expect_mapequal()`:
+      ! All elements in `expected` must have unique names.
+      x Duplicate names: "x"
+    Code
+      expect_mapequal(duplicated, named)
+    Condition
+      Error in `expect_mapequal()`:
+      ! All elements in `object` must have unique names.
+      x Duplicate names: "x"
+
+# warns if empty vector
+
+    Code
+      expect_success(expect_mapequal(list(), list()))
+    Condition
+      Warning:
+      `object` and `expected` are empty vectors.
+
 # expect_contains() gives useful message on failure
 
     Code

tests/testthat/test-expect-setequal.R

@@ -70,51 +70,50 @@ test_that("truncates long vectors", {
 
 test_that("ignores order", {
   expect_success(expect_mapequal(list(a = 1, b = 2), list(b = 2, a = 1)))
+  expect_success(expect_mapequal(c(a = 1, b = 2), c(b = 2, a = 1)))
 })
 
-test_that("ignores order recursively", {
-  x <- list(outer_1 = 1, outer_2 = list(inner_1 = 1, inner_2 = 2))
-  y <- list(outer_2 = list(inner_2 = 2, inner_1 = 1), outer_1 = 1)
-  expect_success(expect_mapequal(x, y))
+test_that("fails if names don't match", {
+  x <- list(a = 1, b = 2)
+  y <- list(a = 1)
+  expect_snapshot_failure(expect_mapequal(x, y))
+  expect_snapshot_failure(expect_mapequal(y, x))
 })
 
-test_that("fails when any names are duplicated", {
-  expect_failure(expect_mapequal(
-    list(a = 1, b = 2, b = 3),
-    list(b = 2, a = 1)
-  ))
-  expect_failure(expect_mapequal(
-    list(a = 1, b = 2),
-    list(b = 3, b = 2, a = 1)
-  ))
-  expect_failure(expect_mapequal(
-    list(a = 1, b = 2, b = 3),
-    list(b = 3, b = 2, a = 1)
-  ))
+test_that("fails if values don't match", {
+  x <- list(a = 1, b = 2)
+  y <- list(a = 1, b = 3)
+  expect_snapshot_failure(expect_mapequal(x, y))
 })
 
-test_that("handling NULLs", {
+test_that("NULLs are not dropped", {
   expect_success(expect_mapequal(list(a = 1, b = NULL), list(b = NULL, a = 1)))
 })
 
-test_that("fail if names don't match", {
-  expect_failure(expect_mapequal(list(a = 1, b = 2), list(a = 1)))
-  expect_failure(expect_mapequal(list(a = 1), list(a = 1, b = 2)))
+test_that("warns if empty vector", {
+  expect_snapshot(expect_success(expect_mapequal(list(), list())))
 })
 
-test_that("fails if values don't match", {
-  expect_failure(expect_mapequal(
-    list(a = 1, b = 2),
-    list(a = 1, b = 3)
-  ))
-})
-
-test_that("fails if unnamed values in different location if any unnamed values", {
-  expect_success(expect_mapequal(list(1, b = 2, c = 3), list(1, c = 3, b = 2)))
-  expect_failure(expect_mapequal(
-    list(1, b = 2, c = 3),
-    list(b = 2, 1, c = 3)
-  ))
+test_that("uses equality behaviour of current edition", {
+  local_edition(2)
+  expect_success(expect_mapequal(c(a = 1), c(a = 1L)))
+})
+
+test_that("validates its inputs", {
+  unnamed <- list(1)
+  named <- list(a = 1)
+  duplicated <- list(x = 1, x = 2)
+
+  expect_snapshot(error = TRUE, {
+    expect_mapequal(sum, named)
+    expect_mapequal(named, sum)
+
+    expect_mapequal(unnamed, named)
+    expect_mapequal(named, unnamed)
+
+    expect_mapequal(named, duplicated)
+    expect_mapequal(duplicated, named)
+  })
 })
 
 # contains ----------------------------------------------------------------