From ebbb5208b73ea2d9a5000cb8ff0d7c3796daa881 Mon Sep 17 00:00:00 2001 From: Neal Richardson Date: Sat, 21 Jan 2017 10:24:57 -0800 Subject: [PATCH 1/6] Patch junit.txt to match a recent change in xml2 --- tests/testthat/reporters/junit.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/reporters/junit.txt b/tests/testthat/reporters/junit.txt index da329c00e..2c88672b4 100644 --- a/tests/testthat/reporters/junit.txt +++ b/tests/testthat/reporters/junit.txt @@ -1,4 +1,4 @@ - + From a44d313f6664ced787bf0447edfbfe1f3a1dd0ca Mon Sep 17 00:00:00 2001 From: Neal Richardson Date: Mon, 23 Jan 2017 21:43:28 -0800 Subject: [PATCH 2/6] Extend expect_length to use an S4 object's length method, if exists --- NAMESPACE | 1 + R/expect-length.R | 14 +++++++++---- tests/testthat/test-expect-length.R | 32 ++++++++++++++++++++++++++--- 3 files changed, 40 insertions(+), 7 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 2e1a7be68..62698bfd1 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -137,6 +137,7 @@ importFrom(crayon,green) importFrom(crayon,red) importFrom(crayon,yellow) importFrom(magrittr,"%>%") +importFrom(methods,selectMethod) useDynLib(testthat,duplicate_) useDynLib(testthat,find_label_) useDynLib(testthat,reassign_function) diff --git a/R/expect-length.R b/R/expect-length.R index 49419b2f8..3c7eb30bb 100644 --- a/R/expect-length.R +++ b/R/expect-length.R @@ -15,8 +15,8 @@ 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)) + if (!has_length(object)) { + fail(sprintf("%s does not have a defined length.", lab)) } expect( @@ -27,6 +27,12 @@ expect_length <- function(object, n) { invisible(object) } -is_vector <- function(x) { - typeof(x) %in% c("logical", "integer", "double", "complex", "character", "raw", "list") +#' @importFrom methods selectMethod +has_length <- function(x) { + # We can assert the length of objects that either are/inherit from base R + # classes that have length defined, or are S4 objects that have a length + # method defined. For an S4 object without a length method, the .Primitive + # length function will always return 1, which could be misleading. + typeof(x) %in% c("logical", "integer", "double", "complex", "character", "raw", "list") || + (isS4(x) && !identical(selectMethod(length, class(x)), length)) } diff --git a/tests/testthat/test-expect-length.R b/tests/testthat/test-expect-length.R index 71b59279e..2e78bab6c 100644 --- a/tests/testthat/test-expect-length.R +++ b/tests/testthat/test-expect-length.R @@ -1,12 +1,38 @@ context("expect_length") -test_that("fails if not a vector", { - expect_failure(expect_length(environment(), 1), "not a vector") +test_that("fails if not a vector or object with defined length method", { + expect_failure(expect_length(environment(), 1), + "does not have a defined length") }) 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, if exists", { + # A has no length method defined + A <- setClass("ExpectLengthA", slots=c(x="numeric")) + expect_failure(expect_length(A(x=1:5), 5), + "does not have a defined length") + # Even though 'length' does not fail on an A + expect_identical(length(A(x=1:5)), 1L) + + # B does has a length method defined + B <- setClass("ExpectLengthB", slots=c(x="numeric")) + setMethod("length", "ExpectLengthB", function (x) 5L) + expect_success(expect_length(B(x=1:8), 5)) + + # C does not, but it inherits from something that does + C <- setClass("ExpectLengthC", contains="list") + expect_success(expect_length(C(), 0)) + expect_success(expect_length(C(1:10), 10)) + + # D does not explicitly have one, but it inherits from B, which does + D <- setClass("ExpectLengthD", contains="ExpectLengthB") + expect_success(expect_length(D(x=1:8), 5)) }) test_that("returns input", { From 7f86317756ecca2dc44ba9a31fce4c9dd33b2dcf Mon Sep 17 00:00:00 2001 From: Neal Richardson Date: Sun, 1 Oct 2017 21:04:01 -0700 Subject: [PATCH 3/6] Remove check for existence of length method in expect_length --- DESCRIPTION | 1 - NAMESPACE | 1 - R/expect-length.R | 14 -------------- tests/testthat/test-expect-length.R | 13 +++---------- 4 files changed, 3 insertions(+), 26 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index be3e86ea3..adfdec732 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -19,7 +19,6 @@ Imports: praise, magrittr, R6 (>= 2.2.0), - methods, xml2 Suggests: devtools, diff --git a/NAMESPACE b/NAMESPACE index 6e7063dc5..94d51b970 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -138,7 +138,6 @@ importFrom(crayon,green) importFrom(crayon,red) importFrom(crayon,yellow) importFrom(magrittr,"%>%") -importFrom(methods,selectMethod) useDynLib(testthat,duplicate_) useDynLib(testthat,find_label_) useDynLib(testthat,reassign_function) diff --git a/R/expect-length.R b/R/expect-length.R index 3c7eb30bb..017de6eb5 100644 --- a/R/expect-length.R +++ b/R/expect-length.R @@ -15,10 +15,6 @@ expect_length <- function(object, n) { stopifnot(is.numeric(n), length(n) == 1) lab <- label(object) - if (!has_length(object)) { - fail(sprintf("%s does not have a defined length.", lab)) - } - expect( length(object) == n, sprintf("%s has length %i, not length %i.", lab, length(object), n) @@ -26,13 +22,3 @@ expect_length <- function(object, n) { invisible(object) } - -#' @importFrom methods selectMethod -has_length <- function(x) { - # We can assert the length of objects that either are/inherit from base R - # classes that have length defined, or are S4 objects that have a length - # method defined. For an S4 object without a length method, the .Primitive - # length function will always return 1, which could be misleading. - typeof(x) %in% c("logical", "integer", "double", "complex", "character", "raw", "list") || - (isS4(x) && !identical(selectMethod(length, class(x)), length)) -} diff --git a/tests/testthat/test-expect-length.R b/tests/testthat/test-expect-length.R index 2e78bab6c..79bcf3727 100644 --- a/tests/testthat/test-expect-length.R +++ b/tests/testthat/test-expect-length.R @@ -1,10 +1,5 @@ context("expect_length") -test_that("fails if not a vector or object with defined length method", { - expect_failure(expect_length(environment(), 1), - "does not have a defined length") -}) - test_that("length computed correctly", { expect_success(expect_length(1, 1)) expect_failure(expect_length(1, 2), "has length 1, not length 2.") @@ -14,11 +9,9 @@ test_that("length computed correctly", { test_that("uses S4 length method, if exists", { # A has no length method defined - A <- setClass("ExpectLengthA", slots=c(x="numeric")) - expect_failure(expect_length(A(x=1:5), 5), - "does not have a defined length") - # Even though 'length' does not fail on an A - expect_identical(length(A(x=1:5)), 1L) + A <- setClass("ExpectLengthA", slots=c(x="numeric", y="numeric")) + # Default for S4 objects that don't inherit a length method: always length 1 + expect_success(expect_length(A(x=1:5, y=3), 1)) # B does has a length method defined B <- setClass("ExpectLengthB", slots=c(x="numeric")) From c60f658f466805e9700758d738da6c1b99128ff1 Mon Sep 17 00:00:00 2001 From: Neal Richardson Date: Sun, 1 Oct 2017 21:08:53 -0700 Subject: [PATCH 4/6] Add back methods package in Imports --- DESCRIPTION | 1 + 1 file changed, 1 insertion(+) diff --git a/DESCRIPTION b/DESCRIPTION index adfdec732..be3e86ea3 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -19,6 +19,7 @@ Imports: praise, magrittr, R6 (>= 2.2.0), + methods, xml2 Suggests: devtools, From fadf3dfe5439223f3fde5e0c8dc90fb216963d8a Mon Sep 17 00:00:00 2001 From: Neal Richardson Date: Mon, 2 Oct 2017 09:12:48 -0700 Subject: [PATCH 5/6] Prune expect_length S4 test --- tests/testthat/test-expect-length.R | 21 +++------------------ 1 file changed, 3 insertions(+), 18 deletions(-) diff --git a/tests/testthat/test-expect-length.R b/tests/testthat/test-expect-length.R index 79bcf3727..24fdc81ab 100644 --- a/tests/testthat/test-expect-length.R +++ b/tests/testthat/test-expect-length.R @@ -7,25 +7,10 @@ test_that("length computed correctly", { expect_success(expect_length(letters[1:5], 5)) }) -test_that("uses S4 length method, if exists", { - # A has no length method defined +test_that("uses S4 length method", { A <- setClass("ExpectLengthA", slots=c(x="numeric", y="numeric")) - # Default for S4 objects that don't inherit a length method: always length 1 - expect_success(expect_length(A(x=1:5, y=3), 1)) - - # B does has a length method defined - B <- setClass("ExpectLengthB", slots=c(x="numeric")) - setMethod("length", "ExpectLengthB", function (x) 5L) - expect_success(expect_length(B(x=1:8), 5)) - - # C does not, but it inherits from something that does - C <- setClass("ExpectLengthC", contains="list") - expect_success(expect_length(C(), 0)) - expect_success(expect_length(C(1:10), 10)) - - # D does not explicitly have one, but it inherits from B, which does - D <- setClass("ExpectLengthD", contains="ExpectLengthB") - expect_success(expect_length(D(x=1:8), 5)) + setMethod("length", "ExpectLengthA", function (x) 5L) + expect_success(expect_length(A(x=1:9, y=3), 5)) }) test_that("returns input", { From 6a6ad6e48cfb7e120f16f3e3ef623a9da8d2661d Mon Sep 17 00:00:00 2001 From: Neal Richardson Date: Mon, 2 Oct 2017 09:43:29 -0700 Subject: [PATCH 6/6] Add news bullet for #564 --- NEWS.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/NEWS.md b/NEWS.md index 5577b750c..d4bdfcdfa 100644 --- a/NEWS.md +++ b/NEWS.md @@ -111,6 +111,8 @@ * New JUnit reporter `JunitReporter`. (#481, @lbartnik) +* 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()`