Implement expect_mapequal()

Fixes #863

NAMESPACE

@@ -78,6 +78,7 @@ export(expect_length)
 export(expect_less_than)
 export(expect_lt)
 export(expect_lte)
+export(expect_mapequal)
 export(expect_match)
 export(expect_message)
 export(expect_more_than)

NEWS.md

@@ -5,6 +5,10 @@
 * New `expect_visible()` and `expect_invisible()` make it easier to check if
   a function call returns its result visibly or invisibly (#719).
 
+* New `expect_mapequal(x, y)` checks that `x` and `y` have the same names,
+  and the same value associated with each name (i.e. they compare the values
+  of the vector standardising the order of the names) (#863).
+
 * New `expect_vector()` is a wrapper around `vctrs::vec_assert()` making it
   easy to test against the vctrs definitions of prototype and size (#846).
   (Currently requires development version of vctrs.)

R/expect-setequal.R

@@ -1,16 +1,24 @@
 #' Expectation: do two vectors contain the same values?
 #'
-#' `expect_setequal(x, y)` tests that every element of `x` occurs in `y`,
-#' and that every element of `y` occurs in `x`. Note that this definition
-#' ignores names, and you will be warned if both `object` and `expected` have
-#' names.
+#' * `expect_setequal(x, y)` tests that every element of `x` occurs in `y`,
+#'    and that every element of `y` occurs in `x`.
+#' * `expect_mapequal(x, y)` tests that `x` and `y` have the same names, and
+#'    that `x[names(y)]` equals `x`.
+#'
+#' Note that `expect_setequal()` ignores names, and you will be warned if both
+#' `object` and `expected` have them.
 #'
 #' @inheritParams expect_equal
 #' @export
-#' @rdname equality-expectations
 #' @examples
 #' expect_setequal(letters, rev(letters))
 #' show_failure(expect_setequal(letters[-1], rev(letters)))
+#'
+#' x <- list(b = 2, a = 1)
+#' expect_mapequal(x, list(a = 1, b = 2))
+#' show_failure(expect_mapequal(x, list(a = 1)))
+#' show_failure(expect_mapequal(x, list(a = 1, b = "x")))
+#' show_failure(expect_mapequal(x, list(a = 1, b = 2, c = 3)))
 expect_setequal <- function(object, expected) {
   act <- quasi_label(enquo(object), arg = "object")
   exp <- quasi_label(enquo(expected), arg = "expected")
@@ -59,3 +67,35 @@ locations <- function(i) {
   paste0("c(", paste0(loc, collapse = ", "), ")")
 }
 
+
+#' @export
+#' @rdname expect_setequal
+expect_mapequal <- function(object, expected) {
+  act <- quasi_label(enquo(object), arg = "object")
+  exp <- quasi_label(enquo(expected), arg = "expected")
+
+  if (!is_vector(act$val) || !is_vector(exp$val)) {
+    abort("`object` and `expected` must both be vectors")
+  }
+
+  act_nms <- names(act$val)
+  exp_nms <- names(exp$val)
+
+  if (!setequal(act_nms, exp_nms)) {
+    act_miss <- setdiff(exp_nms, act_nms)
+    if (length(act_miss) > 0) {
+      vals <- paste0(encodeString(act_miss, quote = '"'), ", ")
+      fail(paste0("Names absent from `object`: ", vals))
+    }
+
+    exp_miss <- setdiff(act_nms, exp_nms)
+    if (length(exp_miss) > 0) {
+      vals <- paste0(encodeString(exp_miss, quote = '"'), ", ")
+      fail(paste0("Names absent from `expected`: ", vals))
+    }
+  } else {
+    expect_equal(act$val[exp_nms], exp$val)
+  }
+
+  invisible(act$val)
+}

tests/testthat/test-expect-setequal.R

@@ -1,3 +1,5 @@
+# setequal ----------------------------------------------------------------
+
 test_that("ignores order and duplicates", {
   expect_success(expect_setequal(letters, rev(letters)))
   expect_success(expect_setequal(c("a", "a", "b"), c("b", "b", "a")))
@@ -21,3 +23,21 @@ test_that("error for non-vectors", {
   expect_error(expect_setequal(sum, sum), "be vectors")
 })
 
+# mapequal ----------------------------------------------------------------
+
+test_that("ignores order", {
+  expect_success(expect_mapequal(list(a = 1, b = 2), list(b = 2, 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("fails if values don't match", {
+  expect_failure(expect_mapequal(list(a = 1, b = 2), list(a = 1, b = 3)))
+})
+
+test_that("error for non-vectors", {
+  expect_error(expect_mapequal(sum, sum), "be vectors")
+})