File: expect-no-condition.R

package info (click to toggle)
r-cran-testthat 3.2.3-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 3,452 kB
  • sloc: cpp: 9,261; ansic: 37; sh: 14; makefile: 5
file content (135 lines) | stat: -rw-r--r-- 4,502 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
#' 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,
                       trace_env = 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
        # We can't call succeed() here because that generates a condition
        # that causes `expect_no_condition()` to always fail
        NULL
      },
      !!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 = trace_env)
      }
    )
  }

  act <- quasi_capture(enquo(object), NULL, capture)
  if (is.null(act$cap)) {
    succeed()
  }
  invisible(act$val)
}

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