From 3820d489e33a00481a0076fa03566c34d3fd0ef0 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Fri, 25 Oct 2024 10:15:28 -0400
Subject: [PATCH 01/13] unname `topNamespaceName()` name

---
 R/aaa.R | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/R/aaa.R b/R/aaa.R
index 2d872fa5..941b5f00 100644
--- a/R/aaa.R
+++ b/R/aaa.R
@@ -26,10 +26,10 @@ new_function <- function(args = NULL,
 topNamespaceName <- function(env = parent.frame()) {
   env <- topenv(env)
   if (!isNamespace(env)) {
-    return()
+    return() # print visible
   }
 
-  getNamespaceName(env)
+  as.character(getNamespaceName(env)) # unname
 }
 
 is_string <- function(x) {

From 935e5e1e6080c2b2c74d543ae71bc8155f051fbb Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Fri, 25 Oct 2024 10:16:38 -0400
Subject: [PATCH 02/13] try to use `pkg::cls()` call as constructor default if
 possible

---
 R/class-spec.R | 8 ++++++++
 1 file changed, 8 insertions(+)

diff --git a/R/class-spec.R b/R/class-spec.R
index 65579a45..cf4a8332 100644
--- a/R/class-spec.R
+++ b/R/class-spec.R
@@ -91,6 +91,14 @@ class_construct_expr <- function(.x, ...) {
   # to extract the expression
   # (mostly for nicer printing and introspection.)
 
+  # If the constructor is an S7 class, avoid inlining the full class def
+  # instead, inline an expression like `pkgname::classname()`
+  # note: if f@package is not NULL, the class is assumed to be exported.
+  if (is_class(f) && !is.null(f@package)) {
+    cl <- call("::", as.name(f@package), as.name(f@name))
+    return(as.call(list(cl, ...)))
+  }
+
   ## early return if not safe to unwrap
   # can't unwrap if we're passing on ...
   if(...length()) {

From e70f23a070c28c8ff7d4a40a51d844d68e9bd4cd Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Fri, 25 Oct 2024 10:34:20 -0400
Subject: [PATCH 03/13] add test

---
 tests/testthat/test-constructor.R | 13 +++++++++++--
 1 file changed, 11 insertions(+), 2 deletions(-)

diff --git a/tests/testthat/test-constructor.R b/tests/testthat/test-constructor.R
index 02152dc3..1d5bd755 100644
--- a/tests/testthat/test-constructor.R
+++ b/tests/testthat/test-constructor.R
@@ -160,8 +160,6 @@ test_that("can create constructors with missing or lazy defaults", {
                "Can\'t set read-only property Person@birthdate")
 })
 
-
-
 test_that("Dynamic settable properties are included in constructor", {
   Foo <- new_class(
     name = "Foo", package = NULL,
@@ -193,3 +191,14 @@ test_that("Dynamic settable properties are included in constructor", {
   expect_equal(foo@dynamic_settable, 1)
 
 })
+
+test_that("package exported classes are not inlined in constructor formals", {
+  # https://github.com/RConsortium/S7/issues/477
+  Foo := new_class(package = "pkgname")
+  Bar := new_class(properties = list(foo = Foo))
+
+  expect_identical(
+    formals(Bar)$foo,
+    quote(pkgname::Foo())
+  )
+})

From 36288d2871b987b03fc88b444c1db78e60fa6136 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <kalinowskit@gmail.com>
Date: Tue, 29 Oct 2024 20:18:21 -0400
Subject: [PATCH 04/13] change class constructor parent environment to
 `new_class()` calling env

---
 R/base.R                       |  2 +-
 R/class-spec.R                 | 42 ++++++++++++++++++++--------------
 R/class.R                      |  2 +-
 R/constructor.R                | 40 ++++++++++++++++++++++++--------
 R/property.R                   |  4 ++--
 tests/testthat/_snaps/class.md |  2 +-
 tests/testthat/test-class.R    | 13 +++++++----
 7 files changed, 69 insertions(+), 36 deletions(-)

diff --git a/R/base.R b/R/base.R
index d749a8d6..38b95a8b 100644
--- a/R/base.R
+++ b/R/base.R
@@ -44,7 +44,7 @@ base_default <- function(type) {
     name = quote(quote(x)),
     call = quote(quote({})),
 
-    `function` = quote(function() {}),
+    `function` = quote(function() NULL),
     environment = quote(new.env(parent = emptyenv()))
 )}
 
diff --git a/R/class-spec.R b/R/class-spec.R
index cf4a8332..f3df4334 100644
--- a/R/class-spec.R
+++ b/R/class-spec.R
@@ -81,35 +81,43 @@ class_friendly <- function(x) {
 }
 
 class_construct <- function(.x, ...) {
-  eval(class_construct_expr(.x, ...))
+  class_constructor(.x)(...)
 }
 
 
-class_construct_expr <- function(.x, ...) {
+class_construct_expr <- function(.x, envir = NULL) {
   f <- class_constructor(.x)
-  # If the constructor is a closure wrapping a simple expression, try
-  # to extract the expression
-  # (mostly for nicer printing and introspection.)
 
-  # If the constructor is an S7 class, avoid inlining the full class def
-  # instead, inline an expression like `pkgname::classname()`
-  # note: if f@package is not NULL, the class is assumed to be exported.
+  # If the constructor is an S7 class that is exported from a package, avoid
+  # inlining the full class def instead, inline an expression like
+  # `pkgname::classname()` or `classname()`
   if (is_class(f) && !is.null(f@package)) {
-    cl <- call("::", as.name(f@package), as.name(f@name))
-    return(as.call(list(cl, ...)))
+    # Check if the class can be resolved as a bare symbol without pkgname::
+    if(identical(topNamespaceName(envir), f@package) &&
+       identical(f, get0(f@name, envir, mode = "function"))) {
+      return(call(f@name))
+    } else {
+      # namespace the pkgname::classname() call
+      cl <- as.call(list(quote(`::`), as.name(f@package), as.name(f@name)))
+      return(as.call(list(cl)))
+    }
   }
 
+  # If the constructor is a closure wrapping a simple expression, try
+  # to extract the expression
+  # (mostly for nicer printing and introspection.)
+
   ## early return if not safe to unwrap
   # can't unwrap if we're passing on ...
-  if(...length()) {
-    return(as.call(list(f, ...)))
+  if (is.null(envir)) {
+    return(as.call(list(f)))
   }
 
   # 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())) {
-    return(as.call(list(f, ...)))
+  if (!identical(fe, baseenv())) {
+    return(as.call(list(f)))
   }
 
   # special case for `class_missing`
@@ -119,8 +127,8 @@ class_construct_expr <- function(.x, ...) {
 
   # `new_object()` must be called from the class constructor, can't
   # be safely unwrapped
-  if("new_object" %in% all.names(fb)) {
-    return(as.call(list(f, ...)))
+  if ("new_object" %in% all.names(fb)) {
+    return(as.call(list(f)))
   }
 
   # maybe unwrap body if it is a single expression wrapped in `{`
@@ -141,7 +149,7 @@ class_construct_expr <- function(.x, ...) {
   }
 
   #else, return a call to the constructor
-  as.call(list(f, ...))
+  as.call(list(f))
 }
 
 class_constructor <- function(.x) {
diff --git a/R/class.R b/R/class.R
index f475a0b6..0d263985 100644
--- a/R/class.R
+++ b/R/class.R
@@ -133,7 +133,7 @@ new_class <- function(
   all_props[names(new_props)] <- new_props
 
   if (is.null(constructor)) {
-    constructor <- new_constructor(parent, all_props)
+    constructor <- new_constructor(parent, all_props, envir = parent.frame())
   }
 
   object <- constructor
diff --git a/R/constructor.R b/R/constructor.R
index 63df1e78..d483a47b 100644
--- a/R/constructor.R
+++ b/R/constructor.R
@@ -1,18 +1,25 @@
-new_constructor <- function(parent, properties) {
+new_constructor <- function(parent, properties, envir = asNamespace("S7")) {
   properties <- as_properties(properties)
-  arg_info <- constructor_args(parent, properties)
+  arg_info <- constructor_args(parent, properties, envir)
   self_args <- as_names(names(arg_info$self), named = TRUE)
 
   if (identical(parent, S7_object) || (is_class(parent) && parent@abstract)) {
+    new_object_call <-
+      if (has_S7_symbols(envir, "new_object", "S7_object")) {
+        bquote(new_object(S7_object(), ..(self_args)), splice = TRUE)
+      } else {
+        bquote(S7::new_object(S7::S7_object(), ..(self_args)), splice = TRUE)
+      }
+
     return(new_function(
       args = arg_info$self,
       body = as.call(c(quote(`{`),
         # Force all promises here so that any errors are signaled from
         # the constructor() call instead of the new_object() call.
         unname(self_args),
-        new_call("new_object", c(list(quote(S7_object())), self_args))
+        new_object_call
       )),
-      env = asNamespace("S7")
+      env = envir
     ))
   }
 
@@ -42,15 +49,18 @@ new_constructor <- function(parent, properties) {
   parent_args <- as_names(names(arg_info$parent), named = TRUE)
   names(parent_args)[names(parent_args) == "..."] <- ""
   parent_call <- new_call(parent_name, parent_args)
-  body <- new_call("new_object", c(parent_call, self_args))
+  body <- new_call(
+    if (has_S7_symbols(envir, "new_object")) "new_object" else "S7::new_object",
+    c(parent_call, self_args)
+  )
 
-  env <- new.env(parent = asNamespace("S7"))
+  env <- new.env(parent = envir)
   env[[parent_name]] <- parent_fun
 
   new_function(args, body, env)
 }
 
-constructor_args <- function(parent, properties = list()) {
+constructor_args <- function(parent, properties = list(), envir = asNamespace("S7")) {
   parent_args <- formals(class_constructor(parent))
 
   # Remove read-only properties
@@ -66,7 +76,7 @@ constructor_args <- function(parent, properties = list()) {
 
   self_args <- as.pairlist(lapply(
     setNames(, self_arg_nms),
-    function(name) prop_default(properties[[name]]))
+    function(name) prop_default(properties[[name]], envir))
   )
 
   list(parent = parent_args,
@@ -81,8 +91,9 @@ is_property_dynamic <- function(x) is.function(x$getter)
 missing_args <- function(names) {
   lapply(setNames(, names), function(i) quote(class_missing))
 }
+
 new_call <- function(call, args) {
-  as.call(c(list(as.name(call)), args))
+  as.call(c(list(str2lang(call)), args))
 }
 
 as_names <- function(x, named = FALSE) {
@@ -91,3 +102,14 @@ as_names <- function(x, named = FALSE) {
   }
   lapply(x, as.name)
 }
+
+has_S7_symbols <- function(env, ...) {
+  env <- topenv(env)
+  if (identical(env, asNamespace("S7")))
+    return (TRUE)
+  if (!isNamespace(env))
+    return (FALSE)
+  imports <- getNamespaceImports(env)[["S7"]]
+  symbols <- c(...) %||% getNamespaceExports("S7")
+  all(symbols %in% imports)
+}
diff --git a/R/property.R b/R/property.R
index 1973d421..ca6e6883 100644
--- a/R/property.R
+++ b/R/property.R
@@ -155,8 +155,8 @@ str.S7_property <- function(object, ..., nest.lev = 0) {
   print(object, ..., nest.lev = nest.lev)
 }
 
-prop_default <- function(prop) {
-  prop$default %||% class_construct_expr(prop$class)
+prop_default <- function(prop, envir) {
+  prop$default %||% class_construct_expr(prop$class, envir)
 }
 
 #' Get/set a property
diff --git a/tests/testthat/_snaps/class.md b/tests/testthat/_snaps/class.md
index 5bd9e6cf..09d4d825 100644
--- a/tests/testthat/_snaps/class.md
+++ b/tests/testthat/_snaps/class.md
@@ -112,7 +112,7 @@
       foo <- new_class("foo", abstract = TRUE)
       foo()
     Condition
-      Error in `new_object()`:
+      Error in `S7::new_object()`:
       ! Can't construct an object from abstract class <foo>
 
 # abstract classes: can't inherit from concrete class
diff --git a/tests/testthat/test-class.R b/tests/testthat/test-class.R
index f6440b2d..b20f7af8 100644
--- a/tests/testthat/test-class.R
+++ b/tests/testthat/test-class.R
@@ -232,14 +232,17 @@ test_that("c(<S7_class>, ...) gives error", {
 })
 
 test_that("can round trip to disk and back", {
-  foo1 <- new_class("foo1", properties = list(y = class_integer))
-  foo2 <- new_class("foo2", properties = list(x = foo1))
-
-  f <- foo2(x = foo1(y = 1L))
+  eval(quote({
+    foo1 <- new_class("foo1", properties = list(y = class_integer))
+    foo2 <- new_class("foo2", properties = list(x = foo1))
+    f <- foo2(x = foo1(y = 1L))
+  }), globalenv())
 
+  f <- globalenv()[["f"]]
   path <- tempfile()
   saveRDS(f, path)
   f2 <- readRDS(path)
 
-  expect_equal(f2, f)
+  expect_equal(f, f2)
+  rm(foo1, foo2, f, envir = globalenv())
 })

From 9f0628f296de5c4506daff33fa04310116e09178 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <kalinowskit@gmail.com>
Date: Tue, 29 Oct 2024 20:38:06 -0400
Subject: [PATCH 05/13] fix non-syntatic class names

---
 R/constructor.R | 9 +++++++--
 1 file changed, 7 insertions(+), 2 deletions(-)

diff --git a/R/constructor.R b/R/constructor.R
index d483a47b..ce1e28dc 100644
--- a/R/constructor.R
+++ b/R/constructor.R
@@ -50,7 +50,7 @@ new_constructor <- function(parent, properties, envir = asNamespace("S7")) {
   names(parent_args)[names(parent_args) == "..."] <- ""
   parent_call <- new_call(parent_name, parent_args)
   body <- new_call(
-    if (has_S7_symbols(envir, "new_object")) "new_object" else "S7::new_object",
+    if (has_S7_symbols(envir, "new_object")) "new_object" else c("S7", "new_object"),
     c(parent_call, self_args)
   )
 
@@ -93,7 +93,12 @@ missing_args <- function(names) {
 }
 
 new_call <- function(call, args) {
-  as.call(c(list(str2lang(call)), args))
+  if (is.character(call)) {
+    call <- switch(length(call),
+                   as.name(call),
+                   as.call(c(quote(`::`), lapply(call, as.name))))
+  }
+  as.call(c(list(call), args))
 }
 
 as_names <- function(x, named = FALSE) {

From b2d52059233981a531769162aa8693461a098601 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <kalinowskit@gmail.com>
Date: Wed, 30 Oct 2024 04:05:29 -0400
Subject: [PATCH 06/13] use pkgname instead of env when deciding to not inline
 constructor calls

---
 R/class-spec.R  |  8 +++++---
 R/class.R       |  4 +++-
 R/constructor.R | 10 ++++++----
 R/property.R    |  4 ++--
 4 files changed, 16 insertions(+), 10 deletions(-)

diff --git a/R/class-spec.R b/R/class-spec.R
index f3df4334..6f6cf273 100644
--- a/R/class-spec.R
+++ b/R/class-spec.R
@@ -85,7 +85,7 @@ class_construct <- function(.x, ...) {
 }
 
 
-class_construct_expr <- function(.x, envir = NULL) {
+class_construct_expr <- function(.x, envir = NULL, package = NULL) {
   f <- class_constructor(.x)
 
   # If the constructor is an S7 class that is exported from a package, avoid
@@ -93,10 +93,12 @@ class_construct_expr <- function(.x, envir = NULL) {
   # `pkgname::classname()` or `classname()`
   if (is_class(f) && !is.null(f@package)) {
     # Check if the class can be resolved as a bare symbol without pkgname::
-    if(identical(topNamespaceName(envir), f@package) &&
-       identical(f, get0(f@name, envir, mode = "function"))) {
+    if (identical(package, f@package)) {
+
       return(call(f@name))
+
     } else {
+
       # namespace the pkgname::classname() call
       cl <- as.call(list(quote(`::`), as.name(f@package), as.name(f@name)))
       return(as.call(list(cl)))
diff --git a/R/class.R b/R/class.R
index 0d263985..abbf0434 100644
--- a/R/class.R
+++ b/R/class.R
@@ -133,7 +133,9 @@ new_class <- function(
   all_props[names(new_props)] <- new_props
 
   if (is.null(constructor)) {
-    constructor <- new_constructor(parent, all_props, envir = parent.frame())
+    constructor <- new_constructor(parent, all_props,
+                                   envir = parent.frame(),
+                                   package = package)
   }
 
   object <- constructor
diff --git a/R/constructor.R b/R/constructor.R
index ce1e28dc..05c901e1 100644
--- a/R/constructor.R
+++ b/R/constructor.R
@@ -1,6 +1,7 @@
-new_constructor <- function(parent, properties, envir = asNamespace("S7")) {
+new_constructor <- function(parent, properties,
+                            envir = asNamespace("S7"), package = NULL) {
   properties <- as_properties(properties)
-  arg_info <- constructor_args(parent, properties, envir)
+  arg_info <- constructor_args(parent, properties, envir, package)
   self_args <- as_names(names(arg_info$self), named = TRUE)
 
   if (identical(parent, S7_object) || (is_class(parent) && parent@abstract)) {
@@ -60,7 +61,8 @@ new_constructor <- function(parent, properties, envir = asNamespace("S7")) {
   new_function(args, body, env)
 }
 
-constructor_args <- function(parent, properties = list(), envir = asNamespace("S7")) {
+constructor_args <- function(parent, properties = list(),
+                             envir = asNamespace("S7"), package = NULL) {
   parent_args <- formals(class_constructor(parent))
 
   # Remove read-only properties
@@ -76,7 +78,7 @@ constructor_args <- function(parent, properties = list(), envir = asNamespace("S
 
   self_args <- as.pairlist(lapply(
     setNames(, self_arg_nms),
-    function(name) prop_default(properties[[name]], envir))
+    function(name) prop_default(properties[[name]], envir, package))
   )
 
   list(parent = parent_args,
diff --git a/R/property.R b/R/property.R
index ca6e6883..e2cf4917 100644
--- a/R/property.R
+++ b/R/property.R
@@ -155,8 +155,8 @@ str.S7_property <- function(object, ..., nest.lev = 0) {
   print(object, ..., nest.lev = nest.lev)
 }
 
-prop_default <- function(prop, envir) {
-  prop$default %||% class_construct_expr(prop$class, envir)
+prop_default <- function(prop, envir, package) {
+  prop$default %||% class_construct_expr(prop$class, envir, package)
 }
 
 #' Get/set a property

From b20ff0b1cc31eb54488ee43792f9334e7c7eca32 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <kalinowskit@gmail.com>
Date: Wed, 30 Oct 2024 04:06:42 -0400
Subject: [PATCH 07/13] update surrounding code

---
 R/class-spec.R | 9 ---------
 1 file changed, 9 deletions(-)

diff --git a/R/class-spec.R b/R/class-spec.R
index 6f6cf273..200ae459 100644
--- a/R/class-spec.R
+++ b/R/class-spec.R
@@ -94,11 +94,8 @@ class_construct_expr <- function(.x, envir = NULL, package = NULL) {
   if (is_class(f) && !is.null(f@package)) {
     # Check if the class can be resolved as a bare symbol without pkgname::
     if (identical(package, f@package)) {
-
       return(call(f@name))
-
     } else {
-
       # namespace the pkgname::classname() call
       cl <- as.call(list(quote(`::`), as.name(f@package), as.name(f@name)))
       return(as.call(list(cl)))
@@ -109,12 +106,6 @@ class_construct_expr <- function(.x, envir = NULL, package = NULL) {
   # to extract the expression
   # (mostly for nicer printing and introspection.)
 
-  ## early return if not safe to unwrap
-  # can't unwrap if we're passing on ...
-  if (is.null(envir)) {
-    return(as.call(list(f)))
-  }
-
   # can't unwrap if the closure is potentially important
   # (this can probably be relaxed to allow additional environments)
   fe <- environment(f)

From 1bb07f3bf190d0d3502f7a1508c9c5eaa241b42f Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <kalinowskit@gmail.com>
Date: Fri, 1 Nov 2024 16:42:59 -0400
Subject: [PATCH 08/13] Add snapshot test

---
 tests/testthat/_snaps/constructor.md | 9 +++++++++
 tests/testthat/test-constructor.R    | 2 ++
 2 files changed, 11 insertions(+)

diff --git a/tests/testthat/_snaps/constructor.md b/tests/testthat/_snaps/constructor.md
index dc728506..3fe6a29f 100644
--- a/tests/testthat/_snaps/constructor.md
+++ b/tests/testthat/_snaps/constructor.md
@@ -79,3 +79,12 @@
       new_object(foo(...), y = y)
       <environment: 0x0>
 
+# package exported classes are not inlined in constructor formals
+
+    Code
+      formals(Bar)
+    Output
+      $foo
+      pkgname::Foo()
+      
+
diff --git a/tests/testthat/test-constructor.R b/tests/testthat/test-constructor.R
index 1d5bd755..f28bdc41 100644
--- a/tests/testthat/test-constructor.R
+++ b/tests/testthat/test-constructor.R
@@ -201,4 +201,6 @@ test_that("package exported classes are not inlined in constructor formals", {
     formals(Bar)$foo,
     quote(pkgname::Foo())
   )
+
+  expect_snapshot(formals(Bar))
 })

From 1f6002d6fb50d69ce819efad6ac646c4ac73070a Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Mon, 4 Nov 2024 09:53:26 -0500
Subject: [PATCH 09/13] Add comment

---
 R/class-spec.R | 6 ++++--
 1 file changed, 4 insertions(+), 2 deletions(-)

diff --git a/R/class-spec.R b/R/class-spec.R
index 200ae459..acf70d20 100644
--- a/R/class-spec.R
+++ b/R/class-spec.R
@@ -88,11 +88,13 @@ class_construct <- function(.x, ...) {
 class_construct_expr <- function(.x, envir = NULL, package = NULL) {
   f <- class_constructor(.x)
 
-  # If the constructor is an S7 class that is exported from a package, avoid
-  # inlining the full class def instead, inline an expression like
+  # For S7 class constructors with a non-NULL @package property
+  # Instead of inlining the full class definition, use either
   # `pkgname::classname()` or `classname()`
   if (is_class(f) && !is.null(f@package)) {
     # Check if the class can be resolved as a bare symbol without pkgname::
+    # Note: During package build, using pkg::class for a package's own symbols
+    # will raise an error from `::`.
     if (identical(package, f@package)) {
       return(call(f@name))
     } else {

From 2441c335306bc70af4c4d1cbcfd2905ec9774133 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Mon, 4 Nov 2024 09:58:13 -0500
Subject: [PATCH 10/13] update `new_class`: `@param package` doc.

---
 R/class.R        | 11 ++++-------
 man/new_class.Rd | 13 +++++--------
 2 files changed, 9 insertions(+), 15 deletions(-)

diff --git a/R/class.R b/R/class.R
index 6781e703..f7d71135 100644
--- a/R/class.R
+++ b/R/class.R
@@ -16,14 +16,11 @@
 #'   * An S7 class, like [S7_object].
 #'   * An S3 class wrapped by [new_S3_class()].
 #'   * A base type, like [class_logical], [class_integer], etc.
-#' @param package Package name. It is good practice to set the package
-#'   name when exporting an S7 class from a package because it prevents
-#'   clashes if two packages happen to export a class with the same
-#'   name.
+#' @param package Package name. This is automatically resolved if the class is
+#'   defined in a package, and `NULL` otherwise.
 #'
-#'   Setting `package` implies that the class is available for external use,
-#'   so should be accompanied by exporting the constructor. Learn more
-#'   in `vignette("packages")`.
+#'   Note, if the class is intended for external use, the constructor should be
+#'   exported. Learn more in `vignette("packages")`.
 #' @param abstract Is this an abstract class? An abstract class can not be
 #'   instantiated.
 #' @param constructor The constructor function. In most cases, you can rely
diff --git a/man/new_class.Rd b/man/new_class.Rd
index 60ca3932..43a62718 100644
--- a/man/new_class.Rd
+++ b/man/new_class.Rd
@@ -30,14 +30,11 @@ There are three options:
 \item A base type, like \link{class_logical}, \link{class_integer}, etc.
 }}
 
-\item{package}{Package name. It is good practice to set the package
-name when exporting an S7 class from a package because it prevents
-clashes if two packages happen to export a class with the same
-name.
-
-Setting \code{package} implies that the class is available for external use,
-so should be accompanied by exporting the constructor. Learn more
-in \code{vignette("packages")}.}
+\item{package}{Package name. This is automatically resolved if the class is
+defined in a package, and \code{NULL} otherwise.
+
+Note, if the class is intended for external use, the constructor should be
+exported. Learn more in \code{vignette("packages")}.}
 
 \item{properties}{A named list specifying the properties (data) that
 belong to each instance of the class. Each element of the list can

From dfe6eec9101a73370a7b4915074e385d1acfb072 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Mon, 4 Nov 2024 10:08:51 -0500
Subject: [PATCH 11/13] update snapshot test

---
 tests/testthat/_snaps/constructor.md | 7 +++----
 tests/testthat/test-constructor.R    | 2 +-
 2 files changed, 4 insertions(+), 5 deletions(-)

diff --git a/tests/testthat/_snaps/constructor.md b/tests/testthat/_snaps/constructor.md
index 3fe6a29f..199b5dcd 100644
--- a/tests/testthat/_snaps/constructor.md
+++ b/tests/testthat/_snaps/constructor.md
@@ -82,9 +82,8 @@
 # package exported classes are not inlined in constructor formals
 
     Code
-      formals(Bar)
+      args(Bar)
     Output
-      $foo
-      pkgname::Foo()
-      
+      function (foo = pkgname::Foo()) 
+      NULL
 
diff --git a/tests/testthat/test-constructor.R b/tests/testthat/test-constructor.R
index f28bdc41..03e860fe 100644
--- a/tests/testthat/test-constructor.R
+++ b/tests/testthat/test-constructor.R
@@ -202,5 +202,5 @@ test_that("package exported classes are not inlined in constructor formals", {
     quote(pkgname::Foo())
   )
 
-  expect_snapshot(formals(Bar))
+  expect_snapshot(args(Bar))
 })

From 0b21f03bd3dc528376ee991ebfcd12e7d3ba7dec Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Mon, 4 Nov 2024 11:39:50 -0500
Subject: [PATCH 12/13] test external classes with actual packages

---
 R/class-spec.R                            | 11 +++++++
 tests/testthat/_snaps/constructor.md      |  8 -----
 tests/testthat/_snaps/external-generic.md | 38 +++++++++++++++++++++++
 tests/testthat/t0/NAMESPACE               |  1 +
 tests/testthat/t0/R/t0.R                  |  3 ++
 tests/testthat/t2/NAMESPACE               |  2 ++
 tests/testthat/t2/R/t2.R                  | 11 +++++++
 tests/testthat/test-constructor.R         | 13 --------
 tests/testthat/test-external-generic.R    | 33 ++++++++++++++++++++
 9 files changed, 99 insertions(+), 21 deletions(-)

diff --git a/R/class-spec.R b/R/class-spec.R
index acf70d20..ba8885ce 100644
--- a/R/class-spec.R
+++ b/R/class-spec.R
@@ -100,6 +100,17 @@ class_construct_expr <- function(.x, envir = NULL, package = NULL) {
     } else {
       # namespace the pkgname::classname() call
       cl <- as.call(list(quote(`::`), as.name(f@package), as.name(f@name)))
+
+      # check the call evaluates to f.
+      # This will error if package is not installed or object is not exported.
+      f2 <- eval(cl, baseenv())
+      if (!identical(f, f2)) {
+        msg <- sprintf(
+          "`%s::%s` is not identical to the class with the same @package and @name properties",
+          f@package, f@name
+        )
+        stop(msg, call. = FALSE)
+      }
       return(as.call(list(cl)))
     }
   }
diff --git a/tests/testthat/_snaps/constructor.md b/tests/testthat/_snaps/constructor.md
index 199b5dcd..dc728506 100644
--- a/tests/testthat/_snaps/constructor.md
+++ b/tests/testthat/_snaps/constructor.md
@@ -79,11 +79,3 @@
       new_object(foo(...), y = y)
       <environment: 0x0>
 
-# package exported classes are not inlined in constructor formals
-
-    Code
-      args(Bar)
-    Output
-      function (foo = pkgname::Foo()) 
-      NULL
-
diff --git a/tests/testthat/_snaps/external-generic.md b/tests/testthat/_snaps/external-generic.md
index 0b14fcff..88f1f9bc 100644
--- a/tests/testthat/_snaps/external-generic.md
+++ b/tests/testthat/_snaps/external-generic.md
@@ -5,3 +5,41 @@
     Output
       <S7_external_generic> foo::bar(x)
 
+# new_method works with both hard and soft dependencies
+
+    Code
+      args(Foo)
+    Output
+      function (bar = t0::AnS7Class()) 
+      NULL
+    Code
+      args(t2::AnS7Class2)
+    Output
+      function (bar = t0::AnS7Class()) 
+      NULL
+    Code
+      args(t2:::AnInternalClass)
+    Output
+      function (foo = t0::AnS7Class(), bar = AnS7Class2()) 
+      NULL
+
+---
+
+    Code
+      new_class("Foo", properties = list(bar = new_class("MadeUpClass", package = "t0")))
+    Condition
+      Error:
+      ! 'MadeUpClass' is not an exported object from 'namespace:t0'
+    Code
+      new_class("Foo", properties = list(bar = new_class("MadeUpClass", package = "MadeUpPackage")))
+    Condition
+      Error in `loadNamespace()`:
+      ! there is no package called 'MadeUpPackage'
+    Code
+      modified_class <- t0::AnS7Class
+      attr(modified_class, "xyz") <- "abc"
+      new_class("Foo", properties = list(bar = modified_class))
+    Condition
+      Error:
+      ! `t0::AnS7Class` is not identical to the class with the same @package and @name properties
+
diff --git a/tests/testthat/t0/NAMESPACE b/tests/testthat/t0/NAMESPACE
index 5647257c..6cf9dd84 100644
--- a/tests/testthat/t0/NAMESPACE
+++ b/tests/testthat/t0/NAMESPACE
@@ -1,4 +1,5 @@
 # Generated by roxygen2: do not edit by hand
 
+export(AnS7Class)
 export(an_s3_generic)
 export(an_s7_generic)
diff --git a/tests/testthat/t0/R/t0.R b/tests/testthat/t0/R/t0.R
index cf5b6843..efbaad27 100644
--- a/tests/testthat/t0/R/t0.R
+++ b/tests/testthat/t0/R/t0.R
@@ -3,3 +3,6 @@ an_s7_generic <- S7::new_generic("an_s7_generic", "x")
 
 #' @export
 an_s3_generic <- function(x) UseMethod("an_s3_generic")
+
+#' @export
+AnS7Class <- S7::new_class("AnS7Class")
diff --git a/tests/testthat/t2/NAMESPACE b/tests/testthat/t2/NAMESPACE
index b5d51e48..1f52c1ab 100644
--- a/tests/testthat/t2/NAMESPACE
+++ b/tests/testthat/t2/NAMESPACE
@@ -1,5 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
+export(AnS7Class2)
 export(an_s7_class)
+importFrom(t0,AnS7Class)
 importFrom(t0,an_s3_generic)
 importFrom(t0,an_s7_generic)
diff --git a/tests/testthat/t2/R/t2.R b/tests/testthat/t2/R/t2.R
index a98bd7b7..0a98fe61 100644
--- a/tests/testthat/t2/R/t2.R
+++ b/tests/testthat/t2/R/t2.R
@@ -10,6 +10,16 @@ S7::method(an_s7_generic, an_s7_class) <- function(x) "foo"
 S7::method(an_s3_generic, an_s7_class) <- function(x) "foo"
 
 
+#' @importFrom t0 AnS7Class
+#' @export
+AnS7Class2 <- S7::new_class("AnS7Class2", properties = list(bar = AnS7Class))
+
+AnInternalClass <- S7::new_class("AnInternalClass", properties = list(
+  foo = AnS7Class,
+  bar = AnS7Class2
+))
+
+
 another_s7_generic <- S7::new_external_generic("t1", "another_s7_generic", "x")
 S7::method(another_s7_generic, S7::class_character) <- function(x) "foo"
 S7::method(another_s7_generic, an_s7_class) <- function(x) "foo"
@@ -17,6 +27,7 @@ S7::method(another_s7_generic, an_s7_class) <- function(x) "foo"
 another_s3_generic <- S7::new_external_generic("t1", "another_s3_generic", "x")
 S7::method(another_s3_generic, an_s7_class) <- function(x) "foo"
 
+
 .onLoad <- function(libname, pkgname) {
   S7::methods_register()
 }
diff --git a/tests/testthat/test-constructor.R b/tests/testthat/test-constructor.R
index 03e860fe..323f14b2 100644
--- a/tests/testthat/test-constructor.R
+++ b/tests/testthat/test-constructor.R
@@ -191,16 +191,3 @@ test_that("Dynamic settable properties are included in constructor", {
   expect_equal(foo@dynamic_settable, 1)
 
 })
-
-test_that("package exported classes are not inlined in constructor formals", {
-  # https://github.com/RConsortium/S7/issues/477
-  Foo := new_class(package = "pkgname")
-  Bar := new_class(properties = list(foo = Foo))
-
-  expect_identical(
-    formals(Bar)$foo,
-    quote(pkgname::Foo())
-  )
-
-  expect_snapshot(args(Bar))
-})
diff --git a/tests/testthat/test-external-generic.R b/tests/testthat/test-external-generic.R
index fb9ce61f..f3bb5089 100644
--- a/tests/testthat/test-external-generic.R
+++ b/tests/testthat/test-external-generic.R
@@ -86,6 +86,39 @@ test_that("new_method works with both hard and soft dependencies", {
   expect_equal(an_s3_generic(t2::an_s7_class()), "foo")
   expect_equal(an_s7_generic("x"), "foo")
 
+  # test that new_class() will construct a property default as a namespaced call
+  # to t0::AnS7Class() (and not inline the full class object).
+  # As these tests grow, consider splitting this into a separate context like:
+  #   test_that("package exported classes are not inlined in constructor formals", {...})
+  Foo <- new_class("Foo", properties = list(bar = t0::AnS7Class))
+  expect_identical(formals(Foo)           , as.pairlist(alist(bar = t0::AnS7Class())))
+  expect_identical(formals(t2::AnS7Class2), as.pairlist(alist(bar = t0::AnS7Class())))
+  expect_identical(formals(t2:::AnInternalClass), as.pairlist(alist(
+    foo = t0::AnS7Class(), bar = AnS7Class2()
+  )))
+
+  expect_snapshot({
+    args(Foo)
+    args(t2::AnS7Class2)
+    args(t2:::AnInternalClass)
+  })
+
+  # test we emit informative error messages if a new_class() call with an
+  # external class dependency is malformed.
+  # https://github.com/RConsortium/S7/issues/477
+  expect_snapshot(error = TRUE, {
+    new_class("Foo", properties = list(
+      bar = new_class("MadeUpClass", package = "t0")
+    ))
+    new_class("Foo", properties = list(
+      bar = new_class("MadeUpClass", package = "MadeUpPackage")
+    ))
+
+    modified_class <- t0::AnS7Class
+    attr(modified_class, "xyz") <- "abc"
+    new_class("Foo", properties = list(bar = modified_class))
+  })
+
   # Now install the soft dependency
   quick_install(test_path("t1"), tmp_lib)
 

From 44ce8138087498bc3f8cd79eae83a38646ce7973 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Mon, 4 Nov 2024 12:06:39 -0500
Subject: [PATCH 13/13] use non-syntatic class names in tests

---
 tests/testthat/_snaps/external-generic.md | 22 +++++++++++-----------
 tests/testthat/t0/NAMESPACE               |  2 +-
 tests/testthat/t0/R/t0.R                  |  2 +-
 tests/testthat/t2/NAMESPACE               |  4 ++--
 tests/testthat/t2/R/t2.R                  | 11 ++++++-----
 tests/testthat/test-external-generic.R    | 20 ++++++++++----------
 6 files changed, 31 insertions(+), 30 deletions(-)

diff --git a/tests/testthat/_snaps/external-generic.md b/tests/testthat/_snaps/external-generic.md
index 88f1f9bc..a0c56dc2 100644
--- a/tests/testthat/_snaps/external-generic.md
+++ b/tests/testthat/_snaps/external-generic.md
@@ -10,36 +10,36 @@
     Code
       args(Foo)
     Output
-      function (bar = t0::AnS7Class()) 
+      function (bar = t0::`An S7 Class`()) 
       NULL
     Code
-      args(t2::AnS7Class2)
+      args(t2::`An S7 Class 2`)
     Output
-      function (bar = t0::AnS7Class()) 
+      function (bar = t0::`An S7 Class`()) 
       NULL
     Code
-      args(t2:::AnInternalClass)
+      args(t2:::`An Internal Class`)
     Output
-      function (foo = t0::AnS7Class(), bar = AnS7Class2()) 
+      function (foo = t0::`An S7 Class`(), bar = `An S7 Class 2`()) 
       NULL
 
 ---
 
     Code
-      new_class("Foo", properties = list(bar = new_class("MadeUpClass", package = "t0")))
+      new_class("Foo", properties = list(bar = new_class("Made Up Class", package = "t0")))
     Condition
       Error:
-      ! 'MadeUpClass' is not an exported object from 'namespace:t0'
+      ! 'Made Up Class' is not an exported object from 'namespace:t0'
     Code
-      new_class("Foo", properties = list(bar = new_class("MadeUpClass", package = "MadeUpPackage")))
+      new_class("Foo", properties = list(bar = new_class("Made Up Class", package = "Made Up Package")))
     Condition
       Error in `loadNamespace()`:
-      ! there is no package called 'MadeUpPackage'
+      ! there is no package called 'Made Up Package'
     Code
-      modified_class <- t0::AnS7Class
+      modified_class <- t0::`An S7 Class`
       attr(modified_class, "xyz") <- "abc"
       new_class("Foo", properties = list(bar = modified_class))
     Condition
       Error:
-      ! `t0::AnS7Class` is not identical to the class with the same @package and @name properties
+      ! `t0::An S7 Class` is not identical to the class with the same @package and @name properties
 
diff --git a/tests/testthat/t0/NAMESPACE b/tests/testthat/t0/NAMESPACE
index 6cf9dd84..d460b7b7 100644
--- a/tests/testthat/t0/NAMESPACE
+++ b/tests/testthat/t0/NAMESPACE
@@ -1,5 +1,5 @@
 # Generated by roxygen2: do not edit by hand
 
-export(AnS7Class)
+export("An S7 Class")
 export(an_s3_generic)
 export(an_s7_generic)
diff --git a/tests/testthat/t0/R/t0.R b/tests/testthat/t0/R/t0.R
index efbaad27..bfba20a6 100644
--- a/tests/testthat/t0/R/t0.R
+++ b/tests/testthat/t0/R/t0.R
@@ -5,4 +5,4 @@ an_s7_generic <- S7::new_generic("an_s7_generic", "x")
 an_s3_generic <- function(x) UseMethod("an_s3_generic")
 
 #' @export
-AnS7Class <- S7::new_class("AnS7Class")
+`An S7 Class` <- S7::new_class("An S7 Class")
diff --git a/tests/testthat/t2/NAMESPACE b/tests/testthat/t2/NAMESPACE
index 1f52c1ab..0fb0c4c0 100644
--- a/tests/testthat/t2/NAMESPACE
+++ b/tests/testthat/t2/NAMESPACE
@@ -1,7 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
-export(AnS7Class2)
+export("An S7 Class 2")
 export(an_s7_class)
-importFrom(t0,AnS7Class)
+importFrom(t0, `An S7 Class`)
 importFrom(t0,an_s3_generic)
 importFrom(t0,an_s7_generic)
diff --git a/tests/testthat/t2/R/t2.R b/tests/testthat/t2/R/t2.R
index 0a98fe61..8834b299 100644
--- a/tests/testthat/t2/R/t2.R
+++ b/tests/testthat/t2/R/t2.R
@@ -10,13 +10,14 @@ S7::method(an_s7_generic, an_s7_class) <- function(x) "foo"
 S7::method(an_s3_generic, an_s7_class) <- function(x) "foo"
 
 
-#' @importFrom t0 AnS7Class
+#' @rawNamespace importFrom(t0, `An S7 Class`)
 #' @export
-AnS7Class2 <- S7::new_class("AnS7Class2", properties = list(bar = AnS7Class))
+`An S7 Class 2` <- S7::new_class("An S7 Class 2", properties = list(bar = `An S7 Class`))
+NULL
 
-AnInternalClass <- S7::new_class("AnInternalClass", properties = list(
-  foo = AnS7Class,
-  bar = AnS7Class2
+`An Internal Class` <- S7::new_class("An Internal Class", properties = list(
+  foo = `An S7 Class`,
+  bar = `An S7 Class 2`
 ))
 
 
diff --git a/tests/testthat/test-external-generic.R b/tests/testthat/test-external-generic.R
index f3bb5089..090fc998 100644
--- a/tests/testthat/test-external-generic.R
+++ b/tests/testthat/test-external-generic.R
@@ -90,17 +90,17 @@ test_that("new_method works with both hard and soft dependencies", {
   # to t0::AnS7Class() (and not inline the full class object).
   # As these tests grow, consider splitting this into a separate context like:
   #   test_that("package exported classes are not inlined in constructor formals", {...})
-  Foo <- new_class("Foo", properties = list(bar = t0::AnS7Class))
-  expect_identical(formals(Foo)           , as.pairlist(alist(bar = t0::AnS7Class())))
-  expect_identical(formals(t2::AnS7Class2), as.pairlist(alist(bar = t0::AnS7Class())))
-  expect_identical(formals(t2:::AnInternalClass), as.pairlist(alist(
-    foo = t0::AnS7Class(), bar = AnS7Class2()
+  Foo <- new_class("Foo", properties = list(bar = t0::`An S7 Class`))
+  expect_identical(formals(Foo)                , as.pairlist(alist(bar = t0::`An S7 Class`())))
+  expect_identical(formals(t2::`An S7 Class 2`), as.pairlist(alist(bar = t0::`An S7 Class`())))
+  expect_identical(formals(t2:::`An Internal Class`), as.pairlist(alist(
+    foo = t0::`An S7 Class`(), bar = `An S7 Class 2`()
   )))
 
   expect_snapshot({
     args(Foo)
-    args(t2::AnS7Class2)
-    args(t2:::AnInternalClass)
+    args(t2::`An S7 Class 2`)
+    args(t2:::`An Internal Class`)
   })
 
   # test we emit informative error messages if a new_class() call with an
@@ -108,13 +108,13 @@ test_that("new_method works with both hard and soft dependencies", {
   # https://github.com/RConsortium/S7/issues/477
   expect_snapshot(error = TRUE, {
     new_class("Foo", properties = list(
-      bar = new_class("MadeUpClass", package = "t0")
+      bar = new_class("Made Up Class", package = "t0")
     ))
     new_class("Foo", properties = list(
-      bar = new_class("MadeUpClass", package = "MadeUpPackage")
+      bar = new_class("Made Up Class", package = "Made Up Package")
     ))
 
-    modified_class <- t0::AnS7Class
+    modified_class <- t0::`An S7 Class`
     attr(modified_class, "xyz") <- "abc"
     new_class("Foo", properties = list(bar = modified_class))
   })