Implement expect_disjoint()

NAMESPACE

@@ -82,6 +82,7 @@ export(expect)
 export(expect_condition)
 export(expect_contains)
 export(expect_cpp_tests_pass)
+export(expect_disjoint)
 export(expect_equal)
 export(expect_equal_to_reference)
 export(expect_equivalent)

NEWS.md

@@ -1,5 +1,6 @@
 # testthat (development version)
 
+* New `expect_disjoint()` to check for the absence of values (#1851).
 * New `vignette("mocking")` explains mocking in detail (#1265).
 * New `vignette("challenging-functions")` provides an index to other documentation organised by testing challenges (#1265).
 * When running a test interactively, testthat now reports the number of succeses. The results should also be more useful if you are using nested tests.

R/expect-setequal.R

@@ -4,8 +4,10 @@
 #'    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`
+#' * `expect_in(x, y)` tests that every element of `x` is in `y`
 #'   (i.e. `x` is a subset of `y`).
+#' * `expect_disjoint(x, y)` tests that no element of `x` is in `y`
+#'   (i.e. `x` is disjoint from `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.
@@ -117,6 +119,7 @@ expect_contains <- function(object, expected) {
   pass(act$val)
 }
 
+
 #' @export
 #' @rdname expect_setequal
 expect_in <- function(object, expected) {
@@ -144,6 +147,33 @@ expect_in <- function(object, expected) {
   pass(act$val)
 }
 
+#' @export
+#' @rdname expect_setequal
+expect_disjoint <- function(object, expected) {
+  act <- quasi_label(enquo(object))
+  exp <- quasi_label(enquo(expected))
+
+  check_vector(object)
+  check_vector(expected)
+
+  act_common <- act$val %in% exp$val
+  if (any(act_common)) {
+    msg_exp <- sprintf(
+      "Expected %s to be disjoint from %s.",
+      act$lab,
+      exp$lab
+    )
+    msg_act <- c(
+      sprintf("Actual: %s", values(act$val)),
+      sprintf("Expected: none of %s", values(exp$val)),
+      sprintf("Invalid: %s", values(act$val[act_common]))
+    )
+    fail(c(msg_exp, msg_act))
+  }
+
+  pass(act$val)
+}
+
 # Helpers ----------------------------------------------------------------------
 
 check_vector <- function(

tests/testthat/_snaps/expect-setequal.md

@@ -143,3 +143,25 @@
       Expected: "d", "e"
       Invalid: "a", "b"
 
+# expect_disjoint() gives useful message on failure
+
+    Code
+      expect_disjoint(x1, x2)
+    Condition
+      Error:
+      ! Expected `x1` to be disjoint from `x2`.
+      Actual: "a", "b", "c"
+      Expected: none of "c", "d"
+      Invalid: "c"
+
+---
+
+    Code
+      expect_disjoint(x1, x3)
+    Condition
+      Error:
+      ! Expected `x1` to be disjoint from `x3`.
+      Actual: "a", "b", "c"
+      Expected: none of "b", "c", "d"
+      Invalid: "b", "c"
+

tests/testthat/test-expect-setequal.R

@@ -148,3 +148,20 @@ test_that("expect_in() gives useful message on failure", {
   expect_snapshot_failure(expect_in(x1, x2))
   expect_snapshot_failure(expect_in(x1, x3))
 })
+
+# disjoint ----------------------------------------------------------------
+
+test_that("expect_disjoint() succeeds when appropriate", {
+  expect_success(expect_disjoint(1, letters))
+  expect_success(expect_disjoint(LETTERS, letters))
+  expect_success(expect_disjoint(character(), letters))
+})
+
+test_that("expect_disjoint() gives useful message on failure", {
+  x1 <- c("a", "b", "c")
+  x2 <- c("c", "d")
+  x3 <- c("b", "c", "d")
+
+  expect_snapshot_failure(expect_disjoint(x1, x2))
+  expect_snapshot_failure(expect_disjoint(x1, x3))
+})