Implement expect_contains() and expect_in() (#1817)

Fixes #1346

Author: hadley

NAMESPACE

@@ -79,6 +79,7 @@ export(evaluate_promise)
 export(exp_signal)
 export(expect)
 export(expect_condition)
+export(expect_contains)
 export(expect_cpp_tests_pass)
 export(expect_equal)
 export(expect_equal_to_reference)
@@ -89,6 +90,7 @@ export(expect_false)
 export(expect_gt)
 export(expect_gte)
 export(expect_identical)
+export(expect_in)
 export(expect_invisible)
 export(expect_is)
 export(expect_known_hash)

NEWS.md

@@ -1,5 +1,10 @@
 # testthat (development version)
 
+* New `expect_contains()` and `expect_in()` that works similarly to 
+  `expect_true(all(expected %in% object))` or 
+  `expect_true(all(object %in% expected))` but give more informative failure
+  messages (#1346).
+
 * Skips are now only shown at the end of reporter summaries, not as tests are 
   run. This makes them less intrusive in interactive tests while still allowing
   you to verify that the correct tests are skipped (#1801).

R/expect-setequal.R

@@ -2,6 +2,10 @@
 #'
 #' * `expect_setequal(x, y)` tests that every element of `x` occurs in `y`,
 #'    and that every element of `y` occurs in `x`.
+#' * `expect_contains(x, y)` tests that `x` contains every element of `y`
+#'   (i.e. `y` is a subset of `x`).
+#' * `expect_in(x, y)` tests every element of `x` is in `y`
+#'   (i.e. `x` is a subset of `y`).
 #' * `expect_mapequal(x, y)` tests that `x` and `y` have the same names, and
 #'    that `x[names(y)]` equals `y`.
 #'
@@ -117,3 +121,53 @@ check_names_ok <- function(x, label) {
     stop("All elements in `", label, "` must be named")
   }
 }
+
+#' @export
+#' @rdname expect_setequal
+expect_contains <- 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")
+  }
+
+  exp_miss <- !exp$val %in% act$val
+
+  if (any(exp_miss)) {
+    fail(paste0(
+      act$lab, " (`actual`) doesn't fully contain all the values in ", exp$lab, " (`expected`).\n",
+      paste0("* Missing from `actual`: ",  values(exp$val[exp_miss]), "\n"),
+      paste0("* Present in `actual`:   ",  values(act$val), "\n")
+    ))
+  } else {
+    succeed()
+  }
+
+  invisible(act$val)
+}
+
+#' @export
+#' @rdname expect_setequal
+expect_in <- 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_miss <- !act$val %in% exp$val
+
+  if (any(act_miss)) {
+    fail(paste0(
+      act$lab, " (`actual`) isn't fully contained within ", exp$lab, " (`expected`).\n",
+      paste0("* Missing from `expected`: ",  values(act$val[act_miss]), "\n"),
+      paste0("* Present in `expected`:   ",  values(exp$val), "\n")
+    ))
+  } else {
+    succeed()
+  }
+
+  invisible(act$val)
+}

man/expect_setequal.Rd

@@ -12,3 +12,31 @@
     * Only in `expected`: 4, 5, 6, 7, 8, 9, 10, 11, 12, ...
 
 
+# expect_contains() gives useful message on failure
+
+    `x1` (`actual`) doesn't fully contain all the values in `x2` (`expected`).
+    * Missing from `actual`: "d"
+    * Present in `actual`:   "a", "b", "c"
+    
+
+---
+
+    `x1` (`actual`) doesn't fully contain all the values in `x3` (`expected`).
+    * Missing from `actual`: "d", "e"
+    * Present in `actual`:   "a", "b", "c"
+    
+
+# expect_in() gives useful message on failure
+
+    `x1` (`actual`) isn't fully contained within `x2` (`expected`).
+    * Missing from `expected`: "a"
+    * Present in `expected`:   "b", "c"
+    
+
+---
+
+    `x1` (`actual`) isn't fully contained within `x3` (`expected`).
+    * Missing from `expected`: "a", "b"
+    * Present in `expected`:   "d", "e"
+    
+

tests/testthat/_snaps/expect-setequal.md

@@ -77,3 +77,39 @@ test_that("succeeds if comparing empty named and unnamed vectors", {
   expect_warning(expect_success(expect_mapequal(x2, x1)))
   expect_warning(expect_success(expect_mapequal(x2, x2)))
 })
+
+# contains ----------------------------------------------------------------
+
+test_that("expect_contains() succeeds when appropriate", {
+  expect_success(expect_contains(letters, "a"))
+  expect_success(expect_contains(letters, letters))
+  expect_success(expect_contains(letters, character()))
+})
+
+test_that("expect_contains() gives useful message on failure", {
+  x1 <- c("a", "b", "c")
+  x2 <- c("c", "d")
+  x3 <- c("d", "e")
+
+  expect_snapshot_failure(expect_contains(x1, x2))
+  expect_snapshot_failure(expect_contains(x1, x3))
+})
+
+
+# in ----------------------------------------------------------------
+
+test_that("expect_in() succeeds when appropriate", {
+  expect_success(expect_in("a", letters))
+  expect_success(expect_in(letters, letters))
+  expect_success(expect_in(character(), letters))
+})
+
+test_that("expect_in() gives useful message on failure", {
+  x1 <- c("a", "b")
+  x2 <- c("b", "c")
+  x3 <- c("d", "e")
+
+  expect_snapshot_failure(expect_in(x1, x2))
+  expect_snapshot_failure(expect_in(x1, x3))
+})
+