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
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
|
#' Old-style expectations.
#'
#' @description
#' `r lifecycle::badge("superseded")`
#'
#' Initial testthat used a style of testing that looked like
#' `expect_that(a, equals(b)))` this allowed expectations to read like
#' English sentences, but was verbose and a bit too cutesy. This style
#' will continue to work but has been soft-deprecated - it is no longer
#' documented, and new expectations will only use the new style
#' `expect_equal(a, b)`.
#'
#' @name oldskool
#' @keywords internal
NULL
#' @export
#' @rdname oldskool
is_null <- function() {
warning(
"`is_null()` is deprecated. Please use `expect_null()` instead.",
call. = FALSE
)
function(x) expect_null(x)
}
#' @export
#' @rdname oldskool
is_a <- function(class) {
function(x) expect_is(x, class)
}
#' @export
#' @rdname oldskool
is_true <- function() {
function(x) {
warning(
"`is_true()` is deprecated. Please use `expect_true()` instead.",
call. = FALSE
)
expect_true(x)
}
}
#' @export
#' @rdname oldskool
is_false <- function() {
function(x) {
warning(
"`is_false()` is deprecated. Please use `expect_false()` instead.",
call. = FALSE
)
expect_false(x)
}
}
#' @export
#' @rdname oldskool
has_names <- function(expected, ignore.order = FALSE, ignore.case = FALSE) {
function(x) {
expect_named(x, expected = expected, ignore.order = ignore.order, ignore.case = ignore.case)
}
}
#' @export
#' @rdname oldskool
is_less_than <- function(expected, label = NULL, ...) {
function(x) expect_lt(x, expected)
}
#' @export
#' @rdname oldskool
is_more_than <- function(expected, label = NULL, ...) {
function(x) expect_gt(x, expected)
}
#' @export
#' @rdname oldskool
equals <- function(expected, label = NULL, ...) {
function(x) expect_equal(x, expected, ..., expected.label = label)
}
#' @export
#' @rdname oldskool
is_equivalent_to <- function(expected, label = NULL) {
function(x) expect_equivalent(x, expected, expected.label = label)
}
#' @export
#' @rdname oldskool
is_identical_to <- function(expected, label = NULL) {
function(x) expect_identical(x, expected, expected.label = label)
}
#' @export
#' @rdname oldskool
equals_reference <- function(file, label = NULL, ...) {
function(x) expect_known_value(x, file, expected.label = label, ...)
}
#' @export
#' @rdname oldskool
shows_message <- function(regexp = NULL, all = FALSE, ...) {
function(x) expect_message(x, regexp = regexp, all = all, ...)
}
#' @export
#' @rdname oldskool
gives_warning <- function(regexp = NULL, all = FALSE, ...) {
function(x) expect_warning(x, regexp = regexp, all = all, ...)
}
#' @export
#' @rdname oldskool
prints_text <- function(regexp = NULL, ...) {
function(x) expect_output(x, regexp, ...)
}
#' @export
#' @rdname oldskool
throws_error <- function(regexp = NULL, ...) {
function(x) expect_error(x, regexp, ...)
}
#' @export
#' @rdname oldskool
matches <- function(regexp, all = TRUE, ...) {
warning(
"`matches()` is deprecated. Please use `expect_match()` instead.",
call. = FALSE
)
function(x) expect_match(x, regexp, all = all, ...)
}
#' Does code take less than the expected amount of time to run?
#'
#' This is useful for performance regression testing.
#'
#' @keywords internal
#' @export
#' @param amount maximum duration in seconds
takes_less_than <- function(amount) {
warning(
"takes_less_than() is deprecated because it is stochastic and unreliable",
call. = FALSE
)
function(expr) {
duration <- system.time(force(expr))["elapsed"]
expect(
duration < amount,
paste0("took ", duration, " seconds, which is more than ", amount)
)
}
}
|
