1#' Does code return a vector containing the expected values?
2#'
3#' * `expect_setequal(x, y)` tests that every element of `x` occurs in `y`,
4#'    and that every element of `y` occurs in `x`.
5#' * `expect_mapequal(x, y)` tests that `x` and `y` have the same names, and
6#'    that `x[names(y)]` equals `y`.
7#'
8#' Note that `expect_setequal()` ignores names, and you will be warned if both
9#' `object` and `expected` have them.
10#'
11#' @inheritParams expect_equal
12#' @export
13#' @examples
14#' expect_setequal(letters, rev(letters))
15#' show_failure(expect_setequal(letters[-1], rev(letters)))
16#'
17#' x <- list(b = 2, a = 1)
18#' expect_mapequal(x, list(a = 1, b = 2))
19#' show_failure(expect_mapequal(x, list(a = 1)))
20#' show_failure(expect_mapequal(x, list(a = 1, b = "x")))
21#' show_failure(expect_mapequal(x, list(a = 1, b = 2, c = 3)))
22expect_setequal <- function(object, expected) {
23  act <- quasi_label(enquo(object), arg = "object")
24  exp <- quasi_label(enquo(expected), arg = "expected")
25
26  if (!is_vector(act$val) || !is_vector(exp$val)) {
27    abort("`object` and `expected` must both be vectors")
28  }
29
30  if (!is.null(names(act$val)) && !is.null(names(exp$val))) {
31    warn("expect_setequal() ignores names")
32  }
33
34  act_miss <- !act$val %in% exp$val
35  if (any(act_miss)) {
36    fail(
37      paste0(act$lab, "[", locations(act_miss), "] absent from ", exp$lab)
38    )
39  }
40
41  exp_miss <- !exp$val %in% act$val
42  if (any(exp_miss)) {
43    fail(
44      paste0(exp$lab, "[", locations(exp_miss), "] absent from ", act$lab)
45    )
46  }
47
48  if (!any(exp_miss) && !any(act_miss)) {
49    succeed()
50  }
51
52  invisible(act$val)
53}
54
55is_vector <- function(x) is.list(x) || (is.atomic(x) && !is.null(x))
56
57locations <- function(i) {
58  loc <- which(i)
59  if (length(loc) == 1) {
60    return(loc)
61  }
62
63  if (length(loc) > 10) {
64    loc <- c(loc[1:9], "...")
65  }
66
67  paste0("c(", paste0(loc, collapse = ", "), ")")
68}
69
70
71#' @export
72#' @rdname expect_setequal
73expect_mapequal <- function(object, expected) {
74  act <- quasi_label(enquo(object), arg = "object")
75  exp <- quasi_label(enquo(expected), arg = "expected")
76
77  if (!is_vector(act$val) || !is_vector(exp$val)) {
78    abort("`object` and `expected` must both be vectors")
79  }
80
81  # Length-0 vectors are OK whether named or unnamed.
82  if (length(act$val) == 0 && length(exp$val) == 0) {
83    warn("`object` and `expected` are empty lists")
84    succeed()
85    return(invisible(act$val))
86  }
87
88  act_nms <- names(act$val)
89  exp_nms <- names(exp$val)
90
91  check_names_ok(act_nms, "object")
92  check_names_ok(exp_nms, "expected")
93
94  if (!setequal(act_nms, exp_nms)) {
95    act_miss <- setdiff(exp_nms, act_nms)
96    if (length(act_miss) > 0) {
97      vals <- paste0(encodeString(act_miss, quote = '"'), ", ")
98      fail(paste0("Names absent from `object`: ", vals))
99    }
100
101    exp_miss <- setdiff(act_nms, exp_nms)
102    if (length(exp_miss) > 0) {
103      vals <- paste0(encodeString(exp_miss, quote = '"'), ", ")
104      fail(paste0("Names absent from `expected`: ", vals))
105    }
106  } else {
107    expect_equal(act$val[exp_nms], exp$val)
108  }
109
110  invisible(act$val)
111}
112
113check_names_ok <- function(x, label) {
114  if (anyDuplicated(x)) {
115    stop("Duplicate names in `", label, "`: ", unique(x[duplicated(x)]))
116  }
117  if (any(x == "")) {
118    stop("All elements in `", label, "` must be named")
119  }
120}
121