Implement expect_shape() (#1469)

Fixes #1423

Co-authored-by: Hadley Wickham <h.wickham@gmail.com>

Author: MichaelChirico

NAMESPACE

@@ -119,6 +119,7 @@ export(expect_s3_class)
 export(expect_s4_class)
 export(expect_s7_class)
 export(expect_setequal)
+export(expect_shape)
 export(expect_silent)
 export(expect_snapshot)
 export(expect_snapshot_error)

NEWS.md

@@ -6,6 +6,7 @@
 * Fixed an issue preventing compilation from succeeding due to deprecation / removal of `std::uncaught_exception()` (@kevinushey, #2047).
 * New `skip_unless_r()` to skip running tests on unsuitable versions of R, e.g. `skip_unless_r(">= 4.1.0")` to skip tests that require, say, `...names` (@MichaelChirico, #2022)
 * `skip_on_os()` gains an option `"emscripten"` of the `os` argument to skip tests on Emscripten (@eitsupi, #2103).
+* New expectation, `expect_shape()`, for testing the shape (i.e., the `length()`, `nrow()`, `ncol()`, or `dim()`), all in one place (#1423, @michaelchirico).
 
 # testthat 3.2.3
 

R/expect-length.R

@@ -1,6 +1,7 @@
 #' Does code return a vector with the specified length?
 #'
-#' @seealso [expect_vector()] to make assertions about the "size" of a vector
+#' @seealso [expect_vector()] to make assertions about the "size" of a vector,
+#'   [expect_shape()] for more general assertions about object "shape".
 #' @inheritParams expect_that
 #' @param n Expected length.
 #' @family expectations
@@ -16,11 +17,16 @@ expect_length <- function(object, n) {
   stopifnot(is.numeric(n), length(n) == 1)
 
   act <- quasi_label(enquo(object), arg = "object")
+  expect_length_impl_(act, n)
+}
+
+expect_length_impl_ <- function(act, n) {
   act$n <- length(act$val)
 
   expect(
     act$n == n,
-    sprintf("%s has length %i, not length %i.", act$lab, act$n, n)
+    sprintf("%s has length %i, not length %i.", act$lab, act$n, n),
+    trace_env = parent.frame()
   )
 
   invisible(act$val)

R/expect-shape.R

@@ -0,0 +1,76 @@
+#' Does code return an object with the specified shape?
+#'
+#' This is a generalization of [expect_length()] to test the "shape" of
+#' more general objects like data.frames, matrices, and arrays.
+#'
+#' @seealso [expect_length()] to specifically make assertions about the
+#'   [length()] of a vector.
+#' @inheritParams expect_that
+#' @param ... Ignored.
+#' @param length Expected [length()] of `object`.
+#' @param nrow,nrow Expected [nrow()]/[ncol()] of `object`.
+#' @param dim Expected [dim()] of `object`.
+#' @family expectations
+#' @export
+#' @examples
+#' x <- matrix(1:9, nrow = 3)
+#' expect_shape(x, length = 9)
+#' expect_shape(x, nrow = 3)
+#' expect_shape(x, ncol = 3)
+#' expect_shape(x, dim = c(3, 3))
+expect_shape = function(object, ..., length, nrow, ncol, dim) {
+  check_dots_empty()
+  check_exclusive(length, nrow, ncol, dim)
+  act <- quasi_label(enquo(object), arg = "object")
+
+  # Re-use expect_length() to ensure they stay in sync.
+  if (!missing(length)) {
+    return(expect_length_impl_(act, length))
+  }
+  # now that we've handled the length argument, revert to usual base function
+  length <- base::length
+
+  dim_object <- base::dim(object)
+  if (is.null(dim_object)) {
+    fail(sprintf("%s has no dimensions.", act$lab))
+  }
+
+  if (!missing(nrow)) {
+    check_number_whole(nrow, allow_na = TRUE)
+    act$nrow <- dim_object[1L]
+
+    expect(
+      identical(as.integer(act$nrow), as.integer(nrow)),
+      sprintf("%s has %i rows, not %i.", act$lab, act$nrow, nrow)
+    )
+  } else if (!missing(ncol)) {
+    check_number_whole(ncol, allow_na = TRUE)
+
+    if (length(dim_object) == 1L) {
+      fail(sprintf("%s has only one dimension.", act$lab))
+    }
+  
+    act$ncol <- dim_object[2L]
+
+    expect(
+      identical(as.integer(act$ncol), as.integer(ncol)),
+      sprintf("%s has %i columns, not %i.", act$lab, act$ncol, ncol)
+    )
+  } else { # !missing(dim)
+    if (!is.numeric(dim) && !is.integer(dim)) {
+      stop_input_type(dim, "a numeric vector")
+    }
+    act$dim <- dim_object
+
+    if (length(act$dim) != length(dim)) {
+      fail(sprintf("%s has %i dimensions, not %i.", act$lab, length(act$dim), length(dim)))
+    }
+
+    expect(
+      identical(as.integer(act$dim), as.integer(dim)),
+      sprintf("%s has dim (%s), not (%s).", act$lab, toString(act$dim), toString(dim))
+    )
+  }
+
+  invisible(act$val)
+}

_pkgdown.yml

@@ -26,6 +26,7 @@ reference:
 - subtitle: Vectors
   contents:
   - expect_length
+  - expect_shape
   - expect_gt
   - expect_match
   - expect_named