Use S7 namespace for base class constructors and validators

NEWS.md

@@ -1,5 +1,6 @@
 # S7 (development version)
 
+* Base type wrappers like `class_integer` now define their constructor and validator in the S7 namespace. (#553).
 * `method<-` now accepts `NULL` to unregister an existing method, e.g. `method(foo, class_character) <- NULL` (#613).
 * `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).
 * Internal changes to support R-devel (4.6) (#592, #593, #598, #600).

R/base.R

@@ -3,17 +3,21 @@ new_base_class <- function(name, constructor_name = name) {
 
   constructor <- new_function(
     args = list(.data = base_default(name)),
-    body = quote(.data),
-    env = baseenv()
+    body = quote(.data)
   )
 
-  validator <- function(object) {
-    if (base_class(object) != name) {
-      sprintf("Underlying data must be <%s> not <%s>", name, base_class(object))
-    }
-  }
-
-  validator <- utils::removeSource(validator)
+  validator <- new_function(
+    args = alist(object = ),
+    body = bquote(
+      if (base_class(object) != .(name)) {
+        sprintf(
+          "Underlying data must be <%s> not <%s>",
+          .(name),
+          base_class(object)
+        )
+      }
+    )
+  )
 
   out <- list(
     class = name,

R/class-spec.R

@@ -132,9 +132,8 @@ class_construct_expr <- function(.x, envir = NULL, package = NULL) {
   # (mostly for nicer printing and introspection.)
 
   # can't unwrap if the closure is potentially important
-  # (this can probably be relaxed to allow additional environments)
   fe <- environment(f)
-  if (!identical(fe, baseenv())) {
+  if (!identical(fe, baseenv()) && !identical(fe, asNamespace("S7"))) {
     return(as.call(list(f)))
   }
 

tests/testthat/test-base.R

@@ -8,6 +8,11 @@ test_that("validation uses typeof", {
   expect_equal(class_function$validator(mean), NULL)
 })
 
+test_that("constructor and validator live in the S7 namespace (#553)", {
+  expect_identical(environment(class_integer$constructor), asNamespace("S7"))
+  expect_identical(environment(class_integer$validator), asNamespace("S7"))
+})
+
 test_that("base class display as expected", {
   expect_snapshot({
     class_integer