allow unquoting first arg for expect_s4_class

r-lib · Mar 2, 2025 · ae4e39c · ae4e39c
1 parent 30f5b11
commit ae4e39c
Show file tree

Hide file tree

Showing 2 changed files with 8 additions and 2 deletions.
diff --git a/R/expect-inheritance.R b/R/expect-inheritance.R
@@ -125,7 +125,7 @@ expect_s7_class <- function(object, class) {
 #' @rdname inheritance-expectations
 expect_s4_class <- function(object, class) {
   act <- quasi_label(enquo(object), arg = "object")
-  act_val_lab <- format_class(methods::is(object))
+  act$class <- format_class(methods::is(act$val))
   exp_lab <- format_class(class)
 
   if (identical(class, NA)) {
@@ -139,7 +139,7 @@ expect_s4_class <- function(object, class) {
     } else {
       expect(
         methods::is(act$val, class),
-        sprintf("%s inherits from %s not %s.", act$lab, act_val_lab, exp_lab)
+        sprintf("%s inherits from %s not %s.", act$lab, act$class, exp_lab)
       )
     }
   } else {

diff --git a/tests/testthat/test-expect-inheritance.R b/tests/testthat/test-expect-inheritance.R
@@ -62,6 +62,12 @@ test_that("expect_s3_class allows unquoting of first argument", {
 })
 
 
+test_that("expect_s4_class allows unquoting of first argument", {
+  cls <- methods::setClass("new_class", slots = c("a" = "numeric"))
+  obj <- methods::new("new_class", a = 3)
+  expect_success(expect_s4_class(!! rlang::quo(obj), "new_class"))
+})
+
 # expect_s7_class --------------------------------------------------------
 
 test_that("checks its inputs", {