Feature request: Expect the same error (or warning or message) message as a reference

[billdenney]

I often want to have tests to ensure that the error/warning/message is the same as the expected one. When it is an error internal to the package, it's no trouble. When it is not an error internal to the package, best practice is not to check that the message is the same. But, that inhibits checking that an error from an external package is the desired error.

One way around this is to capture the expected error message, but this is cumbersome (see example below). Would a feature that could capture and verify the message from an external package is the same be of interest? I think that it would apply to expect_error(), expect_warning(), and expect_error().

I think that it could look something like the following:

expect_error(
  myfun(x = c()),
  same_message =
    {
      x <- c()
      stopifnot(length(x) == 1)
    }
)

myfun <- function(x) {
  stopifnot(length(x) == 1)
  x
}

expect_error(
  myfun(x = c()),
  regexp =
    attr(
      try(
        {
          x <- c()
          stopifnot(length(x) == 1)
        },
        silent = TRUE
      ),
      "condition"
    )$message,
  fixed = TRUE
)
#> Error in expect_error(myfun(x = c()), regexp = attr(try({: could not find function "expect_error"

^{Created on 2024-02-02 with reprex v2.0.2}

[hadley]

Hmmmm, you can do this currently with:

library(testthat)

myfun <- function(x) {
  stopifnot(length(x) == 1)
}

expected <- tryCatch( 
  {
    x <- c()
    stopifnot(length(x) == 1)
  },
  error = function(e) conditionMessage(e)
)

expect_error(myfun(x = c()), regexp = expected, fixed = TRUE)

which you could make easier with a family of helpers along these lines (not tested):

error_message <- function(code) {
  tryCatch(
    {
      code
      stop("No error thrown")
    },
    error = function(e) conditionMessage(e)
  )
}

But that still leaves you need to supply fixed to expect_error().

The interface of expect_error() is already complicated with the class and regexp arguments so I don't like the idea of adding a third mutually exclusive argument, but it might could be a new family of expectations like expect_error_forwarded():

expect_error_forwared <- function(actual, expected) {
  message <- error_message(expected)
  expect_error(actual, regexp = message, fixed = TRUE)
}

I'd suggest you try out that code in a helper, see how it feels, and then report back.

[billdenney]

Thanks for these thoughts. I tried it out a bit, and I have a few thoughts:

1. The error thrown with stop("No error thrown") could accidentally capture an error with the text "No error thrown", so I modified it to return NULL in the expected message. Then, I am checking for that NULL in the expect_error_forwarded() function.
2. Do the same for warnings and messages

The below works as a variant on your code. Would you like me to make a PR? (If so, should it have a label argument that is passed to the subsequent expect_*() function?)

library(testthat)

error_message <- function(code) {
  tryCatch(
    {
      code
      NULL
    },
    error = function(e) conditionMessage(e)
  )
}

warning_message <- function(code) {
  tryCatch(
    {
      code
      NULL
    },
    warning = function(e) conditionMessage(e)
  )
}

message_message <- function(code) {
  tryCatch(
    {
      code
      NULL
    },
    message = function(e) conditionMessage(e)
  )
}

expect_error_forwarded <- function(actual, expected) {
  message <- error_message(expected)
  if (is.null(message)) {
    stop("No expected error thrown")
  }
  expect_error(actual, regexp = message, fixed = TRUE)
}

expect_warning_forwarded <- function(actual, expected) {
  message <- warning_message(expected)
  if (is.null(message)) {
    stop("No expected warning thrown")
  }
  expect_warning(actual, regexp = message, fixed = TRUE)
}

expect_message_forwarded <- function(actual, expected) {
  message <- message_message(expected)
  if (is.null(message)) {
    stop("No expected message thrown")
  }
  expect_message(actual, regexp = message, fixed = TRUE)
}

# Generic functions for testing

myfun <- function(x) {
  stopifnot(length(x) == 1)
}

myfunwarn1 <- function() {
  warning("foo")
}

myfunwarn2 <- function() {
  warning("foo")
  warning("bar")
}

# Testing

# Normal behavior
expect_error_forwarded(
  myfun(1:2),
  {
    x <- c()
    stopifnot(length(x) == 1)
  }
)

# The expected error was not an error (a bad test or something about the
# underlying package may have changed)
expect_error_forwarded(
  myfun(1:2),
  {
    x <- 1
    stopifnot(length(x) == 1)
  }
)
#> Error in expect_error_forwarded(myfun(1:2), {: No expected error thrown

# The expected warning is returned
expect_warning_forwarded(
  myfunwarn1(),
  warning("foo")
)

# No warning is returned
expect_warning_forwarded(
  1,
  warning("foo")
)
#> Error: `actual` did not produce any warnings.

# multiple warnings are returned, either can be captured
expect_warning_forwarded(
  myfunwarn2(),
  warning("foo")
)
expect_warning_forwarded(
  myfunwarn2(),
  warning("bar")
)

# A different warning is returned
expect_warning_forwarded(
  warning("baz"),
  warning("bar")
)
#> Error: `actual` produced unexpected warnings.
#> Expected match: bar
#> Actual values:
#> * baz

# A warning then an error is returned (this doesn't work, but it also appears
# not to work with `expect_warning()`, so that's consistent.)
expect_warning_forwarded(
  {
    warning("bar")
    stop("baz")
  },
  warning("bar")
)
#> Error in eval_bare(quo_get_expr(.quo), quo_get_env(.quo)): baz

expect_message_forwarded(
  message("foo"),
  message("foo")
)

expect_message_forwarded(
  message("bar"),
  message("foo")
)
#> Error: `actual` produced unexpected messages.
#> Expected match: foo\n
#> Actual values:
#> * bar

expect_message_forwarded(
  {
    message("bar")
    message("foo")
  },
  message("foo")
)

expect_message_forwarded(
  {
    message("bar")
    message("foo")
  },
  message("bar")
)

expect_message_forwarded(
  {
    message("bar")
    message("foo")
  },
  message("baz")
)
#> Error: `actual` produced unexpected messages.
#> Expected match: baz\n
#> Actual values:
#> * bar
#> 
#> * foo

expect_message_forwarded(
  {
    message("bar")
    message("foo")
  },
  {}
)
#> Error in expect_message_forwarded({: No expected message thrown

^{Created on 2024-02-14 with reprex v2.1.0}

[hadley]

Oh yeah. I'd suggest you do it like this:

error_message <- function(code) {
  out <- tryCatch(
    {
      code
      NULL
    },
    error = function(e) conditionMessage(e)
  )
  if (is.null(out)) {
    stop("No error thrown")
  } else {
    out
  }
}

[billdenney]

That makes sense. I created the PR.