Negating tests with testthat

gistfile1.r

library(testthat)

## This works but won't correct labels:
not <- function(f) {
  function(...) {
    res <- f(...)
    res$passed <- !res$passed
    res
  }
}

## These work using normal testthat ideas:
a <- 1
expect_that(a, is_identical_to(1)) # should pass
expect_that(a, is_identical_to(2)) # should fail

## These fail appropriately, but write misleading messages
expect_that(a, not(is_identical_to(1))) # fails, but wrong message
expect_that(a, not(is_identical_to(2))) # passes, all good

## Rewriting expect_that to flip conditions would suffer the same
## basic problem.  Rewriting the message strings is hard to do
## automatically.

## But it's straightforward to write new testing function.  For
## example (based off `equals()`)
not_equals <- function(expected, label = NULL, ...) {
  if (is.null(label)) {
    label <- find_expr("expected")
  } else if (!is.character(label) || length(label) != 1) {
    label <- deparse(label)
  }

  function(actual) {
    same <- isTRUE(all.equal(expected, actual, ...))
    expectation(identical(same, FALSE),
                str_c("is equal to ",  label, ", but should differ"))
  }
}
environment(not_equals) <- environment(equals)

## and off `is_identical_to()`
is_not_identical_to <- function(expected, label = NULL) {
  if (is.null(label)) {
    label <- find_expr("expected")
  } else if (!is.character(label) || length(label) != 1) {
    label <- deparse(label)
  }

  function(actual) {
    expectation(!isTRUE(all.equal(expected, actual)),
                str_c("is identical to ", label, ", but should differ"))
  }
}
environment(is_not_identical_to) <- environment(is_identical_to)

## These work using normal testthat ideas:
a <- 1
expect_that(a, is_not_identical_to(2)) # should pass
expect_that(a, is_not_identical_to(1)) # should fail

expect_that(a, not_equals(2)) # should pass
expect_that(a, not_equals(1)) # should fail

## Automatic negation would require messages to be built for both
## success and failure, I think.