Only report the first class in obj_type_friendly() (#1622)

* Only report the first class in `obj_type_friendly()`

* NEWS bullet

NEWS.md

@@ -1,5 +1,7 @@
 # rlang (development version)
 
+* `obj_type_friendly()` now only displays the first class of S3 objects (#1622).
+
 # rlang 1.1.1
 
 * `englue()` now allows omitting `{{`. This is to make it easier to

R/standalone-obj-type.R

@@ -1,13 +1,16 @@
 # ---
 # repo: r-lib/rlang
 # file: standalone-obj-type.R
-# last-updated: 2023-03-30
+# last-updated: 2023-05-01
 # license: https://unlicense.org
 # imports: rlang (>= 1.1.0)
 # ---
 #
 # ## Changelog
 #
+# 2023-05-01:
+# - `obj_type_friendly()` now only displays the first class of S3 objects.
+#
 # 2023-03-30:
 # - `stop_input_type()` now handles `I()` input literally in `arg`.
 #
@@ -64,7 +67,7 @@ obj_type_friendly <- function(x, value = TRUE) {
     if (inherits(x, "quosure")) {
       type <- "quosure"
     } else {
-      type <- paste(class(x), collapse = "/")
+      type <- class(x)[[1L]]
     }
     return(sprintf("a <%s> object", type))
   }

tests/testthat/_snaps/cnd-signal.md

@@ -63,19 +63,19 @@
     Output
       <error/rlang_error>
       Error in `abort()`:
-      ! `message` must be a character vector, not a <foo/rlang_error/error/condition> object.
+      ! `message` must be a character vector, not a <foo> object.
     Code
       (expect_error(inform(error_cnd("foo"))))
     Output
       <error/rlang_error>
       Error in `inform()`:
-      ! `message` must be a character vector, not a <foo/rlang_error/error/condition> object.
+      ! `message` must be a character vector, not a <foo> object.
     Code
       (expect_error(warn(class = error_cnd("foo"))))
     Output
       <error/rlang_error>
       Error in `warn()`:
-      ! `class` must be a character vector, not a <foo/rlang_error/error/condition> object.
+      ! `class` must be a character vector, not a <foo> object.
     Code
       (expect_error(abort("foo", call = base::call)))
     Output

tests/testthat/test-friendly-type.R

@@ -10,6 +10,11 @@ test_that("obj_type_friendly() supports objects", {
   ))
 })
 
+test_that("obj_type_friendly() only displays the first class of objects", {
+  x <- structure(1, class = c("subclass", "class"))
+  expect_identical(obj_type_friendly(x), "a <subclass> object")
+})
+
 test_that("obj_type_friendly() supports matrices and arrays (#141)", {
   expect_true(all(friendly_types(matrix(list(1, 2))) == "a list matrix"))
   expect_true(all(friendly_types(array(list(1, 2, 3), dim = 1:3)) == "a list array"))