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