From b67507275e5e49eec7a920bca595ed79a091ff53 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Wed, 10 Jun 2026 11:03:35 -0500 Subject: [PATCH] Allow subclassing an external class with deferred resolution `new_class()` now accepts a `new_external_class()` as its `parent`. The child constructor takes the child's own properties plus `...`, which it forwards to the parent, so the external parent is only resolved the first time an object is constructed (not when the class is defined). This means a package can subclass a class from a soft dependency and still build and load when that dependency is absent. On first construction the class is rebuilt with the resolved parent (and the result cached), so inherited properties, validation, and dispatch all behave as if the parent had been known up front. Adds an in-process test plus a cross-package test (new fixture package t5, which subclasses ParentClass from soft dependency t1). Co-Authored-By: Claude Opus 4.8 (1M context) --- NEWS.md | 2 +- R/class.R | 4 +- R/constructor.R | 56 +++++++++++++++++++++++++ R/external-class.R | 9 ++++ man/new_external_class.Rd | 7 ++++ tests/testthat/_snaps/external-class.md | 25 +++++++++++ tests/testthat/t1/NAMESPACE | 1 + tests/testthat/t1/R/t1.R | 7 ++++ tests/testthat/t5/DESCRIPTION | 19 +++++++++ tests/testthat/t5/NAMESPACE | 3 ++ tests/testthat/t5/R/t5.R | 16 +++++++ tests/testthat/test-external-class.R | 42 +++++++++++++++++++ 12 files changed, 189 insertions(+), 2 deletions(-) create mode 100644 tests/testthat/t5/DESCRIPTION create mode 100644 tests/testthat/t5/NAMESPACE create mode 100644 tests/testthat/t5/R/t5.R diff --git a/NEWS.md b/NEWS.md index 03ace2a7..ee6f4722 100644 --- a/NEWS.md +++ b/NEWS.md @@ -18,7 +18,7 @@ * `method<-` can now register methods on S3 and S4 generics with base types (e.g. `class_character`), S3 classes (`new_S3_class()`, `class_factor`, etc.), S7 unions (expanded to one registration per class), `class_any` (registered as the `default` method), and `NULL` (registered as the `NULL` method) (#455). * `new_class()` now allows properties named `names`, `dim`, `dimnames`, `class`, `comment`, `tsp`, and `row.names`. But property names beginning with `_` are now reserved for internal use (#579). * `new_class()` experimentally allows `class_environment` as a parent again, so you can build S7 objects that share R's reference semantics for environments. This support is provisional: because environments are mutated in place, some operations behave differently than for value-typed S7 objects, and the API may change. `S7_data()` and `S7_data<-()` error on environment-based objects, since they would otherwise destroy the object's S7 attributes in place (#590). -* `new_external_class()` creates a delayed reference to an S7 class in another package (or your own package, but not yet defined). It is useful for registering methods on classes from suggested packages (#573) and for creating self-referential or mutually recursive classes (#250). +* `new_external_class()` creates a delayed reference to an S7 class in another package (or your own package, but not yet defined). It is useful for registering methods on classes from suggested packages (#573), for creating self-referential or mutually recursive classes (#250), and for subclassing a class from a soft dependency (the parent is only resolved when an object is constructed, so your package builds and loads even if the parent's package is absent). * `new_object()` now gives an informative error when `.parent` is a class specification rather than an instance of the parent class (#409). * `new_object()` no longer materialises ALTREP parent values (e.g. `seq_len()`), so constructing an S7 object that wraps a large compact integer sequence is now O(1) in memory instead of O(n) (@kschaubroeck, #607). * `new_object()` no longer re-runs property validators for properties inherited unchanged from an already-validated parent class, so constructing an instance of a deeply nested class hierarchy validates each property exactly once (#539). diff --git a/R/class.R b/R/class.R index 7bfa02c1..df5a8afa 100644 --- a/R/class.R +++ b/R/class.R @@ -248,7 +248,9 @@ c.S7_class <- function(...) { stop2("Can not combine S7 class objects.") } -can_inherit <- function(x) is_base_class(x) || is_S3_class(x) || is_class(x) +can_inherit <- function(x) { + is_base_class(x) || is_S3_class(x) || is_class(x) || is_external_class(x) +} check_can_inherit <- function( x, diff --git a/R/constructor.R b/R/constructor.R index 83cc88f7..dbc4c49a 100644 --- a/R/constructor.R +++ b/R/constructor.R @@ -5,6 +5,11 @@ new_constructor <- function( package = NULL ) { properties <- as_properties(properties) + + if (is_external_class(parent)) { + return(new_external_constructor(parent, properties, envir, package)) + } + arg_info <- constructor_args(parent, properties, envir, package) self_args <- as_names(names(arg_info$self), named = TRUE) @@ -97,6 +102,57 @@ constructor_args <- function( list(parent = parent_args, self = self_args) } +# Constructor for a class that inherits from an external class. The parent's +# package might not be loaded when the class is defined, so rather than inlining +# the parent's constructor arguments (which would require resolving the external +# class now), the constructor takes the child's own properties plus a `...` that +# is forwarded to the parent. The external class is only resolved the first time +# an object is constructed (when its package must be loaded anyway): at that +# point we rebuild the class with the resolved parent so that inherited +# properties, validation, and dispatch all behave as if the parent had been +# known up front. The completed class is cached for subsequent calls. +new_external_constructor <- function(parent, properties, envir, package) { + properties <- properties[!vlapply(properties, prop_is_read_only)] + self_args <- as.pairlist(lapply( + setNames(, names2(properties)), + function(name) prop_default(properties[[name]], envir, package) + )) + self_names <- as_names(names(self_args), named = TRUE) + + # Bind the resolver into the constructor's environment: the wrapper runs in + # the consumer's namespace, which only imports S7's *exported* functions, so + # this internal helper must be reachable lexically. + env <- new.env(parent = envir) + env$parent <- parent + env$completed <- NULL + env$complete_external_class <- complete_external_class + + body <- bquote( + { + if (is.null(completed)) { + completed <<- complete_external_class(sys.function(), parent) + } + completed(..(self_names), ...) + }, + splice = TRUE + ) + + new_function(c(self_args, alist(... = )), body, env) +} + +# Rebuild a class that inherits from an external `parent`, now that the parent's +# package is loaded and the external class can be resolved. +complete_external_class <- function(child, parent) { + new_class( + child@name, + parent = resolve_external_class_req(parent), + package = child@package, + properties = child@properties, + abstract = child@abstract, + validator = child@validator + ) +} + # helpers ----------------------------------------------------------------- diff --git a/R/external-class.R b/R/external-class.R index ce7d2555..8b043c24 100644 --- a/R/external-class.R +++ b/R/external-class.R @@ -25,6 +25,15 @@ #' new_class("tree", properties = list(child = NULL | tree_stub)) #' ``` #' +#' * To subclass a class from a soft dependency. The child constructor forwards +#' `...` to the parent, so the parent is only resolved when an object is +#' constructed (not when the class is defined), and your package builds and +#' loads even if the parent's package is absent. +#' +#' ```R +#' Child <- new_class("Child", parent = new_external_class("pkg", "Parent")) +#' ``` +#' #' Make sure to call [S7_on_load()] in your package's `.onLoad()` so that #' deferred method registrations fire when the relevant package is loaded. #' diff --git a/man/new_external_class.Rd b/man/new_external_class.Rd index b1816605..d9563e37 100644 --- a/man/new_external_class.Rd +++ b/man/new_external_class.Rd @@ -38,6 +38,13 @@ self-referential or mutually recursive class. \if{html}{\out{
}}\preformatted{tree_stub <- new_external_class("mypkg", "tree") new_class("tree", properties = list(child = NULL | tree_stub)) }\if{html}{\out{
}} +\item To subclass a class from a soft dependency. The child constructor forwards +\code{...} to the parent, so the parent is only resolved when an object is +constructed (not when the class is defined), and your package builds and +loads even if the parent's package is absent. + +\if{html}{\out{
}}\preformatted{Child <- new_class("Child", parent = new_external_class("pkg", "Parent")) +}\if{html}{\out{
}} } Make sure to call \code{\link[=S7_on_load]{S7_on_load()}} in your package's \code{.onLoad()} so that diff --git a/tests/testthat/_snaps/external-class.md b/tests/testthat/_snaps/external-class.md index 64dbe751..a8280d7c 100644 --- a/tests/testthat/_snaps/external-class.md +++ b/tests/testthat/_snaps/external-class.md @@ -49,3 +49,28 @@ ! object properties are invalid: - @child must be or , not +# can subclass an external class without resolving it (in process) + + Code + Child(x = 1) + Condition + Error: + ! Can't find external class : package 'not_a_pkg' is not installed. + +# can subclass an external class with deferred resolution + + Code + t5::ChildClass(child_prop = "a", parent_prop = "b") + Condition + Error: + ! Can't find external class : package 't1' is not installed. + +--- + + Code + t5::ChildClass(child_prop = "a", parent_prop = 1) + Condition + Error in `ParentClass()`: + ! object properties are invalid: + - @parent_prop must be , not + diff --git a/tests/testthat/t1/NAMESPACE b/tests/testthat/t1/NAMESPACE index ec360154..b59d7e6b 100644 --- a/tests/testthat/t1/NAMESPACE +++ b/tests/testthat/t1/NAMESPACE @@ -1,5 +1,6 @@ # Generated by roxygen2: do not edit by hand export("Another S7 Class") +export(ParentClass) export(another_s3_generic) export(another_s7_generic) diff --git a/tests/testthat/t1/R/t1.R b/tests/testthat/t1/R/t1.R index ab11284a..80da275f 100644 --- a/tests/testthat/t1/R/t1.R +++ b/tests/testthat/t1/R/t1.R @@ -6,3 +6,10 @@ another_s3_generic <- function(x) UseMethod("another_s3_generic") #' @export `Another S7 Class` <- S7::new_class("Another S7 Class", package = "t1") + +#' @export +ParentClass <- S7::new_class( + "ParentClass", + package = "t1", + properties = list(parent_prop = S7::class_character) +) diff --git a/tests/testthat/t5/DESCRIPTION b/tests/testthat/t5/DESCRIPTION new file mode 100644 index 00000000..a64edb18 --- /dev/null +++ b/tests/testthat/t5/DESCRIPTION @@ -0,0 +1,19 @@ +Package: t5 +Title: Test Consumer Subclassing an External Class +Version: 0.0.0.9000 +Authors@R: + c(person(given = "Jim", + family = "Hester", + role = c("aut", "cre"), + email = "james.f.hester@gmail.com", + comment = c(ORCID = "0000-0002-2739-7082")), + person(given = "RStudio", + role = c("cph", "fnd"))) +Description: What the package does (one paragraph). +Imports: S7 +Suggests: t1 +License: MIT + file LICENSE +Encoding: UTF-8 +LazyData: true +Roxygen: list(markdown = TRUE) +Config/roxygen2/version: 8.0.0 diff --git a/tests/testthat/t5/NAMESPACE b/tests/testthat/t5/NAMESPACE new file mode 100644 index 00000000..aa71d02f --- /dev/null +++ b/tests/testthat/t5/NAMESPACE @@ -0,0 +1,3 @@ +# Generated by roxygen2: do not edit by hand + +export(ChildClass) diff --git a/tests/testthat/t5/R/t5.R b/tests/testthat/t5/R/t5.R new file mode 100644 index 00000000..845c28f7 --- /dev/null +++ b/tests/testthat/t5/R/t5.R @@ -0,0 +1,16 @@ +# `ChildClass` subclasses `ParentClass`, which is defined in t1 (a soft +# dependency). Because the parent is referenced via new_external_class(), t5 can +# be built and loaded even when t1 is not installed: the external class is only +# resolved when an object is actually constructed. + +#' @export +ChildClass <- S7::new_class( + "ChildClass", + package = "t5", + parent = S7::new_external_class("t1", "ParentClass"), + properties = list(child_prop = S7::class_character) +) + +.onLoad <- function(libname, pkgname) { + S7::S7_on_load() +} diff --git a/tests/testthat/test-external-class.R b/tests/testthat/test-external-class.R index 0d82d4c2..620837b5 100644 --- a/tests/testthat/test-external-class.R +++ b/tests/testthat/test-external-class.R @@ -117,6 +117,48 @@ test_that("method_deps() collects the generic and external classes", { expect_equal(deps[[3]]$version, "1.0") }) +test_that("can subclass an external class without resolving it (in process)", { + ec <- new_external_class("not_a_pkg", "Foo") + Child <- new_class("Child", parent = ec, properties = list(x = class_integer)) + + expect_named(formals(Child), c("x", "...")) + # still can't construct + expect_snapshot(Child(x = 1), error = TRUE) +}) + +test_that("can subclass an external class with deferred resolution", { + # NB: Relies on installed S7 + skip_if(getRversion() < "4.1" && Sys.info()[["sysname"]] == "Windows") + skip_if(quick_test()) + tmp_lib <- local_libpath() + + # t5 subclasses ParentClass from t1 (a soft dependency) via + # new_external_class(). It must install and load even though t1 is absent, + # because the external parent is only resolved when an object is constructed. + local_install_and_attach(test_path("t5"), tmp_lib) + + # Constructing errors clearly while t1 is unavailable + expect_snapshot( + t5::ChildClass(child_prop = "a", parent_prop = "b"), + error = TRUE + ) + + # Once t1 is installed, construction resolves the parent and forwards the + # parent property through `...` + local_install_and_attach(test_path("t1"), tmp_lib) + obj <- t5::ChildClass(child_prop = "a", parent_prop = "b") + expect_equal(obj@child_prop, "a") + expect_equal(obj@parent_prop, "b") + expect_s3_class(obj, "t5::ChildClass") + expect_s3_class(obj, "t1::ParentClass") + + # The parent constructor still validates the inherited property's type + expect_snapshot( + error = TRUE, + t5::ChildClass(child_prop = "a", parent_prop = 1) + ) +}) + test_that("dep_available() respects loaded + version", { # S7 is loaded, so this dep is available expect_true(dep_available(new_external_generic("S7", "S7_inherits", "x")))