Don't get generic 'object' label by passing to expect_length(); correct return values & corresponding tests

Author: MichaelChirico

R/expect-length.R

@@ -17,6 +17,10 @@ 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(

R/expect-shape.R

@@ -17,15 +17,16 @@
 expect_shape = function(object, ..., length, nrow, ncol, dim) {
   rlang::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(object, length))
+    return(expect_length_impl_(act, length))
   }
 
   # need base:: qualification or we might trigger an error for missing(length)
   length <- base::length
 
-  act <- quasi_label(enquo(object), arg = "object")
   dim_object <- base::dim(object)
 
   if (is.null(dim_object)) {
@@ -62,4 +63,6 @@ expect_shape = function(object, ..., length, nrow, ncol, dim) {
       sprintf("%s has dim (%s), not (%s).", act$lab, toString(act$dim), toString(dim))
     )
   }
+
+  invisible(act$val)
 }

tests/testthat/_snaps/expect-shape.md

@@ -1,6 +1,6 @@
 # length compared correctly
 
-    `object` has length 1, not length 2.
+    1 has length 1, not length 2.
 
 # dim compared correctly
 

tests/testthat/test-expect-shape.R

@@ -4,6 +4,10 @@ test_that("length compared correctly", {
   expect_success(expect_shape(1:10, length = 10))
   expect_success(expect_shape(letters[1:5], length = 5))
   expect_success(expect_shape(integer(), length = 0))
+
+  x <- list(1:10, letters)
+  out <- expect_shape(x, length = 2)
+  expect_identical(out, x)
 })
 
 test_that("dim compared correctly", {
@@ -17,6 +21,10 @@ test_that("dim compared correctly", {
   expect_success(expect_shape(array(integer()), dim = 0L))
   dd <- c(0L, 0L, 0L, 5L, 0L, 0L, 0L)
   expect_success(expect_shape(array(dim = dd), dim = dd))
+
+  x <- cbind(1:2, 3:4)
+  out <- expect_shape(x, dim = c(2L, 2L))
+  expect_identical(out, x)
 })
 
 test_that("nrow compared correctly", {
@@ -27,6 +35,10 @@ test_that("nrow compared correctly", {
   expect_success(expect_shape(array(integer()), nrow = 0L))
   dd <- c(0L, 0L, 0L, 5L, 0L, 0L, 0L)
   expect_success(expect_shape(array(dim = dd), nrow = 0L))
+
+  x <- cbind(1:2, 3:4)
+  out <- expect_shape(x, dim = c(2L, 2L))
+  expect_identical(out, x)
 })
 
 test_that("ncol compared correctly", {
@@ -37,6 +49,10 @@ test_that("ncol compared correctly", {
   expect_snapshot_failure(expect_shape(array(integer()), ncol = 0L))
   dd <- c(0L, 0L, 0L, 5L, 0L, 0L, 0L)
   expect_success(expect_shape(array(dim = dd), ncol = 0L))
+
+  x <- cbind(1:2, 3:4)
+  out <- expect_shape(x, dim = c(2L, 2L))
+  expect_identical(out, x)
 })
 
 test_that("uses S3 dim method", {
@@ -69,12 +85,6 @@ test_that("uses S4 dim method", {
   expect_success(expect_shape(A(x = 1:9, y = 3), dim = 8:10))
 })
 
-test_that("returns input", {
-  x <- list(1:10, letters)
-  out <- expect_shape(x, length = 2)
-  expect_identical(out, x)
-})
-
 test_that("at least one argument is required", {
   err_msg <- "Exactly one of `length`, `nrow`, `ncol`, or `dim` must be provided."
   expect_snapshot(expect_shape(1:10), error = TRUE) # no args