Make S7_inherits() more flexible

R/inherits.R

@@ -1,13 +1,15 @@
 #' Does this object inherit from an S7 class?
 #'
 #' * `S7_inherits()` returns `TRUE` or `FALSE`.
-#' * `check_is_S7()` throws an error.
+#' * `check_is_S7()` throws an error if `x` isn't the specified `class`.
 #'
 #' @param x An object
-#' @param class An S7 class. Can be omitted in `check_is_S7()`.
+#' @param class An S7 class or `NULL`. If `NULL`, tests whether `x` is an
+#'   S7 object without testing for a specific class.
 #' @param arg Argument name used in error message.
-#' @returns `S7_inherits()` returns a single `TRUE` or `FALSE`;
-#'   `check_is_S7()` returns nothing; it's called for its side-effects.
+#' @returns
+#' * `S7_inherits()` returns a single `TRUE` or `FALSE`.
+#' * `check_is_S7()` returns nothing; it's called for its side-effects.
 #' @export
 #' @examples
 #' foo1 <- new_class("foo1")
@@ -19,12 +21,13 @@
 #'
 #' S7_inherits(foo1(), foo2)
 #' try(check_is_S7(foo1(), foo2))
-S7_inherits <- function(x, class) {
-  if (!inherits(class, "S7_class")) {
-    stop("`class` is not an <S7_class>")
+S7_inherits <- function(x, class = NULL) {
+  if (!inherits(class, "S7_class") && !is.null(class)) {
+    stop("`class` must be an <S7_class> or NULL")
   }
 
-  inherits(x, "S7_object") && inherits(x, S7_class_name(class))
+  inherits(x, "S7_object") &&
+    (is.null(class) || inherits(x, S7_class_name(class)))
 }
 
 #' @export

tests/testthat/_snaps/inherits.md

@@ -3,7 +3,7 @@
     Code
       S7_inherits(1:10, "x")
     Error <simpleError>
-      `class` is not an <S7_class>
+      `class` must be an <S7_class> or NULL
 
 # throws informative error
 

tests/testthat/test-inherits.R

@@ -2,9 +2,11 @@ test_that("it works", {
   foo1 <- new_class("foo1")
   foo2 <- new_class("foo2", parent = foo1)
 
+  expect_true(S7_inherits(foo1(), NULL))
   expect_true(S7_inherits(foo1(), foo1))
   expect_true(S7_inherits(foo2(), foo1))
   expect_false(S7_inherits(foo1(), foo2))
+  expect_false(S7_inherits(1, NULL))
 })
 
 test_that("checks that input is a class", {