Add convert() fallback to base as.* methods

NEWS.md

@@ -5,6 +5,7 @@
 * Internal changes to support R-devel (4.6) (#592, #593, #598, #600).
 * Method dispatch on `class_missing` now correctly handles missing arguments forwarded through a wrapper functions (#595).
 * `S7_error_method_not_found` now has a correct class vector without a duplicate `"error"` entry (@jjjermiah, #604).
+* `convert()` now falls back to the corresponding `as.*()` function (e.g. `as.character()`) when converting to a base type like `class_character` and no method or inheritance-based default applies, so `convert(1, class_character)` works out of the box (#472).
 * `convert()` no longer errors when `from` is a base or S3 object and `to` is an S7 class that inherits from `from`'s class. The base/S3 value is now passed as `.data` to the `to` constructor (#537).
 * `method<-` now gives a clear error when assigning a primitive function (e.g. `log`) as a method (#608).
 * `method<-` and `method()` now accept a length-1 list as `signature` for single-dispatch generics, matching the list-of-classes form required for multi-dispatch (#555).

R/base.R

@@ -84,6 +84,27 @@ base_S7_class <- function(x) {
 
 is_base_class <- function(x) inherits(x, "S7_base_class")
 
+# Default coercion to a base type via the corresponding `as.*()`. `convert()`
+# uses this as a last resort, so a base type target works without a registered
+# method, but only after any user method and the inheritance-based defaults.
+base_coerce <- function(from, to, ...) {
+  switch(
+    to$class,
+    logical = as.logical(from, ...),
+    integer = as.integer(from, ...),
+    double = as.double(from, ...),
+    complex = as.complex(from, ...),
+    character = as.character(from, ...),
+    raw = as.raw(from, ...),
+    list = as.list(from, ...),
+    expression = as.expression(from, ...),
+    name = as.name(from, ...),
+    call = as.call(from, ...),
+    `function` = as.function(from, ...),
+    environment = as.environment(from, ...)
+  )
+}
+
 #' @export
 print.S7_base_class <- function(x, ...) {
   cat("<S7_base_class>: ", class_desc(x), "\n", sep = "")

R/convert.R

@@ -16,13 +16,18 @@
 #'   to work because those methods will return `classParent` objects, not
 #'   `classChild` objects.
 #'
-#' `convert()` provides two default implementations:
+#' `convert()` provides three default implementations:
 #'
 #' 1. When `from` inherits from `to`, it strips any properties that `from`
 #'    possesses that `to` does not (upcasting).
 #' 2. When `to` inherits from `from`, it creates a new object of class `to`,
 #'    copying over existing properties from `from` and initializing new
 #'    properties of `to` (downcasting).
+#' 3. When `to` is a base type (e.g. [class_integer] or [class_character]) and
+#'    neither of the above apply, it calls the corresponding `as.*()` function
+#'    (e.g. `as.integer()` or `as.character()`). This mirrors the convention
+#'    that `as.*()` coercion sits below `convert()`, so you can rely on it as a
+#'    fallback but still override it with a more specific method.
 #'
 #' If you are converting an object solely for the purposes of accessing a method
 #' on a superclass, you probably want [super()] instead. See its docs for more
@@ -55,6 +60,10 @@
 #' convert(Foo1(x = 1L), to = Foo2, y = 2.5)  # Set new property
 #' convert(Foo1(x = 1L), to = Foo2, x = 2L, y = 2.5)  # Override existing and set new
 #'
+#' # Converting to a base type falls back to the corresponding `as.*()`:
+#' convert(1.5, to = class_character)
+#' convert(c("1", "2"), to = class_integer)
+#'
 #' # For all other cases, you'll need to provide your own.
 #' try(convert(Foo1(x = 1L), to = class_integer))
 #'
@@ -87,6 +96,8 @@ convert <- function(from, to, ...) {
     convert_up(from, to)
   } else if (is_down_cast(from, to)) {
     convert_down(from, to, ...)
+  } else if (is_base_class(to)) {
+    base_coerce(from, to, ...)
   } else {
     msg <- paste_c(
       "Can't find method with dispatch classes:\n",

tests/testthat/_snaps/convert.md

@@ -3,8 +3,6 @@
     Code
       convert(obj, to = class_double)
     Condition
-      Error in `convert()`:
-      ! Can't find method with dispatch classes:
-      - from: <converttest>
-      - to  : <double>
+      Error in `as.double()`:
+      ! cannot coerce type 'object' to vector of type 'double'
 

tests/testthat/test-convert.R

@@ -17,7 +17,12 @@ test_that("can register convert methods", {
   expect_equal(convert(obj, to = class_integer), "i")
 
   # Errors if none found
-  expect_snapshot(convert(obj, to = class_double), error = TRUE)
+  expect_snapshot(
+    convert(obj, to = class_double),
+    error = TRUE,
+    # for < 4.4.0
+    transform = \(x) gsub("'S4'", "'object'", x)
+  )
 })
 
 test_that("doesn't convert to subclass", {
@@ -122,43 +127,31 @@ describe("fallback convert", {
     expect_false(S7_inherits(obj))
     expect_equal(attr(obj, "x"), NULL)
   })
+})
 
-  it("can convert base type to S7 subclass (#537)", {
-    my_logical <- new_class(
-      "my_logical",
-      parent = class_logical,
-      package = NULL
-    )
-    expect_equal(convert(TRUE, my_logical), my_logical(TRUE))
-
-    my_logical2 <- new_class(
-      "my_logical2",
-      parent = class_logical,
-      properties = list(x = class_integer),
-      package = NULL
-    )
-    expect_equal(
-      convert(TRUE, my_logical2, x = 42L),
-      my_logical2(TRUE, x = 42L)
-    )
-  })
-
-  it("can convert S3 object to S7 subclass", {
-    my_factor <- new_class("my_factor", parent = class_factor, package = NULL)
-    obj <- convert(factor(c("a", "b", "a")), my_factor)
-    expect_equal(obj, my_factor(c(1L, 2L, 1L), levels = c("a", "b")))
-  })
-
-  it("can convert base type to base class (#537)", {
-    obj <- convert(TRUE, class_logical)
-    expect_equal(obj, TRUE)
-  })
+test_that("convert() falls back to as.*() for base type targets (#472)", {
+  expect_identical(convert(1.5, class_character), "1.5")
+  expect_identical(convert(c("1", "2"), class_integer), c(1L, 2L))
+  expect_identical(convert(0:1, class_logical), c(FALSE, TRUE))
+  expect_identical(convert(1:2, class_double), c(1, 2))
+  expect_identical(convert(c("a", "b"), class_list), list("a", "b"))
+  expect_identical(convert("x", class_name), as.name("x"))
+})
 
-  it("can convert S3 object to its S3 class and underlying base class", {
-    obj <- convert(factor("a"), class_factor)
-    expect_equal(obj, structure(1L, levels = "a", class = "factor"))
+test_that("base type fallback sits below user methods and inheritance", {
+  local_methods(convert)
 
-    obj <- convert(factor("a"), class_integer)
-    expect_equal(obj, structure(1L, levels = "a"))
-  })
+  # A registered method wins over the as.*() fallback
+  Txt <- new_class("Txt", class_character, package = NULL)
+  method(convert, list(Txt, class_character)) <- function(from, to, ...) {
+    "custom"
+  }
+  expect_equal(convert(Txt("hi"), class_character), "custom")
+
+  # Upcasting to a base type strips the S7 wrapper rather than calling as.*()
+  method(convert, list(Txt, class_character)) <- NULL
+  obj <- convert(Txt("hi"), class_character)
+  expect_false(S7_inherits(obj))
+  expect_null(attributes(obj))
+  expect_identical(obj, "hi")
 })