Implement expect_disjoint() (#2239)

Fixes #1851

Author: stibu81

NAMESPACE

@@ -85,6 +85,7 @@ export(expect_all_true)
 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).
 * `expect_all_equal()`, `expect_all_true()`, and `expect_all_false()` are a new family of expectations that checks that every element of a vector has the same value. Compared to using `expect_true(all(...))` they give better failure messages (#1836, #2235).
 * Expectations now consistently return the value of the first argument, regardless of whether the expectation succeeds or fails. The primary exception are `expect_message()` and friends which will return the condition. This shouldn't affect existing tests, but will make failures clearer when you chain together multiple expectations (#2246).
 * `set_state_inspector()` gains `tolerance` argument and ignores minor FP differences by default (@mcol, #2237).

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, checks that `x` and `y` have the same names, then
 #'   checks that `x[names(y)]` equals `y`.
@@ -145,6 +147,7 @@ expect_contains <- function(object, expected) {
   invisible(act$val)
 }
 
+
 #' @export
 #' @rdname expect_setequal
 expect_in <- function(object, expected) {
@@ -174,6 +177,30 @@ expect_in <- function(object, expected) {
   invisible(act$val)
 }
 
+#' @export
+#' @rdname expect_setequal
+expect_disjoint <- function(object, expected) {
+  act <- quasi_label(enquo(object))
+  exp <- quasi_label(enquo(expected))
+
+  check_vector(act$val, error_arg = "object")
+  check_vector(exp$val, error_arg = "expected")
+
+  act_common <- act$val %in% exp$val
+  if (any(act_common)) {
+    fail(c(
+      sprintf("Expected %s to be disjoint from %s.", act$lab, exp$lab),
+      sprintf("Actual: %s", values(act$val)),
+      sprintf("Expected: None of %s", values(exp$val)),
+      sprintf("Invalid: %s", values(act$val[act_common]))
+    ))
+  } else {
+    pass()
+  }
+
+  invisible(act$val)
+}
+
 # Helpers ----------------------------------------------------------------------
 
 check_vector <- function(x, error_arg, error_call = caller_env()) {

man/expect_setequal.Rd

@@ -231,3 +231,36 @@
       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"
+
+---
+
+    Code
+      expect_disjoint(NA, c("a", NA))
+    Condition
+      Error:
+      ! Expected NA to be disjoint from `c("a", NA)`.
+      Actual: NA
+      Expected: None of "a", NA
+      Invalid: NA
+

tests/testthat/_snaps/expect-setequal.md

@@ -154,3 +154,21 @@ 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))
+  expect_snapshot_failure(expect_disjoint(NA, c("a", NA)))
+})