From f617c3a4e634772fd9da2355ce66e4102e716821 Mon Sep 17 00:00:00 2001
From: Hadley Wickham <h.wickham@gmail.com>
Date: Fri, 29 May 2026 08:14:55 -0500
Subject: [PATCH 1/2] Use S7 namespace for base class constructors and
 validators

This avoids capturing the local environment in the case of the validator, and the inconsistent use of the base environment in the case of the constructor. The validator and constructor for the S3 wrappers already used the S7 namespace.

Fixes #553
---
 NEWS.md                    |  1 +
 R/base.R                   | 22 +++++++++++++---------
 tests/testthat/test-base.R |  5 +++++
 3 files changed, 19 insertions(+), 9 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index a437adbb..ee673c2c 100644
--- a/NEWS.md
+++ b/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).
diff --git a/R/base.R b/R/base.R
index 54f67c88..aabf0037 100644
--- a/R/base.R
+++ b/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,
diff --git a/tests/testthat/test-base.R b/tests/testthat/test-base.R
index a25ee1f2..9c73c8df 100644
--- a/tests/testthat/test-base.R
+++ b/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

From 4aa243cab9b6669fb017792baa4387aab8c7116d Mon Sep 17 00:00:00 2001
From: Hadley Wickham <h.wickham@gmail.com>
Date: Fri, 29 May 2026 13:07:15 -0500
Subject: [PATCH 2/2] Now also also S7 namespace

---
 R/class-spec.R | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/R/class-spec.R b/R/class-spec.R
index 03fb7fe4..180908d8 100644
--- a/R/class-spec.R
+++ b/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)))
   }