Use fail() + early return, which exposed faulty logic

Author: MichaelChirico

R/expect-shape.R

@@ -28,10 +28,9 @@ expect_shape = function(object, ..., length, nrow, ncol, dim) {
   act <- quasi_label(enquo(object), arg = "object")
   dim_object <- base::dim(object)
 
-  expect(
-    !is.null(dim_object),
-    sprintf("%s has no dimensions.", act$lab)
-  )
+  if (is.null(dim_object)) {
+    return(fail(sprintf("%s has no dimensions.", act$lab)))
+  }
 
   if (!missing(nrow)) {
     act$nrow <- dim_object[1L]
@@ -41,11 +40,10 @@ expect_shape = function(object, ..., length, nrow, ncol, dim) {
       sprintf("%s has %i rows, not %i.", act$lab, act$nrow, nrow)
     )
   } else if (!missing(ncol)) {
-    expect(
-      length(dim_object) >= 2L,
-      sprintf("%s has only one dimension.", act$lab)
-    )
-
+    if (length(dim_object) == 1L) {
+      return(fail(sprintf("%s has only one dimension.", act$lab)))
+    }
+  
     act$ncol <- dim_object[2L]
 
     expect(
@@ -55,14 +53,13 @@ expect_shape = function(object, ..., length, nrow, ncol, dim) {
   } else { # !missing(dim)
     act$dim <- dim_object
 
-    expect(
-      length(act$dim) == length(dim),
-      sprintf("%s has %i dimensions, not %i", act$lab, length(act$dim), length(dim))
-    )
+    if (length(act$dim) != length(dim)) {
+      return(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 shape (%s), not (%s).", act$lab, toString(act$dim), toString(dim))
+      sprintf("%s has dim (%s), not (%s).", act$lab, toString(act$dim), toString(dim))
     )
   }
 }

tests/testthat/_snaps/expect-shape.md

@@ -36,7 +36,7 @@
 
 ---
 
-    array() has only one dimension.
+    array(integer()) has only one dimension.
 
 # NA handling (e.g. dbplyr)
 

tests/testthat/test-expect-shape.R

@@ -14,7 +14,7 @@ test_that("dim compared correctly", {
   expect_success(expect_shape(array(dim = 1:3), dim = 1:3))
   expect_snapshot_failure(expect_shape(array(dim = 1:3), dim = 1:2))
   expect_snapshot_failure(expect_shape(array(dim = 1:3), dim = 1:4))
-  expect_success(expect_shape(array(), dim = 0L))
+  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))
 })
@@ -24,7 +24,7 @@ test_that("nrow compared correctly", {
   expect_snapshot_failure(expect_shape(matrix(nrow = 5, ncol = 5), nrow = 6L))
   expect_success(expect_shape(data.frame(1:10, 11:20), nrow = 10L))
   expect_snapshot_failure(expect_shape(1, nrow = 1))
-  expect_success(expect_shape(array(), nrow = 0L))
+  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))
 })
@@ -34,7 +34,7 @@ test_that("ncol compared correctly", {
   expect_snapshot_failure(expect_shape(matrix(nrow = 5, ncol = 5), ncol = 7L))
   expect_success(expect_shape(data.frame(1:10, 11:20), ncol = 2L))
   expect_snapshot_failure(expect_shape(array(1), ncol = 1))
-  expect_snapshot_failure(expect_shape(array(), ncol = 0L))
+  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))
 })