Robustness: dim() can return NA

Author: MichaelChirico

R/expect-shape.R

@@ -37,7 +37,7 @@ expect_shape = function(object, ..., length, nrow, ncol, dim) {
     act$nrow <- dim_object[1L]
 
     expect(
-      act$nrow == nrow,
+      identical(as.integer(act$nrow), as.integer(nrow)),
       sprintf("%s has %i rows, not %i.", act$lab, act$nrow, nrow)
     )
   } else if (!missing(ncol)) {
@@ -49,7 +49,7 @@ expect_shape = function(object, ..., length, nrow, ncol, dim) {
     act$ncol <- dim_object[2L]
 
     expect(
-      act$ncol == ncol,
+      identical(as.integer(act$ncol), as.integer(ncol)),
       sprintf("%s has %i columns, not %i.", act$lab, act$ncol, ncol)
     )
   } else { # !missing(dim)
@@ -61,7 +61,7 @@ expect_shape = function(object, ..., length, nrow, ncol, dim) {
     )
 
     expect(
-      isTRUE(all(act$dim == dim)),
+      identical(as.integer(act$dim), as.integer(dim)),
       sprintf("%s has shape (%s), not (%s).", act$lab, toString(act$dim), toString(dim))
     )
   }

tests/testthat/_snaps/expect-shape.md

@@ -38,6 +38,18 @@
 
     array() has only one dimension.
 
+# NA handling (e.g. dbplyr)
+
+    `x` has NA rows, not 10.
+
+---
+
+    `x` has 10 columns, not NA.
+
+---
+
+    `x` has shape (NA, 10), not (10, NA).
+
 # at least one argument is required
 
     Code

tests/testthat/test-expect-shape.R

@@ -43,9 +43,26 @@ test_that("uses S3 dim method", {
   dim.testthat_expect_shape <- function(x) 1:2
   x <- integer()
   class(x) <- "testthat_expect_shape"
+  registerS3method("dim", "testthat_expect_shape", dim.testthat_expect_shape)
+
   expect_success(expect_shape(x, dim = 1:2))
 })
 
+test_that("NA handling (e.g. dbplyr)", {
+  dim.testthat_expect_shape_missing <- function(x) c(NA_integer_, 10L)
+  x <- integer()
+  class(x) <- "testthat_expect_shape_missing"
+  registerS3method("dim", "testthat_expect_shape_missing", dim.testthat_expect_shape_missing)
+
+  expect_success(expect_shape(x, nrow = NA_integer_))
+  expect_success(expect_shape(x, ncol = 10L))
+  expect_success(expect_shape(x, dim = c(NA_integer_, 10L)))
+
+  expect_snapshot_failure(expect_shape(x, nrow = 10L))
+  expect_snapshot_failure(expect_shape(x, ncol = NA_integer_))
+  expect_snapshot_failure(expect_shape(x, dim = c(10L, NA_integer_)))
+})
+
 test_that("uses S4 dim method", {
   A <- setClass("ExpectShapeA", slots = c(x = "numeric", y = "numeric"))
   setMethod("dim", "ExpectShapeA", function(x) 8:10)