R/expect-no-condition.R

In testthat: Unit Testing for R

#' Does code run without error, warning, message, or other condition?
#'
#' @description
#' These expectations are the opposite of [expect_error()],
#' `expect_warning()`, `expect_message()`, and `expect_condition()`. They
#' assert the absence of an error, warning, or message, respectively.
#'
#' @inheritParams expect_error
#' @param message,class The default, `message = NULL, class = NULL`,
#'   will fail if there is any error/warning/message/condition.
#'
#'   In many cases, particularly when testing warnings and messages, you will
#'   want to be more specific about the condition you are hoping **not** to see,
#'   i.e. the condition that motivated you to write the test.  Similar to
#'   `expect_error()` and friends, you can specify the `message` (a regular
#'   expression that the message of the condition must match) and/or the
#'   `class` (a class the condition must inherit from). This ensures that
#'   the message/warnings you don't want never recur, while allowing new
#'   messages/warnings to bubble up for you to deal with.
#'
#'   Note that you should only use `message` with errors/warnings/messages
#'   that you generate, or that base R generates (which tend to be stable).
#'   Avoid tests that rely on the specific text generated by another package
#'   since this can easily change. If you do need to test text generated by
#'   another package, either protect the test with `skip_on_cran()` or
#'   use `expect_snapshot()`.
#' @inheritParams rlang::args_dots_empty
#' @export
#' @examples
#' expect_no_warning(1 + 1)
#'
#' foo <- function(x) {
#'   warning("This is a problem!")
#' }
#'
#' # warning doesn't match so bubbles up:
#' expect_no_warning(foo(), message = "bananas")
#'
#' # warning does match so causes a failure:
#' try(expect_no_warning(foo(), message = "problem"))
expect_no_error <- function(object,
                            ...,
                            message = NULL,
                            class = NULL) {
  check_dots_empty()
  expect_no_("error", {{ object }}, regexp = message, class = class)
}


#' @export
#' @rdname expect_no_error
expect_no_warning <- function(object,
                              ...,
                              message = NULL,
                              class = NULL
                              ) {
  check_dots_empty()
  expect_no_("warning", {{ object }}, regexp = message, class = class)
}

#' @export
#' @rdname expect_no_error
expect_no_message <- function(object,
                              ...,
                              message = NULL,
                              class = NULL
                              ) {
  check_dots_empty()
  expect_no_("message", {{ object }}, regexp = message, class = class)
}

#' @export
#' @rdname expect_no_error
expect_no_condition <- function(object,
                                ...,
                                message = NULL,
                                class = NULL
                                ) {
  check_dots_empty()
  expect_no_("condition", {{ object }}, regexp = message, class = class)
}


expect_no_ <- function(base_class,
                            object,
                            regexp = NULL,
                            class = NULL,
                            error_call = caller_env()) {

  matcher <- cnd_matcher(
    base_class,
    class,
    pattern = regexp,
    ignore_deprecation = base_class == "warning" && is.null(regexp) && is.null(class)
  )

  capture <- function(code) {
    try_fetch(
      code,
      !!base_class := function(cnd) {
        if (!matcher(cnd)) {
          return(zap())
        }

        expected <- paste0(
          "Expected ", quo_label(enquo(object)), " to run without any ", base_class, "s",
          if (!is.null(class)) paste0(" of class '", class, "'"),
          if (!is.null(regexp)) paste0(" matching pattern '", regexp, "'"),
          "."
        )
        actual <- paste0(
          "Actually got a <", class(cnd)[[1]], "> with text:\n",
          indent_lines(rlang::cnd_message(cnd))
        )
        message <- format_error_bullets(c(expected, i = actual))
        fail(message, trace_env = error_call)
      }
    )
  }

  act <- quasi_capture(enquo(object), NULL, capture)
  succeed()
  invisible(act$val)
}

indent_lines <- function(x) {
  paste0("  ", gsub("\n", "\n  ", x))
}