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 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219
|
#' Expectations: is the output or the value equal to a known good value?
#'
#' For complex printed output and objects, it is often challenging to describe
#' exactly what you expect to see. `expect_known_value()` and
#' `expect_known_output()` provide a slightly weaker guarantee, simply
#' asserting that the values have not changed since the last time that you ran
#' them.
#'
#' These expectations should be used in conjunction with git, as otherwise
#' there is no way to revert to previous values. Git is particularly useful
#' in conjunction with `expect_known_output()` as the diffs will show you
#' exactly what has changed.
#'
#' Note that known values updates will only be updated when running tests
#' interactively. `R CMD check` clones the package source so any changes to
#' the reference files will occur in a temporary directory, and will not be
#' synchronised back to the source package.
#'
#' @section 3rd edition:
#' `r lifecycle::badge("deprecated")`
#'
#' `expect_known_output()` and friends are deprecated in the 3rd edition;
#' please use [expect_snapshot_output()] and friends instead.
#'
#' @export
#' @param file File path where known value/output will be stored.
#' @param update Should the file be updated? Defaults to `TRUE`, with
#' the expectation that you'll notice changes because of the first failure,
#' and then see the modified files in git.
#' @param version The serialization format version to use. The default, 2, was
#' the default format from R 1.4.0 to 3.5.3. Version 3 became the default from
#' R 3.6.0 and can only be read by R versions 3.5.0 and higher.
#' @param ... Passed on to [waldo::compare()].
#' @keywords internal
#' @inheritParams expect_equal
#' @inheritParams capture_output_lines
#' @examples
#' tmp <- tempfile()
#'
#' # The first run always succeeds
#' expect_known_output(mtcars[1:10, ], tmp, print = TRUE)
#'
#' # Subsequent runs will succeed only if the file is unchanged
#' # This will succeed:
#' expect_known_output(mtcars[1:10, ], tmp, print = TRUE)
#'
#' \dontrun{
#' # This will fail
#' expect_known_output(mtcars[1:9, ], tmp, print = TRUE)
#' }
expect_known_output <- function(object, file,
update = TRUE,
...,
info = NULL,
label = NULL,
print = FALSE,
width = 80) {
edition_deprecate(3, "expect_known_output()",
"Please use `expect_snapshot_output()` instead"
)
act <- list()
act$quo <- enquo(object)
act$lab <- label %||% quo_label(act$quo)
act <- append(act, eval_with_output(object, print = print, width = width))
compare_file(file, act$out, update = update, info = info, ...)
invisible(act$val)
}
compare_file <- function(path, lines, ..., update = TRUE, info = NULL) {
if (!file.exists(path)) {
warning("Creating reference output", call. = FALSE)
brio::write_lines(lines, path)
succeed()
return()
}
old_lines <- brio::read_lines(path)
if (update) {
brio::write_lines(lines, path)
if (!all_utf8(lines)) {
warning("New reference output is not UTF-8 encoded", call. = FALSE)
}
}
if (!all_utf8(old_lines)) {
warning("Reference output is not UTF-8 encoded", call. = FALSE)
}
comp <- waldo_compare(
x = old_lines, x_arg = "old",
y = lines, y_arg = "new",
...
)
expect(
length(comp) == 0,
sprintf(
"Results have changed from known value recorded in %s.\n\n%s",
encodeString(path, quote = "'"), paste0(comp, collapse = "\n\n")
),
info = info,
trace_env = caller_env()
)
}
#' Expectations: is the output or the value equal to a known good value?
#'
#' `expect_output_file()` behaves identically to [expect_known_output()].
#'
#' @section 3rd edition:
#' `r lifecycle::badge("deprecated")`
#'
#' `expect_output_file()` is deprecated in the 3rd edition;
#' please use [expect_snapshot_output()] and friends instead.
#'
#' @export
#' @keywords internal
expect_output_file <- function(object, file,
update = TRUE,
...,
info = NULL,
label = NULL,
print = FALSE,
width = 80) {
# Code is a copy of expect_known_output()
edition_deprecate(3, "expect_output_file()",
"Please use `expect_snapshot_output()` instead"
)
act <- list()
act$quo <- enquo(object)
act$lab <- label %||% quo_label(act$quo)
act <- append(act, eval_with_output(object, print = print, width = width))
compare_file(file, act$out, update = update, info = info, ...)
invisible(act$val)
}
#' @export
#' @rdname expect_known_output
expect_known_value <- function(object, file,
update = TRUE,
...,
info = NULL,
label = NULL,
version = 2) {
edition_deprecate(3, "expect_known_value()",
"Please use `expect_snapshot_value()` instead"
)
act <- quasi_label(enquo(object), label, arg = "object")
if (!file.exists(file)) {
warning("Creating reference value", call. = FALSE)
saveRDS(object, file, version = version)
succeed()
} else {
ref_val <- readRDS(file)
comp <- compare(act$val, ref_val, ...)
if (update && !comp$equal) {
saveRDS(act$val, file, version = version)
}
expect(
comp$equal,
sprintf(
"%s has changed from known value recorded in %s.\n%s",
act$lab, encodeString(file, quote = "'"), comp$message
),
info = info
)
}
invisible(act$value)
}
#' @export
#' @rdname expect_known_output
#' @usage NULL
expect_equal_to_reference <- function(..., update = FALSE) {
edition_deprecate(3, "expect_equal_to_reference()",
"Please use `expect_snapshot_value()` instead"
)
expect_known_value(..., update = update)
}
#' @export
#' @rdname expect_known_output
#' @param hash Known hash value. Leave empty and you'll be informed what
#' to use in the test output.
expect_known_hash <- function(object, hash = NULL) {
edition_deprecate(3, "expect_known_hash()",
"Please use `expect_snapshot_value()` instead"
)
act <- quasi_label(enquo(object), arg = "object")
act_hash <- digest::digest(act$val)
if (!is.null(hash)) {
act_hash <- substr(act_hash, 1, nchar(hash))
}
if (is.null(hash)) {
warning(paste0("No recorded hash: use ", substr(act_hash, 1, 10)))
succeed()
} else {
expect(
hash == act_hash,
sprintf("Value hashes to %s, not %s", act_hash, hash)
)
}
invisible(act$value)
}
all_utf8 <- function(x) {
! any(is.na(iconv(x, "UTF-8", "UTF-8")))
}
|