From d1fd7d93cfd5874ac5976506d75b3ec10b043e69 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Wed, 17 Apr 2019 10:08:43 -0500 Subject: [PATCH] Implement expect_mapequal() Fixes #863 --- NAMESPACE | 1 + NEWS.md | 4 +++ R/expect-setequal.R | 50 ++++++++++++++++++++++++--- man/equality-expectations.Rd | 12 +------ man/expect_setequal.Rd | 46 ++++++++++++++++++++++++ tests/testthat/test-expect-setequal.R | 20 +++++++++++ 6 files changed, 117 insertions(+), 16 deletions(-) create mode 100644 man/expect_setequal.Rd diff --git a/NAMESPACE b/NAMESPACE index 7f19ce029..f08166e66 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -78,6 +78,7 @@ export(expect_length) export(expect_less_than) export(expect_lt) export(expect_lte) +export(expect_mapequal) export(expect_match) export(expect_message) export(expect_more_than) diff --git a/NEWS.md b/NEWS.md index dfe4036c1..bd40fc929 100644 --- a/NEWS.md +++ b/NEWS.md @@ -5,6 +5,10 @@ * New `expect_visible()` and `expect_invisible()` make it easier to check if a function call returns its result visibly or invisibly (#719). +* New `expect_mapequal(x, y)` checks that `x` and `y` have the same names, + and the same value associated with each name (i.e. they compare the values + of the vector standardising the order of the names) (#863). + * New `expect_vector()` is a wrapper around `vctrs::vec_assert()` making it easy to test against the vctrs definitions of prototype and size (#846). (Currently requires development version of vctrs.) diff --git a/R/expect-setequal.R b/R/expect-setequal.R index 663fbcb22..49f03d769 100644 --- a/R/expect-setequal.R +++ b/R/expect-setequal.R @@ -1,16 +1,24 @@ #' Expectation: do two vectors contain the same values? #' -#' `expect_setequal(x, y)` tests that every element of `x` occurs in `y`, -#' and that every element of `y` occurs in `x`. Note that this definition -#' ignores names, and you will be warned if both `object` and `expected` have -#' names. +#' * `expect_setequal(x, y)` tests that every element of `x` occurs in `y`, +#' and that every element of `y` occurs in `x`. +#' * `expect_mapequal(x, y)` tests that `x` and `y` have the same names, and +#' that `x[names(y)]` equals `x`. +#' +#' Note that `expect_setequal()` ignores names, and you will be warned if both +#' `object` and `expected` have them. #' #' @inheritParams expect_equal #' @export -#' @rdname equality-expectations #' @examples #' expect_setequal(letters, rev(letters)) #' show_failure(expect_setequal(letters[-1], rev(letters))) +#' +#' x <- list(b = 2, a = 1) +#' expect_mapequal(x, list(a = 1, b = 2)) +#' show_failure(expect_mapequal(x, list(a = 1))) +#' show_failure(expect_mapequal(x, list(a = 1, b = "x"))) +#' show_failure(expect_mapequal(x, list(a = 1, b = 2, c = 3))) expect_setequal <- function(object, expected) { act <- quasi_label(enquo(object), arg = "object") exp <- quasi_label(enquo(expected), arg = "expected") @@ -59,3 +67,35 @@ locations <- function(i) { paste0("c(", paste0(loc, collapse = ", "), ")") } + +#' @export +#' @rdname expect_setequal +expect_mapequal <- function(object, expected) { + act <- quasi_label(enquo(object), arg = "object") + exp <- quasi_label(enquo(expected), arg = "expected") + + if (!is_vector(act$val) || !is_vector(exp$val)) { + abort("`object` and `expected` must both be vectors") + } + + act_nms <- names(act$val) + exp_nms <- names(exp$val) + + if (!setequal(act_nms, exp_nms)) { + act_miss <- setdiff(exp_nms, act_nms) + if (length(act_miss) > 0) { + vals <- paste0(encodeString(act_miss, quote = '"'), ", ") + fail(paste0("Names absent from `object`: ", vals)) + } + + exp_miss <- setdiff(act_nms, exp_nms) + if (length(exp_miss) > 0) { + vals <- paste0(encodeString(exp_miss, quote = '"'), ", ") + fail(paste0("Names absent from `expected`: ", vals)) + } + } else { + expect_equal(act$val[exp_nms], exp$val) + } + + invisible(act$val) +} diff --git a/man/equality-expectations.Rd b/man/equality-expectations.Rd index b0b4a32a3..8057faa35 100644 --- a/man/equality-expectations.Rd +++ b/man/equality-expectations.Rd @@ -1,12 +1,11 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/expect-equality.R, R/expect-setequal.R +% Please edit documentation in R/expect-equality.R \name{equality-expectations} \alias{equality-expectations} \alias{expect_equal} \alias{expect_equivalent} \alias{expect_identical} \alias{expect_reference} -\alias{expect_setequal} \title{Expectation: is the object equal to a value?} \usage{ expect_equal(object, expected, ..., info = NULL, label = NULL, @@ -20,8 +19,6 @@ expect_identical(object, expected, info = NULL, label = NULL, expect_reference(object, expected, info = NULL, label = NULL, expected.label = NULL) - -expect_setequal(object, expected) } \arguments{ \item{object, expected}{Computation and value to compare it to. @@ -49,11 +46,6 @@ use only.} \code{check.attributes = FALSE} \item \code{expect_reference()} compares the underlying memory addresses. } - -\code{expect_setequal(x, y)} tests that every element of \code{x} occurs in \code{y}, -and that every element of \code{y} occurs in \code{x}. Note that this definition -ignores names, and you will be warned if both \code{object} and \code{expected} have -names. } \examples{ a <- 10 @@ -83,8 +75,6 @@ expect_equal(10.01, expected = x, tolerance = 0.002, scale = x) a <- b <- 1:3 names(b) <- letters[1:3] expect_equivalent(a, b) -expect_setequal(letters, rev(letters)) -show_failure(expect_setequal(letters[-1], rev(letters))) } \seealso{ \code{expect_setequal()} to test for set equality. diff --git a/man/expect_setequal.Rd b/man/expect_setequal.Rd new file mode 100644 index 000000000..7281f4982 --- /dev/null +++ b/man/expect_setequal.Rd @@ -0,0 +1,46 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/expect-setequal.R +\name{expect_setequal} +\alias{expect_setequal} +\alias{expect_mapequal} +\title{Expectation: do two vectors contain the same values?} +\usage{ +expect_setequal(object, expected) + +expect_mapequal(object, expected) +} +\arguments{ +\item{object}{Computation and value to compare it to. + +Both arguments supports limited unquoting to make it easier to generate +readable failures within a function or for loop. See \link{quasi_label} for +more details.} + +\item{expected}{Computation and value to compare it to. + +Both arguments supports limited unquoting to make it easier to generate +readable failures within a function or for loop. See \link{quasi_label} for +more details.} +} +\description{ +\itemize{ +\item \code{expect_setequal(x, y)} tests that every element of \code{x} occurs in \code{y}, +and that every element of \code{y} occurs in \code{x}. +\item \code{expect_mapequal(x, y)} tests that \code{x} and \code{y} have the same names, and +that \code{x[names(y)]} equals \code{x}. +} +} +\details{ +Note that \code{expect_setequal()} ignores names, and you will be warned if both +\code{object} and \code{expected} have them. +} +\examples{ +expect_setequal(letters, rev(letters)) +show_failure(expect_setequal(letters[-1], rev(letters))) + +x <- list(b = 2, a = 1) +expect_mapequal(x, list(a = 1, b = 2)) +show_failure(expect_mapequal(x, list(a = 1))) +show_failure(expect_mapequal(x, list(a = 1, b = "x"))) +show_failure(expect_mapequal(x, list(a = 1, b = 2, c = 3))) +} diff --git a/tests/testthat/test-expect-setequal.R b/tests/testthat/test-expect-setequal.R index df43018dc..27a1eae2f 100644 --- a/tests/testthat/test-expect-setequal.R +++ b/tests/testthat/test-expect-setequal.R @@ -1,3 +1,5 @@ +# setequal ---------------------------------------------------------------- + test_that("ignores order and duplicates", { expect_success(expect_setequal(letters, rev(letters))) expect_success(expect_setequal(c("a", "a", "b"), c("b", "b", "a"))) @@ -21,3 +23,21 @@ test_that("error for non-vectors", { expect_error(expect_setequal(sum, sum), "be vectors") }) +# mapequal ---------------------------------------------------------------- + +test_that("ignores order", { + expect_success(expect_mapequal(list(a = 1, b = 2), list(b = 2, a = 1))) +}) + +test_that("fail if names don't match", { + expect_failure(expect_mapequal(list(a = 1, b = 2), list(a = 1))) + expect_failure(expect_mapequal(list(a = 1), list(a = 1, b = 2))) +}) + +test_that("fails if values don't match", { + expect_failure(expect_mapequal(list(a = 1, b = 2), list(a = 1, b = 3))) +}) + +test_that("error for non-vectors", { + expect_error(expect_mapequal(sum, sum), "be vectors") +})