Extend expect_length to use an S4 object's length method, if exists

NEWS.md

@@ -113,6 +113,8 @@
 
 * Clarified `skip` semantics in documentation (@brodieG)
 
+* Extend `expect_length()` to work with any object that has a `length` method (#564, @nealrichardson)
+
 # testthat 1.0.2
 
 * Ensure `std::logic_error()` constructed with `std::string()`

R/expect-length.R

@@ -15,18 +15,10 @@ expect_length <- function(object, n) {
   stopifnot(is.numeric(n), length(n) == 1)
   lab <- label(object)
 
-  if (!is_vector(object)) {
-    fail(sprintf("%s is not a vector.", lab))
-  }
-
   expect(
     length(object) == n,
     sprintf("%s has length %i, not length %i.", lab, length(object), n)
   )
 
   invisible(object)
 }
-
-is_vector <- function(x) {
-  typeof(x) %in% c("logical", "integer", "double", "complex", "character", "raw", "list")
-}

tests/testthat/test-expect-length.R

@@ -1,12 +1,16 @@
 context("expect_length")
 
-test_that("fails if not a vector", {
-  expect_failure(expect_length(environment(), 1), "not a vector")
-})
-
 test_that("length computed correctly", {
   expect_success(expect_length(1, 1))
-  expect_failure(expect_length(1, 2))
+  expect_failure(expect_length(1, 2), "has length 1, not length 2.")
+  expect_success(expect_length(1:10, 10))
+  expect_success(expect_length(letters[1:5], 5))
+})
+
+test_that("uses S4 length method", {
+  A <- setClass("ExpectLengthA", slots=c(x="numeric", y="numeric"))
+  setMethod("length", "ExpectLengthA", function (x) 5L)
+  expect_success(expect_length(A(x=1:9, y=3), 5))
 })
 
 test_that("returns input", {