From 1d3a5f6ba094e1d08dccb33d42397d0427cf3ecb Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Sun, 8 Sep 2024 14:15:02 -0400
Subject: [PATCH 01/29] Update Roxygen version to 7.3.2;
 `pkgload:::use_compilation_db()`

---
 DESCRIPTION | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index 33a80436..98d65945 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -45,4 +45,5 @@ Config/testthat/parallel: TRUE
 Config/testthat/start-first: external-generic
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2
+Config/build/compilation-database: true

From ab1baf7f9da11d21b1b2240e9e40d84ece840c50 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Sun, 8 Sep 2024 14:17:45 -0400
Subject: [PATCH 02/29] use `class_missing` in `class_missing` example

---
 R/special.R          | 2 ++
 man/class_missing.Rd | 2 ++
 2 files changed, 4 insertions(+)

diff --git a/R/special.R b/R/special.R
index 1afbae03..2ecebe2c 100644
--- a/R/special.R
+++ b/R/special.R
@@ -10,10 +10,12 @@
 #' @examples
 #' foo <- new_generic("foo", "x")
 #' method(foo, class_numeric) <- function(x) "number"
+#' method(foo, class_missing) <- function(x) "missing"
 #' method(foo, class_any) <- function(x) "fallback"
 #'
 #' foo(1)
 #' foo()
+#' foo("")
 class_missing <- structure(list(), class = "S7_missing")
 
 is_class_missing <- function(x) inherits(x, "S7_missing")
diff --git a/man/class_missing.Rd b/man/class_missing.Rd
index 058aa187..b745e66c 100644
--- a/man/class_missing.Rd
+++ b/man/class_missing.Rd
@@ -18,9 +18,11 @@ i.e. it's missing in the sense of \code{\link[=missing]{missing()}}, not in the
 \examples{
 foo <- new_generic("foo", "x")
 method(foo, class_numeric) <- function(x) "number"
+method(foo, class_missing) <- function(x) "missing"
 method(foo, class_any) <- function(x) "fallback"
 
 foo(1)
 foo()
+foo("")
 }
 \keyword{datasets}

From 97be220db6ac103f5f85c91a1cfbd9cbe3e48ad2 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Sun, 8 Sep 2024 14:18:11 -0400
Subject: [PATCH 03/29] ignore dev artifacts

---
 .Rbuildignore | 2 ++
 .gitignore    | 4 ++++
 2 files changed, 6 insertions(+)

diff --git a/.Rbuildignore b/.Rbuildignore
index 671a5f1e..ceadd3ea 100644
--- a/.Rbuildignore
+++ b/.Rbuildignore
@@ -15,3 +15,5 @@
 ^pkgdown$
 ^cran-comments\.md$
 ^CRAN-SUBMISSION$
+^compile_commands\.json$
+^\.cache$
diff --git a/.gitignore b/.gitignore
index 683065ab..8e02e4b2 100644
--- a/.gitignore
+++ b/.gitignore
@@ -3,3 +3,7 @@ script.R
 inst/doc
 docs
 .Rhistory
+compile_commands.json
+.cache
+fetch_github_issue.py
+.Rbuildignore

From 20d740e837701de5579740b544e6dee8b45f3aaf Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Sun, 8 Sep 2024 15:20:23 -0400
Subject: [PATCH 04/29] define `S7_generic()` and `S7_method()` in `.onLoad()`

`new_class()` requires `prop_` dyn loaded symbol, which is not available at package build time.
---
 R/zzz.R | 43 ++++++++++++++++++++++++++++---------------
 1 file changed, 28 insertions(+), 15 deletions(-)

diff --git a/R/zzz.R b/R/zzz.R
index b4f463e5..b7ba1c36 100644
--- a/R/zzz.R
+++ b/R/zzz.R
@@ -88,25 +88,36 @@ check_subsettable <- function(x, allow_env = FALSE) {
   invisible(TRUE)
 }
 
-S7_generic <- new_class(
-  name = "S7_generic",
-  properties = list(
-    name = class_character,
-    methods = class_environment,
-    dispatch_args = class_character
-  ),
-  parent = class_function
-)
+S7_generic <- NULL
+
+on_load_define_S7_generic <- function() {
+  # we do this in .onLoad() because dynlib `prop_` symbol
+  # is not available at pkg build time, and new_class()
+  # errors if `@` is not usable.
+  S7_generic <<- new_class(
+    name = "S7_generic",
+    properties = list(
+      name = class_character,
+      methods = class_environment,
+      dispatch_args = class_character
+    ),
+    parent = class_function
+  )
+}
+
 methods::setOldClass(c("S7_generic", "function", "S7_object"))
 is_S7_generic <- function(x) inherits(x, "S7_generic")
 
-S7_method <- new_class("S7_method",
-  parent = class_function,
-  properties = list(
-    generic = S7_generic,
-    signature = class_list
+
+S7_method <- NULL
+
+on_load_define_S7_method <- function() {
+  S7_method <<- new_class(
+    "S7_method",
+    parent = class_function,
+    properties = list(generic = S7_generic, signature = class_list)
   )
-)
+}
 methods::setOldClass(c("S7_method", "function", "S7_object"))
 
 # hooks -------------------------------------------------------------------
@@ -121,6 +132,8 @@ methods::setOldClass(c("S7_method", "function", "S7_object"))
 .onLoad <- function(...) {
   activate_backward_compatiblility()
 
+  on_load_define_S7_generic()
+  on_load_define_S7_method()
   on_load_make_convert_generic()
   on_load_define_ops()
   on_load_define_or_methods()

From 208fb4e83e12e090b27c415fb66752db067f7983 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Sun, 8 Sep 2024 15:21:55 -0400
Subject: [PATCH 05/29] fix `prop` name collision

`class@prop` could be called instead of `S7::prop`,
if `class@prop` is a function.
---
 R/valid.R | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/R/valid.R b/R/valid.R
index ed2aaf27..65173557 100644
--- a/R/valid.R
+++ b/R/valid.R
@@ -103,14 +103,14 @@ validate <- function(object, recursive = TRUE, properties = TRUE) {
 validate_properties <- function(object, class) {
   errors <- character()
 
-  for (prop in class@properties) {
+  for (prop_obj in class@properties) {
     # Don't validate dynamic properties
-    if (!is.null(prop$getter)) {
+    if (!is.null(prop_obj$getter)) {
       next
     }
 
-    value <- prop(object, prop$name)
-    errors <- c(errors, prop_validate(prop, value))
+    value <- prop(object, prop_obj$name)
+    errors <- c(errors, prop_validate(prop_obj, value))
   }
 
   errors

From 434fa5295e0848cdc2102474305e37b050c3c0d4 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Sun, 8 Sep 2024 15:40:00 -0400
Subject: [PATCH 06/29] change constructor arg defaults

---
 R/base.R        | 12 ++++--------
 R/class-spec.R  | 10 ++++++++--
 R/class.R       | 14 +++-----------
 R/constructor.R | 38 ++++++++++++++++++++------------------
 R/property.R    |  2 +-
 R/utils.R       | 10 ++++++++++
 6 files changed, 46 insertions(+), 40 deletions(-)

diff --git a/R/base.R b/R/base.R
index 753da654..257d286d 100644
--- a/R/base.R
+++ b/R/base.R
@@ -1,12 +1,8 @@
 new_base_class <- function(name, constructor_name = name) {
   force(name)
 
-  constructor <- function(.data = class_missing) {
-    if (is_class_missing(.data)) {
-      .data <- base_default(name)
-    }
-    .data
-  }
+  constructor <- as.function.default(list(.data = base_default(name), quote(.data)),
+                                     baseenv())
 
   validator <- function(object) {
     if (base_class(object) != name) {
@@ -35,8 +31,8 @@ base_default <- function(type) {
     list = list(),
     expression = expression(),
 
-    `function` = function() {},
-    environment = new.env(parent = emptyenv())
+    `function` = quote(function() {}),
+    environment = quote(new.env(parent = emptyenv()))
 )}
 
 
diff --git a/R/class-spec.R b/R/class-spec.R
index 525766f6..5a7f3db9 100644
--- a/R/class-spec.R
+++ b/R/class-spec.R
@@ -80,7 +80,7 @@ class_friendly <- function(x) {
   )
 }
 
-class_constructor <- function(.x, ...) {
+class_constructor <- function(.x) {
   switch(class_type(.x),
     NULL = function() NULL,
     any = function() NULL,
@@ -92,8 +92,14 @@ class_constructor <- function(.x, ...) {
     stop(sprintf("Can't construct %s", class_friendly(.x)), call. = FALSE)
   )
 }
+
+class_construct_expr <- function(.x, ...) {
+  f <- class_constructor(.x)
+  as.call(list(f, ...))
+}
+
 class_construct <- function(.x, ...) {
-  class_constructor(.x)(...)
+  eval(class_construct_expr(.x, ...))
 }
 
 class_validate <- function(class, object) {
diff --git a/R/class.R b/R/class.R
index 426387bb..fe6521fc 100644
--- a/R/class.R
+++ b/R/class.R
@@ -260,17 +260,9 @@ new_object <- function(.parent, ...) {
   attr(object, "S7_class") <- class
   class(object) <- class_dispatch(class)
 
-  supplied_props <- nms[!vlapply(args, is_class_missing)]
-  for (prop in supplied_props) {
-    prop(object, prop, check = FALSE) <- args[[prop]]
-  }
-
-  # We have to fill in missing values after setting the initial properties,
-  # because custom setters might set property values
-  missing_props <- setdiff(nms, union(supplied_props, names(attributes(object))))
-  for (prop in missing_props) {
-    prop(object, prop, check = FALSE) <- prop_default(class@properties[[prop]])
-  }
+  # Set properties. This will potentially invoke custom property setters
+  for (name in names(args))
+    prop(object, name, check = FALSE) <- args[[name]]
 
   # Don't need to validate if parent class already validated,
   # i.e. it's a non-abstract S7 class
diff --git a/R/constructor.R b/R/constructor.R
index 1319e4e6..1bcd8c92 100644
--- a/R/constructor.R
+++ b/R/constructor.R
@@ -1,10 +1,11 @@
 new_constructor <- function(parent, properties) {
+  properties <- as_properties(properties)
   arg_info <- constructor_args(parent, properties)
-  self_args <- as_names(arg_info$self, named = TRUE)
+  self_args <- as_names(names(arg_info$self), named = TRUE)
 
   if (identical(parent, S7_object) || (is_class(parent) && parent@abstract)) {
     return(new_function(
-      args = missing_args(arg_info$self),
+      args = arg_info$self,
       body = new_call("new_object", c(list(quote(S7_object())), self_args)),
       env = asNamespace("S7")
     ))
@@ -13,16 +14,16 @@ new_constructor <- function(parent, properties) {
   if (is_class(parent)) {
     parent_name <- parent@name
     parent_fun <- parent
-    args <- missing_args(union(arg_info$parent, arg_info$self))
+    args <- modify_list(arg_info$parent, arg_info$self)
   } else if (is_base_class(parent)) {
     parent_name <- parent$constructor_name
     parent_fun <- parent$constructor
-    args <- missing_args(union(arg_info$parent, arg_info$self))
+    args <- modify_list(arg_info$parent, arg_info$self)
   } else if (is_S3_class(parent)) {
     parent_name <- paste0("new_", parent$class[[1]])
     parent_fun <- parent$constructor
     args <- formals(parent$constructor)
-    args[arg_info$self] <- missing_args(arg_info$self)
+    args[names(arg_info$self)] <- arg_info$self
   } else {
     # user facing error in S7_class()
     stop("Unsupported `parent` type", call. = FALSE)
@@ -33,7 +34,8 @@ new_constructor <- function(parent, properties) {
     args[names(args) == "..."] <- list(quote(expr = ))
   }
 
-  parent_args <- as_names(arg_info$parent, named = TRUE)
+  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))
 
@@ -44,7 +46,8 @@ new_constructor <- function(parent, properties) {
 }
 
 constructor_args <- function(parent, properties = list()) {
-  parent_args <- names2(formals(class_constructor(parent)))
+  parent_constructor_formals <- formals(class_constructor(parent))
+  parent_args <- names2(parent_constructor_formals)
 
   self_args <- names2(properties)
   # Remove dynamic arguments
@@ -55,22 +58,21 @@ constructor_args <- function(parent, properties = list()) {
     self_args <- setdiff(self_args, names2(parent@properties))
   }
 
-  list(
-    parent = parent_args,
-    self = self_args
-  )
+  self_args <- lapply(setNames(nm = self_args),
+                      function(name) prop_default(properties[[name]]))
+  parent_args <- parent_constructor_formals %||%
+    structure(list(), names = character())
+
+  list(parent = as.list(parent_args),
+       self = as.list(self_args))
 }
 
+is_property_dynamic <- function(prop) is.function(x$getter)
+
 # helpers -----------------------------------------------------------------
 
 new_function <- function(args, body, env) {
-  f <- function() {}
-  formals(f) <- args
-  body(f) <- body
-  environment(f) <- env
-  attr(f, "srcref") <- NULL
-
-  f
+  as.function.default(c(args, body), env)
 }
 missing_args <- function(names) {
   lapply(setNames(, names), function(i) quote(class_missing))
diff --git a/R/property.R b/R/property.R
index 66c53e12..6d3964e4 100644
--- a/R/property.R
+++ b/R/property.R
@@ -131,7 +131,7 @@ str.S7_property <- function(object, ..., nest.lev = 0) {
 }
 
 prop_default <- function(prop) {
-  prop$default %||% class_construct(prop$class)
+  prop$default %||% class_construct_expr(prop$class)
 }
 
 #' Get/set a property
diff --git a/R/utils.R b/R/utils.R
index 9e6ea4d6..c549b8bd 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -136,6 +136,16 @@ show_args <- function(x, name = "function", suffix = "") {
   paste0(name, "(", args, ")", suffix)
 }
 
+modify_list <- function (x, new_vals) {
+  stopifnot(is.list(x))
+
+  for (name in names(new_vals))
+    x[name] <- new_vals[name]
+
+  x
+}
+
+
 # For older versions of R ----------------------------------------------------
 deparse1 <- function(expr, collapse = " ", width.cutoff = 500L, ...) {
   paste(deparse(expr, width.cutoff, ...), collapse = collapse)

From b9cbad00fe8b36d80b4ef74830e9fd7111a0302f Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Sun, 8 Sep 2024 15:42:47 -0400
Subject: [PATCH 07/29] some effort to keep printing reasonably pretty

---
 R/class-spec.R | 31 +++++++++++++++++++++++++++++++
 R/utils.R      | 10 +++-------
 2 files changed, 34 insertions(+), 7 deletions(-)

diff --git a/R/class-spec.R b/R/class-spec.R
index 5a7f3db9..5ccc3a50 100644
--- a/R/class-spec.R
+++ b/R/class-spec.R
@@ -95,6 +95,37 @@ class_constructor <- function(.x) {
 
 class_construct_expr <- function(.x, ...) {
   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.)
+  fb <- body(f)
+  ff <- formals(f)
+  fe <- environment(f)
+
+  # early return if not safe to unwrap
+  if(length(list(...)))
+    return(as.call(list(f, ...)))
+
+  if(!identical(fe, baseenv()))
+    return(as.call(list(f, ...)))
+
+  if("new_object" %in% all.names(fb))
+    return(as.call(list(f, ...)))
+
+  # maybe unwrap if body is a single expression wrapped in `{`
+  if (length(fb) == 2L && identical(fb[[1L]], quote(`{`)))
+    fb <- fb[[2L]]
+
+  # If all the all the work happens in the promise to the `.data` arg,
+  # return the `.data` expression.
+  if ((identical(fb, quote(.data))) &&
+      identical(names(ff), ".data"))
+    return(ff$.data)
+
+  # if all the work happens in the function body, return the body.
+  if (is.null(ff))
+    return(fb)
+
+  #else, return a call to the constructor
   as.call(list(f, ...))
 }
 
diff --git a/R/utils.R b/R/utils.R
index c549b8bd..f46c3c10 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -113,13 +113,9 @@ show_function <- function(x, constructor = FALSE) {
   args <- formals(x)
 
   if (constructor) {
-    args <- lapply(args, function(x) {
-      if (identical(x, quote(class_missing))) {
-        quote(expr = )
-      } else {
-        x
-      }
-    })
+    # don't show the defaults arg values in the constructor, keep it compact
+    # TODO: do show the default values next to properties in class printouts.
+    args <- lapply(args, function(q) quote(expr =))
   }
 
   show_args(args, suffix = " {...}")

From 7ee32ddbb938581dcf9d831d69aec6be59e1b0a2 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Sun, 8 Sep 2024 15:48:41 -0400
Subject: [PATCH 08/29] update tests

---
 tests/testthat/_snaps/class.md       |  2 +-
 tests/testthat/_snaps/constructor.md | 16 ++++++++--------
 tests/testthat/helper.R              | 16 ++++++++++++++++
 tests/testthat/test-constructor.R    | 20 ++++++++++----------
 tests/testthat/test-property.R       |  2 +-
 5 files changed, 36 insertions(+), 20 deletions(-)

diff --git a/tests/testthat/_snaps/class.md b/tests/testthat/_snaps/class.md
index 3cb70b94..64515b4c 100644
--- a/tests/testthat/_snaps/class.md
+++ b/tests/testthat/_snaps/class.md
@@ -33,7 +33,7 @@
        ..  ..$ validator: NULL
        ..  ..$ default  : NULL
        @ abstract   : logi FALSE
-       @ constructor: function (x = class_missing, y = class_missing)  
+       @ constructor: function (x = integer(0), y = integer(0))  
        @ validator  : NULL
     Code
       str(list(foo2))
diff --git a/tests/testthat/_snaps/constructor.md b/tests/testthat/_snaps/constructor.md
index 5f48e511..8c824bb9 100644
--- a/tests/testthat/_snaps/constructor.md
+++ b/tests/testthat/_snaps/constructor.md
@@ -9,21 +9,21 @@
     Code
       new_constructor(S7_object, as_properties(list(x = class_numeric, y = class_numeric)))
     Output
-      function (x = class_missing, y = class_missing) 
+      function (x = integer(0), y = integer(0)) 
       new_object(S7_object(), x = x, y = y)
       <environment: namespace:S7>
     Code
       foo <- new_class("foo", parent = class_character)
       new_constructor(foo, list())
     Output
-      function (.data = class_missing) 
+      function (.data = character(0)) 
       new_object(foo(.data = .data))
       <environment: 0x0>
     Code
       foo2 <- new_class("foo2", parent = foo)
       new_constructor(foo2, list())
     Output
-      function (.data = class_missing) 
+      function (.data = character(0)) 
       new_object(foo2(.data = .data))
       <environment: 0x0>
 
@@ -38,8 +38,8 @@
     Code
       new_constructor(class_factor, as_properties(list(x = class_numeric, y = class_numeric)))
     Output
-      function (.data = integer(), levels = character(), x = class_missing, 
-          y = class_missing) 
+      function (.data = integer(), levels = character(), x = integer(0), 
+          y = integer(0)) 
       new_object(new_factor(.data = .data, levels = levels), x = x, 
           y = y)
       <environment: 0x0>
@@ -56,7 +56,7 @@
     Code
       new_constructor(foo1, as_properties(list(y = class_double)))
     Output
-      function (y = class_missing) 
+      function (y = numeric(0)) 
       new_object(S7_object(), y = y)
       <environment: namespace:S7>
 
@@ -65,7 +65,7 @@
     Code
       new_constructor(foo, list(y = class_double))
     Output
-      function (..., y = class_missing) 
-      new_object(foo(... = ...), y = y)
+      function (..., y = numeric(0)) 
+      new_object(foo(...), y = y)
       <environment: 0x0>
 
diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R
index 4e6a251e..b0c4bb1d 100644
--- a/tests/testthat/helper.R
+++ b/tests/testthat/helper.R
@@ -62,3 +62,19 @@ defer <- function(expr, frame = parent.frame(), after = FALSE) {
   thunk <- as.call(list(function() expr))
   do.call(on.exit, list(thunk, TRUE, after), envir = frame)
 }
+
+# always returns a named list
+nlist <- function(...) {
+  x <- list(...)
+  nms <- names2(x)
+
+  for (i in which(nms == "")) {
+    nm <- substitute(str2lang(paste0("..", i)))
+    if (!is.symbol(nm))
+      stop("Please provide a name for `", deparse(nm), "`")
+    nms[i] <- as.character(nm)
+  }
+
+  names(x) <- nms
+  x
+}
diff --git a/tests/testthat/test-constructor.R b/tests/testthat/test-constructor.R
index 45a73b20..8b6dd8ce 100644
--- a/tests/testthat/test-constructor.R
+++ b/tests/testthat/test-constructor.R
@@ -1,26 +1,26 @@
 test_that("generates correct arguments from parent + properties",  {
   # No arguments
   args <- constructor_args(S7_object)
-  expect_equal(args$self, character())
-  expect_equal(args$parent, character())
+  expect_equal(args$self, nlist())
+  expect_equal(args$parent, nlist())
 
   # Includes properties
   args <- constructor_args(S7_object, as_properties(list(x = class_numeric)))
-  expect_equal(args$self, "x")
-  expect_equal(args$parent, character())
+  expect_equal(args$self, list(x = integer()))
+  expect_equal(args$parent, nlist())
 
   # unless they're dynamic
   args <- constructor_args(S7_object,
     as_properties(list(x = new_property(getter = function(self) 10)))
   )
-  expect_equal(args$self, character())
-  expect_equal(args$parent, character())
+  expect_equal(args$self, nlist())
+  expect_equal(args$parent, nlist())
 
   # Includes parent properties
   foo <- new_class("foo", properties = list(x = class_numeric))
   args <- constructor_args(foo, as_properties(list(y = class_numeric)))
-  expect_equal(args$self, "y")
-  expect_equal(args$parent, "x")
+  expect_equal(args$self, list(y = integer()))
+  expect_equal(args$parent, list(x = integer()))
 
   # But only those in the constructor
   foo <- new_class("foo",
@@ -28,8 +28,8 @@ test_that("generates correct arguments from parent + properties",  {
     constructor = function() new_object(x = 1)
   )
   args <- constructor_args(foo, as_properties(list(y = class_numeric)))
-  expect_equal(args$self, "y")
-  expect_equal(args$parent, character())
+  expect_equal(args$self, list(y = integer()))
+  expect_equal(args$parent, nlist())
 })
 
 test_that("generates meaningful constructors", {
diff --git a/tests/testthat/test-property.R b/tests/testthat/test-property.R
index f5d9c813..02c260ca 100644
--- a/tests/testthat/test-property.R
+++ b/tests/testthat/test-property.R
@@ -244,7 +244,7 @@ test_that("properties can be base, S3, S4, S7, or S7 union", {
       anything = class_any,
       null = NULL,
       base = class_integer,
-      S3 = new_S3_class("factor"),
+      S3 = class_factor,
       S4 = class_S4,
       S7 = class_S7,
       S7_union = new_union(class_integer, class_logical)

From d45f3949e3ed81cc3213952ada106da3673becc2 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Sun, 8 Sep 2024 15:49:01 -0400
Subject: [PATCH 09/29] more test updates

---
 tests/testthat/test-property.R | 20 +++++++++++---------
 1 file changed, 11 insertions(+), 9 deletions(-)

diff --git a/tests/testthat/test-property.R b/tests/testthat/test-property.R
index 02c260ca..2d5e58b3 100644
--- a/tests/testthat/test-property.R
+++ b/tests/testthat/test-property.R
@@ -108,22 +108,25 @@ describe("prop setting", {
       "foo",
       properties = list(
         x = new_property(setter = function(self, value) {
-          self@x <- 1
-          self@y <- value + 1
+          self@x <- value
+          self@y <- paste0(value, "_set_by_x_setter")
           self
         }),
         y = new_property(setter = function(self, value) {
-          self@y <- 2
-          self@z <- as.integer(value + 1)
+          self@y <- value
+          self@z <- paste0(value, "_set_by_z_setter")
           self
         }),
-        z = new_property(class_integer)
+        z = new_property(class_character)
       ),
       validator = function(self) { add(times_validated) <<- 1L; NULL }
     )
-    out <- foo(x = 1)
+    out <- foo()
     expect_equal(times_validated, 1L)
-    expect_identical(out@z, 3L)
+
+    out@x <- "VAL"
+    expect_equal(times_validated, 2L)
+    expect_equal(out@z, "VAL_set_by_x_setter_set_by_z_setter")
   })
 
   it("does not run the check or validation functions if check = FALSE", {
@@ -396,8 +399,7 @@ test_that("custom getters don't infinitely recurse", {
   someclass <- new_class("someclass", properties = list(
     someprop = new_property(
       class_character,
-      getter = function(self)
-        self@someprop,
+      getter = function(self) self@someprop,
       setter = function(self, value) {
         self@someprop <- toupper(value)
         self

From eac36e491525b2b3702572486837193bdb412b58 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Mon, 9 Sep 2024 10:01:30 -0400
Subject: [PATCH 10/29] allow `new_property(default = <call|missing>)`

---
 R/property.R | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/R/property.R b/R/property.R
index 6d3964e4..c1479d12 100644
--- a/R/property.R
+++ b/R/property.R
@@ -88,7 +88,9 @@ new_property <- function(class = class_any,
                          default = NULL,
                          name = NULL) {
   class <- as_class(class)
-  if (!is.null(default) && !class_inherits(default, class)) {
+  if (!is.null(default) &&
+      (!is.call(default) || identical(default, quote(expr=))) && # allow calls or missing
+      !class_inherits(default, class)) {
     msg <- sprintf("`default` must be an instance of %s, not a %s", class_desc(class), obj_desc(default))
     stop(msg)
   }

From ad3b0b220bf631b07feed76c9066dadea58fe674 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Mon, 9 Sep 2024 10:01:41 -0400
Subject: [PATCH 11/29] test tweak

---
 tests/testthat/test-property.R | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/tests/testthat/test-property.R b/tests/testthat/test-property.R
index 2d5e58b3..e244ac83 100644
--- a/tests/testthat/test-property.R
+++ b/tests/testthat/test-property.R
@@ -114,7 +114,7 @@ describe("prop setting", {
         }),
         y = new_property(setter = function(self, value) {
           self@y <- value
-          self@z <- paste0(value, "_set_by_z_setter")
+          self@z <- paste0(value, "_set_by_y_setter")
           self
         }),
         z = new_property(class_character)
@@ -126,7 +126,7 @@ describe("prop setting", {
 
     out@x <- "VAL"
     expect_equal(times_validated, 2L)
-    expect_equal(out@z, "VAL_set_by_x_setter_set_by_z_setter")
+    expect_equal(out@z, "VAL_set_by_x_setter_set_by_y_setter")
   })
 
   it("does not run the check or validation functions if check = FALSE", {

From 159de6f39a298e18ff0eb4c95b2b8539e9a280db Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Mon, 9 Sep 2024 10:28:37 -0400
Subject: [PATCH 12/29] style changes and other tweaks

---
 R/aaa.R         |  4 ++++
 R/base.R        | 10 +++++++---
 R/class-spec.R  | 28 +++++++++++++++++++---------
 R/constructor.R |  3 ---
 4 files changed, 30 insertions(+), 15 deletions(-)
 create mode 100644 R/aaa.R

diff --git a/R/aaa.R b/R/aaa.R
new file mode 100644
index 00000000..ed489278
--- /dev/null
+++ b/R/aaa.R
@@ -0,0 +1,4 @@
+
+new_function <- function(args, body, env) {
+  as.function.default(c(args, body), env)
+}
diff --git a/R/base.R b/R/base.R
index 257d286d..0e7dc40a 100644
--- a/R/base.R
+++ b/R/base.R
@@ -1,12 +1,16 @@
 new_base_class <- function(name, constructor_name = name) {
   force(name)
 
-  constructor <- as.function.default(list(.data = base_default(name), quote(.data)),
-                                     baseenv())
+  constructor <- new_function(
+    args = list(.data = base_default(name)),
+    body = quote(.data),
+    env = baseenv()
+  )
 
   validator <- function(object) {
     if (base_class(object) != name) {
-      sprintf("Underlying data must be <%s> not <%s>", name, base_class(object))
+      sprintf("Underlying data must be <%s> not <%s>",
+              name, base_class(object))
     }
   }
 
diff --git a/R/class-spec.R b/R/class-spec.R
index 5ccc3a50..efa7f187 100644
--- a/R/class-spec.R
+++ b/R/class-spec.R
@@ -97,33 +97,43 @@ class_construct_expr <- function(.x, ...) {
   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.)
-  fb <- body(f)
-  ff <- formals(f)
-  fe <- environment(f)
 
-  # early return if not safe to unwrap
-  if(length(list(...)))
+  ## early return if not safe to unwrap
+  # can't unwrap if we're passing on ...
+  if(...length()) {
     return(as.call(list(f, ...)))
+  }
 
-  if(!identical(fe, baseenv()))
+  # 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("new_object" %in% all.names(fb))
+  # `new_object()` must be called from the class constructor, can't
+  # be safely unwrapped
+  fb <- body(f)
+  if("new_object" %in% all.names(fb)) {
     return(as.call(list(f, ...)))
+  }
 
   # maybe unwrap if body is a single expression wrapped in `{`
   if (length(fb) == 2L && identical(fb[[1L]], quote(`{`)))
     fb <- fb[[2L]]
 
+  ff <- formals(f)
   # If all the all the work happens in the promise to the `.data` arg,
   # return the `.data` expression.
   if ((identical(fb, quote(.data))) &&
-      identical(names(ff), ".data"))
+      identical(names(ff), ".data")) {
     return(ff$.data)
+  }
 
   # if all the work happens in the function body, return the body.
-  if (is.null(ff))
+  if (is.null(ff)) {
     return(fb)
+  }
 
   #else, return a call to the constructor
   as.call(list(f, ...))
diff --git a/R/constructor.R b/R/constructor.R
index 1bcd8c92..32824f68 100644
--- a/R/constructor.R
+++ b/R/constructor.R
@@ -71,9 +71,6 @@ is_property_dynamic <- function(prop) is.function(x$getter)
 
 # helpers -----------------------------------------------------------------
 
-new_function <- function(args, body, env) {
-  as.function.default(c(args, body), env)
-}
 missing_args <- function(names) {
   lapply(setNames(, names), function(i) quote(class_missing))
 }

From c136f3da27f9468d34ebf5d54df39efe6f7f8a9d Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Mon, 9 Sep 2024 10:32:26 -0400
Subject: [PATCH 13/29] more style changes; reorder fn defs

---
 R/class-spec.R | 34 ++++++++++++++++++----------------
 1 file changed, 18 insertions(+), 16 deletions(-)

diff --git a/R/class-spec.R b/R/class-spec.R
index efa7f187..05b19e6b 100644
--- a/R/class-spec.R
+++ b/R/class-spec.R
@@ -80,22 +80,15 @@ class_friendly <- function(x) {
   )
 }
 
-class_constructor <- function(.x) {
-  switch(class_type(.x),
-    NULL = function() NULL,
-    any = function() NULL,
-    S4 = function(...) methods::new(.x, ...),
-    S7 = .x,
-    S7_base = .x$constructor,
-    S7_union = class_constructor(.x$classes[[1]]),
-    S7_S3 = .x$constructor,
-    stop(sprintf("Can't construct %s", class_friendly(.x)), call. = FALSE)
-  )
+class_construct <- function(.x, ...) {
+  eval(class_construct_expr(.x, ...))
 }
 
+
 class_construct_expr <- function(.x, ...) {
   f <- class_constructor(.x)
-  # If the constructor is a closure wrapping a simple expression, try to extract the expression
+  # 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
@@ -118,13 +111,13 @@ class_construct_expr <- function(.x, ...) {
     return(as.call(list(f, ...)))
   }
 
-  # maybe unwrap if body is a single expression wrapped in `{`
+  # maybe unwrap body if it is a single expression wrapped in `{`
   if (length(fb) == 2L && identical(fb[[1L]], quote(`{`)))
     fb <- fb[[2L]]
 
-  ff <- formals(f)
   # If all the all the work happens in the promise to the `.data` arg,
   # return the `.data` expression.
+  ff <- formals(f)
   if ((identical(fb, quote(.data))) &&
       identical(names(ff), ".data")) {
     return(ff$.data)
@@ -139,8 +132,17 @@ class_construct_expr <- function(.x, ...) {
   as.call(list(f, ...))
 }
 
-class_construct <- function(.x, ...) {
-  eval(class_construct_expr(.x, ...))
+class_constructor <- function(.x) {
+  switch(class_type(.x),
+         NULL = function() NULL,
+         any = function() NULL,
+         S4 = function(...) methods::new(.x, ...),
+         S7 = .x,
+         S7_base = .x$constructor,
+         S7_union = class_constructor(.x$classes[[1]]),
+         S7_S3 = .x$constructor,
+         stop(sprintf("Can't construct %s", class_friendly(.x)), call. = FALSE)
+  )
 }
 
 class_validate <- function(class, object) {

From 1ea6ebe19aaf8449e3a3981dc03d99a3bfdb6cbe Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Mon, 9 Sep 2024 11:14:13 -0400
Subject: [PATCH 14/29] simplify `modify_list()`

---
 R/utils.R | 10 +++++++---
 1 file changed, 7 insertions(+), 3 deletions(-)

diff --git a/R/utils.R b/R/utils.R
index f46c3c10..d54bd2e5 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -133,10 +133,14 @@ show_args <- function(x, name = "function", suffix = "") {
 }
 
 modify_list <- function (x, new_vals) {
-  stopifnot(is.list(x))
+  stopifnot(is.list(x) || is.pairlist(x), all(nzchar(names2(x))))
 
-  for (name in names(new_vals))
-    x[name] <- new_vals[name]
+  if (length(new_vals)) {
+    nms <- names2(new_vals)
+    if (!all(nzchar(nms)))
+      stop("all elements in `new_vals` must be named")
+    x[nms] <- new_vals
+  }
 
   x
 }

From 257eeb9b83e6cf2a9e1856367f1ecf3d18a6140e Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Mon, 9 Sep 2024 11:14:40 -0400
Subject: [PATCH 15/29] return `pairlist()`s from `constructor_args()`

---
 R/constructor.R                   | 25 +++++++++++++------------
 tests/testthat/test-constructor.R | 20 ++++++++++----------
 2 files changed, 23 insertions(+), 22 deletions(-)

diff --git a/R/constructor.R b/R/constructor.R
index 32824f68..fb24231d 100644
--- a/R/constructor.R
+++ b/R/constructor.R
@@ -46,31 +46,32 @@ new_constructor <- function(parent, properties) {
 }
 
 constructor_args <- function(parent, properties = list()) {
-  parent_constructor_formals <- formals(class_constructor(parent))
-  parent_args <- names2(parent_constructor_formals)
+  parent_args <- formals(class_constructor(parent))
 
-  self_args <- names2(properties)
+  self_arg_nms <- names2(properties)
   # Remove dynamic arguments
-  self_args <- self_args[vlapply(properties, function(x) is.null(x$getter))]
+  self_arg_nms <- self_arg_nms[vlapply(properties, function(x) is.null(x$getter))]
+
   if (is_class(parent) && !parent@abstract) {
     # Remove any parent properties; can't use parent_args() since the constructor
     # might automatically set some properties.
-    self_args <- setdiff(self_args, names2(parent@properties))
+    self_arg_nms <- setdiff(self_arg_nms, names2(parent@properties))
   }
 
-  self_args <- lapply(setNames(nm = self_args),
-                      function(name) prop_default(properties[[name]]))
-  parent_args <- parent_constructor_formals %||%
-    structure(list(), names = character())
+  self_args <- as.pairlist(lapply(
+    setNames(, self_arg_nms),
+    function(name) prop_default(properties[[name]]))
+  )
 
-  list(parent = as.list(parent_args),
-       self = as.list(self_args))
+  list(parent = parent_args,
+       self = self_args)
 }
 
-is_property_dynamic <- function(prop) is.function(x$getter)
 
 # helpers -----------------------------------------------------------------
 
+is_property_dynamic <- function(x) is.function(x$getter)
+
 missing_args <- function(names) {
   lapply(setNames(, names), function(i) quote(class_missing))
 }
diff --git a/tests/testthat/test-constructor.R b/tests/testthat/test-constructor.R
index 8b6dd8ce..554261b4 100644
--- a/tests/testthat/test-constructor.R
+++ b/tests/testthat/test-constructor.R
@@ -1,26 +1,26 @@
 test_that("generates correct arguments from parent + properties",  {
   # No arguments
   args <- constructor_args(S7_object)
-  expect_equal(args$self, nlist())
-  expect_equal(args$parent, nlist())
+  expect_equal(args$self, pairlist())
+  expect_equal(args$parent, pairlist())
 
   # Includes properties
   args <- constructor_args(S7_object, as_properties(list(x = class_numeric)))
-  expect_equal(args$self, list(x = integer()))
-  expect_equal(args$parent, nlist())
+  expect_equal(args$self, pairlist(x = integer()))
+  expect_equal(args$parent, pairlist())
 
   # unless they're dynamic
   args <- constructor_args(S7_object,
     as_properties(list(x = new_property(getter = function(self) 10)))
   )
-  expect_equal(args$self, nlist())
-  expect_equal(args$parent, nlist())
+  expect_equal(args$self, pairlist())
+  expect_equal(args$parent, pairlist())
 
   # Includes parent properties
   foo <- new_class("foo", properties = list(x = class_numeric))
   args <- constructor_args(foo, as_properties(list(y = class_numeric)))
-  expect_equal(args$self, list(y = integer()))
-  expect_equal(args$parent, list(x = integer()))
+  expect_equal(args$self, pairlist(y = integer()))
+  expect_equal(args$parent, pairlist(x = integer()))
 
   # But only those in the constructor
   foo <- new_class("foo",
@@ -28,8 +28,8 @@ test_that("generates correct arguments from parent + properties",  {
     constructor = function() new_object(x = 1)
   )
   args <- constructor_args(foo, as_properties(list(y = class_numeric)))
-  expect_equal(args$self, list(y = integer()))
-  expect_equal(args$parent, nlist())
+  expect_equal(args$self, pairlist(y = integer()))
+  expect_equal(args$parent, pairlist())
 })
 
 test_that("generates meaningful constructors", {

From 4c0c6ed88608523357f0c668f8940699a6ae1aef Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Mon, 9 Sep 2024 11:15:38 -0400
Subject: [PATCH 16/29] delete `nlist` / `named_list()` helper

---
 tests/testthat/helper.R | 16 ----------------
 1 file changed, 16 deletions(-)

diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R
index b0c4bb1d..4e6a251e 100644
--- a/tests/testthat/helper.R
+++ b/tests/testthat/helper.R
@@ -62,19 +62,3 @@ defer <- function(expr, frame = parent.frame(), after = FALSE) {
   thunk <- as.call(list(function() expr))
   do.call(on.exit, list(thunk, TRUE, after), envir = frame)
 }
-
-# always returns a named list
-nlist <- function(...) {
-  x <- list(...)
-  nms <- names2(x)
-
-  for (i in which(nms == "")) {
-    nm <- substitute(str2lang(paste0("..", i)))
-    if (!is.symbol(nm))
-      stop("Please provide a name for `", deparse(nm), "`")
-    nms[i] <- as.character(nm)
-  }
-
-  names(x) <- nms
-  x
-}

From ec1b022a96ab9407209e86d73a3070098bdb2a29 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <kalinowskit@gmail.com>
Date: Mon, 9 Sep 2024 12:24:46 -0400
Subject: [PATCH 17/29] remove accidental `.gitignore` entries

---
 .gitignore | 2 --
 1 file changed, 2 deletions(-)

diff --git a/.gitignore b/.gitignore
index 8e02e4b2..c69b61b7 100644
--- a/.gitignore
+++ b/.gitignore
@@ -5,5 +5,3 @@ docs
 .Rhistory
 compile_commands.json
 .cache
-fetch_github_issue.py
-.Rbuildignore

From d717400335241216d58057413cae59ec297288c2 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Mon, 9 Sep 2024 18:26:08 -0400
Subject: [PATCH 18/29] accept `class_missing` as a prop.

---
 R/aaa.R        | 5 ++++-
 R/class-spec.R | 7 ++++++-
 R/property.R   | 2 +-
 3 files changed, 11 insertions(+), 3 deletions(-)

diff --git a/R/aaa.R b/R/aaa.R
index ed489278..cfd6c6b3 100644
--- a/R/aaa.R
+++ b/R/aaa.R
@@ -1,4 +1,7 @@
 
-new_function <- function(args, body, env) {
+
+new_function <- function(args = NULL,
+                         body = call(`{`),
+                         env = asNamespace("S7")) {
   as.function.default(c(args, body), env)
 }
diff --git a/R/class-spec.R b/R/class-spec.R
index 05b19e6b..74ab7db2 100644
--- a/R/class-spec.R
+++ b/R/class-spec.R
@@ -104,9 +104,13 @@ class_construct_expr <- function(.x, ...) {
     return(as.call(list(f, ...)))
   }
 
+  # special case for `class_missing`
+  if (identical(body(f) -> fb, quote(expr =))) {
+    return(quote(expr =))
+  }
+
   # `new_object()` must be called from the class constructor, can't
   # be safely unwrapped
-  fb <- body(f)
   if("new_object" %in% all.names(fb)) {
     return(as.call(list(f, ...)))
   }
@@ -135,6 +139,7 @@ class_construct_expr <- function(.x, ...) {
 class_constructor <- function(.x) {
   switch(class_type(.x),
          NULL = function() NULL,
+         missing = new_function(, quote(expr =), baseenv()),
          any = function() NULL,
          S4 = function(...) methods::new(.x, ...),
          S7 = .x,
diff --git a/R/property.R b/R/property.R
index c1479d12..a41fab81 100644
--- a/R/property.R
+++ b/R/property.R
@@ -89,7 +89,7 @@ new_property <- function(class = class_any,
                          name = NULL) {
   class <- as_class(class)
   if (!is.null(default) &&
-      (!is.call(default) || identical(default, quote(expr=))) && # allow calls or missing
+      !(is.call(default) || identical(default, quote(expr=))) && # allow calls or missing
       !class_inherits(default, class)) {
     msg <- sprintf("`default` must be an instance of %s, not a %s", class_desc(class), obj_desc(default))
     stop(msg)

From e7d792fe0fdd2249158207e9f7879461746d544f Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Tue, 10 Sep 2024 08:54:03 -0400
Subject: [PATCH 19/29] allow symbol arg defaults

---
 R/property.R | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/R/property.R b/R/property.R
index a41fab81..bc0d64fe 100644
--- a/R/property.R
+++ b/R/property.R
@@ -89,7 +89,7 @@ new_property <- function(class = class_any,
                          name = NULL) {
   class <- as_class(class)
   if (!is.null(default) &&
-      !(is.call(default) || identical(default, quote(expr=))) && # allow calls or missing
+      !(is.call(default) || is.symbol(default)) && # allow promises
       !class_inherits(default, class)) {
     msg <- sprintf("`default` must be an instance of %s, not a %s", class_desc(class), obj_desc(default))
     stop(msg)

From d069a8f2c714996308ecf77f850bc4ae4cb1dc29 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Tue, 10 Sep 2024 09:00:14 -0400
Subject: [PATCH 20/29] add tests

---
 tests/testthat/test-constructor.R | 63 +++++++++++++++++++++++++++++++
 1 file changed, 63 insertions(+)

diff --git a/tests/testthat/test-constructor.R b/tests/testthat/test-constructor.R
index 554261b4..d577bc8a 100644
--- a/tests/testthat/test-constructor.R
+++ b/tests/testthat/test-constructor.R
@@ -85,3 +85,66 @@ test_that("can use `...` in parent constructor", {
   expect_equal(bar(2)@x, list(2))
   expect_equal(bar(y = 2)@x, list())
 })
+
+test_that("can create constructors with missing or lazy defaults", {
+
+  Person <- new_class(
+    name = "Person",
+    properties = list(
+      # non-dynamic, default missing (required constructor arg)
+      first_name = new_property(class_character, default = quote(expr = )),
+
+      # non-dynamic, static default (optional constructor arg)
+      middle_name = new_property(class_character, default = ""),
+
+      # non-dynamic, default missing (required constructor arg) (same as first_name)
+      last_name = new_property(class_missing | class_character),
+
+      # non-dynamic, but defaults to the value of another property
+      nick_name = new_property(class_character, default = quote(first_name)),
+
+      # non-dynamic, optional constructor argument, read-only after construction.
+      birthdate = new_property(
+        class = class_Date,
+        default = quote(Sys.Date()),
+        setter = function(self, value) {
+          if (!is.null(self@birthdate))
+            stop("Can't set read-only property Person@birthdate")
+          self@birthdate <- value
+          self
+        }
+      ),
+
+      # dynamic property, not a constructor argument
+      age = new_property(class = class_any, getter = \(self) {
+        Sys.Date() - self@birthdate
+      })
+    )
+  )
+
+  expect_equal(formals(Person), as.pairlist(alist(
+    first_name = ,
+    middle_name = "",
+    last_name = ,
+    nick_name = first_name,
+    birthdate = Sys.Date()
+  ))) # no age
+
+  expect_error(Person(), 'argument "first_name" is missing, with no default')
+  expect_error(Person("Alice"), 'argument "last_name" is missing, with no default')
+
+  p <- Person("Alice", ,"Smith")
+
+  expect_equal(p@nick_name, "Alice")
+  expect_equal(p@middle_name, "")
+  expect_equal(p@birthdate, Sys.Date())
+  expect_equal(p@age, Sys.Date() - Sys.Date())
+
+  p <- Person("Bob", nick_name = "Bobby", "Allen" , "Smith", as.Date('1970-01-01'))
+  expect_equal(p@nick_name, "Bobby")
+  expect_equal(p@birthdate, as.Date('1970-01-01'))
+  expect_equal(p@age, Sys.Date() - as.Date('1970-01-01'))
+  expect_equal(p@middle_name, "Allen")
+  expect_error(p@birthdate <- as.Date('1970-01-01'),
+               "Can\'t set read-only property Person@birthdate")
+})

From 562af65e71afe674d21b355250da471f64f37a29 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Tue, 10 Sep 2024 09:26:53 -0400
Subject: [PATCH 21/29] update `new_property()` docs

---
 R/property.R        | 21 +++++++++++++++++++--
 man/new_property.Rd | 21 +++++++++++++++++++--
 2 files changed, 38 insertions(+), 4 deletions(-)

diff --git a/R/property.R b/R/property.R
index bc0d64fe..224fee7b 100644
--- a/R/property.R
+++ b/R/property.R
@@ -7,7 +7,8 @@
 #'
 #' By specifying a `getter` and/or `setter`, you can make the property
 #' "dynamic" so that it's computed when accessed or has some non-standard
-#' behaviour when modified.
+#' behaviour when modified. Dynamic properties are not included as an argument
+#' to the default class constructor.
 #'
 #' @param class Class that the property must be an instance of.
 #'   See [as_class()] for details.
@@ -59,9 +60,13 @@
 #' my_clock <- clock()
 #' my_clock@now; Sys.sleep(1)
 #' my_clock@now
-#' # This property is read only
+#' # This property is read only, because there is a 'getter' but not a 'setter'
 #' try(my_clock@now <- 10)
 #'
+#' # Because the property is dynamic, it is not included as an
+#' # argument to the default constructor
+#' "now" %in% names(formals(clock)) # FALSE
+#'
 #' # These can be useful if you want to deprecate a property
 #' person <- new_class("person", properties = list(
 #'   first_name = class_character,
@@ -81,6 +86,18 @@
 #' hadley@firstName
 #' hadley@firstName <- "John"
 #' hadley@first_name
+#'
+#' # Properties can have default values that are language objects.
+#' # These become standard function promises in the default constructor,
+#' # evaluated at the time the object is constructed.
+#' stopwatch <- new_class("stopwatch", properties = list(
+#'   starttime = new_property(class = class_POSIXct, default = quote(Sys.time())),
+#'   totaltime = new_property(getter = function(self)
+#'     difftime(Sys.time(), self@starttime, units = "secs"))
+#' ))
+#' args(stopwatch)
+#' round( stopwatch()@totaltime )
+#' round( stopwatch(Sys.time() - 1)@totaltime )
 new_property <- function(class = class_any,
                          getter = NULL,
                          setter = NULL,
diff --git a/man/new_property.Rd b/man/new_property.Rd
index 70e7cd58..74ce9603 100644
--- a/man/new_property.Rd
+++ b/man/new_property.Rd
@@ -58,7 +58,8 @@ limited to a data of a specific \code{class}.
 
 By specifying a \code{getter} and/or \code{setter}, you can make the property
 "dynamic" so that it's computed when accessed or has some non-standard
-behaviour when modified.
+behaviour when modified. Dynamic properties are not included as an argument
+to the default class constructor.
 }
 \examples{
 # Simple properties store data inside an object
@@ -80,9 +81,13 @@ clock <- new_class("clock", properties = list(
 my_clock <- clock()
 my_clock@now; Sys.sleep(1)
 my_clock@now
-# This property is read only
+# This property is read only, because there is a 'getter' but not a 'setter'
 try(my_clock@now <- 10)
 
+# Because the property is dynamic, it is not included as an
+# argument to the default constructor
+"now" \%in\% names(formals(clock)) # FALSE
+
 # These can be useful if you want to deprecate a property
 person <- new_class("person", properties = list(
   first_name = class_character,
@@ -102,4 +107,16 @@ hadley <- person(first_name = "Hadley")
 hadley@firstName
 hadley@firstName <- "John"
 hadley@first_name
+
+# Properties can have default values that are language objects.
+# These become standard function promises in the default constructor,
+# evaluated at the time the object is constructed.
+stopwatch <- new_class("stopwatch", properties = list(
+  starttime = new_property(class = class_POSIXct, default = quote(Sys.time())),
+  totaltime = new_property(getter = function(self)
+    difftime(Sys.time(), self@starttime, units = "secs"))
+))
+args(stopwatch)
+round( stopwatch()@totaltime )
+round( stopwatch(Sys.time() - 1)@totaltime )
 }

From 095e93a5d22391da1100248a4dca6285a561af41 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Tue, 10 Sep 2024 09:42:00 -0400
Subject: [PATCH 22/29] add NEWS

---
 .Rbuildignore | 1 +
 .gitignore    | 1 +
 NEWS.md       | 6 ++++++
 3 files changed, 8 insertions(+)

diff --git a/.Rbuildignore b/.Rbuildignore
index ceadd3ea..f9d9a651 100644
--- a/.Rbuildignore
+++ b/.Rbuildignore
@@ -17,3 +17,4 @@
 ^CRAN-SUBMISSION$
 ^compile_commands\.json$
 ^\.cache$
+^\.vscode$
diff --git a/.gitignore b/.gitignore
index c69b61b7..931b8c42 100644
--- a/.gitignore
+++ b/.gitignore
@@ -5,3 +5,4 @@ docs
 .Rhistory
 compile_commands.json
 .cache
+.vscode
diff --git a/NEWS.md b/NEWS.md
index e55f3ce9..91a42e85 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,5 +1,11 @@
 # S7 (development version)
 
+* The default object constructor returned by `new_class()` has been updated. 
+  It now accepts missing and lazy (promise) property defaults. Additionally, 
+  all custom property setters are now consistently invoked by the default 
+  constructor. If you're using S7 in an R package, you'll need to re-document 
+  to ensure that your docs match the updated usage (#438).
+
 * Fixed an issue where a custom property `getter()` would infinitely recurse 
   when accessing itself (reported in #403, fixed in #406).
 

From 7b8982fa10e7c033a2d6378aec94de470e03ba29 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Tue, 10 Sep 2024 09:56:01 -0400
Subject: [PATCH 23/29] add more `new_property()` doc examples

Show how to make a missing, required
constructor arg.
---
 R/property.R        | 9 +++++++++
 man/new_property.Rd | 9 +++++++++
 2 files changed, 18 insertions(+)

diff --git a/R/property.R b/R/property.R
index 224fee7b..c3573b46 100644
--- a/R/property.R
+++ b/R/property.R
@@ -98,6 +98,15 @@
 #' args(stopwatch)
 #' round( stopwatch()@totaltime )
 #' round( stopwatch(Sys.time() - 1)@totaltime )
+#'
+#' # Properties can also have a 'missing' default value, making them
+#' # required arguments to the default constructor.
+#' # You can generate a missing arg with `quote(expr =)` or `rlang::missing_arg()`
+#' Person <- new_class("Person", properties = list(
+#'   name = new_property(class_character, default = quote(expr = ))
+#' ))
+#' try(Person())
+#' Person("Alice")
 new_property <- function(class = class_any,
                          getter = NULL,
                          setter = NULL,
diff --git a/man/new_property.Rd b/man/new_property.Rd
index 74ce9603..5bae06bc 100644
--- a/man/new_property.Rd
+++ b/man/new_property.Rd
@@ -119,4 +119,13 @@ stopwatch <- new_class("stopwatch", properties = list(
 args(stopwatch)
 round( stopwatch()@totaltime )
 round( stopwatch(Sys.time() - 1)@totaltime )
+
+# Properties can also have a 'missing' default value, making them
+# required arguments to the default constructor.
+# You can generate a missing arg with `quote(expr =)` or `rlang::missing_arg()`
+Person <- new_class("Person", properties = list(
+  name = new_property(class_character, default = quote(expr = ))
+))
+try(Person())
+Person("Alice")
 }

From 9fcf3d76afe3c63e6eb8e1bfc8da71c4bec0ec8e Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Tue, 10 Sep 2024 11:10:12 -0400
Subject: [PATCH 24/29] helper tweak

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

diff --git a/R/aaa.R b/R/aaa.R
index cfd6c6b3..b9a28394 100644
--- a/R/aaa.R
+++ b/R/aaa.R
@@ -1,7 +1,7 @@
 
 
 new_function <- function(args = NULL,
-                         body = call(`{`),
+                         body = NULL,
                          env = asNamespace("S7")) {
-  as.function.default(c(args, body), env)
+  as.function.default(c(args, body) %||% list(NULL), env)
 }

From 83ab2cbc735e14c9157e41028b34d3ff1f923e7d Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Tue, 10 Sep 2024 13:00:07 -0400
Subject: [PATCH 25/29] Update R/property.R

Co-authored-by: Hadley Wickham <h.wickham@gmail.com>
---
 R/property.R | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/R/property.R b/R/property.R
index c3573b46..8b60f4b3 100644
--- a/R/property.R
+++ b/R/property.R
@@ -87,7 +87,7 @@
 #' hadley@firstName <- "John"
 #' hadley@first_name
 #'
-#' # Properties can have default values that are language objects.
+#' # Properties can have default values that are quoted calls.
 #' # These become standard function promises in the default constructor,
 #' # evaluated at the time the object is constructed.
 #' stopwatch <- new_class("stopwatch", properties = list(

From f381fcaa2b2f9a02d2f500995b74b55bc98a87a3 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Tue, 10 Sep 2024 13:00:46 -0400
Subject: [PATCH 26/29] Update R/property.R

Co-authored-by: Hadley Wickham <h.wickham@gmail.com>
---
 R/property.R | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/R/property.R b/R/property.R
index 8b60f4b3..dfdb408e 100644
--- a/R/property.R
+++ b/R/property.R
@@ -96,8 +96,8 @@
 #'     difftime(Sys.time(), self@starttime, units = "secs"))
 #' ))
 #' args(stopwatch)
-#' round( stopwatch()@totaltime )
-#' round( stopwatch(Sys.time() - 1)@totaltime )
+#' round(stopwatch()@totaltime)
+#' round(stopwatch(Sys.time() - 1)@totaltime)
 #'
 #' # Properties can also have a 'missing' default value, making them
 #' # required arguments to the default constructor.

From f264c39298a4b16a4583e8af6b1ca2cb75df5a5f Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Tue, 10 Sep 2024 13:12:01 -0400
Subject: [PATCH 27/29] Add suggested doc changes.

---
 R/property.R        |  9 ++++++---
 man/new_property.Rd | 15 +++++++++------
 2 files changed, 15 insertions(+), 9 deletions(-)

diff --git a/R/property.R b/R/property.R
index dfdb408e..2bf677ec 100644
--- a/R/property.R
+++ b/R/property.R
@@ -32,8 +32,10 @@
 #'   The validator will be called after the `class` has been verified, so
 #'   your code can assume that `value` has known type.
 #' @param default When an object is created and the property is not supplied,
-#'   what should it default to? If `NULL`, defaults to the "empty" instance
-#'   of `class`.
+#'   what should it default to? If `NULL`, it defaults to the "empty" instance
+#'   of `class`. This can also be a quoted call, which then becomes a standard
+#'   function promise in the default constructor, evaluated at the time the
+#'   object is constructed.
 #' @param name Property name, primarily used for error messages. Generally
 #'   don't need to set this here, as it's more convenient to supply as a
 #'   the element name when defining a list of properties. If both `name`
@@ -65,7 +67,8 @@
 #'
 #' # Because the property is dynamic, it is not included as an
 #' # argument to the default constructor
-#' "now" %in% names(formals(clock)) # FALSE
+#' try(clock(now = 10))
+#' args(clock)
 #'
 #' # These can be useful if you want to deprecate a property
 #' person <- new_class("person", properties = list(
diff --git a/man/new_property.Rd b/man/new_property.Rd
index 5bae06bc..461e64b0 100644
--- a/man/new_property.Rd
+++ b/man/new_property.Rd
@@ -40,8 +40,10 @@ The validator will be called after the \code{class} has been verified, so
 your code can assume that \code{value} has known type.}
 
 \item{default}{When an object is created and the property is not supplied,
-what should it default to? If \code{NULL}, defaults to the "empty" instance
-of \code{class}.}
+what should it default to? If \code{NULL}, it defaults to the "empty" instance
+of \code{class}. This can also be a quoted call, which then becomes a standard
+function promise in the default constructor, evaluated at the time the
+object is constructed.}
 
 \item{name}{Property name, primarily used for error messages. Generally
 don't need to set this here, as it's more convenient to supply as a
@@ -86,7 +88,8 @@ try(my_clock@now <- 10)
 
 # Because the property is dynamic, it is not included as an
 # argument to the default constructor
-"now" \%in\% names(formals(clock)) # FALSE
+try(clock(now = 10))
+args(clock)
 
 # These can be useful if you want to deprecate a property
 person <- new_class("person", properties = list(
@@ -108,7 +111,7 @@ hadley@firstName
 hadley@firstName <- "John"
 hadley@first_name
 
-# Properties can have default values that are language objects.
+# Properties can have default values that are quoted calls.
 # These become standard function promises in the default constructor,
 # evaluated at the time the object is constructed.
 stopwatch <- new_class("stopwatch", properties = list(
@@ -117,8 +120,8 @@ stopwatch <- new_class("stopwatch", properties = list(
     difftime(Sys.time(), self@starttime, units = "secs"))
 ))
 args(stopwatch)
-round( stopwatch()@totaltime )
-round( stopwatch(Sys.time() - 1)@totaltime )
+round(stopwatch()@totaltime)
+round(stopwatch(Sys.time() - 1)@totaltime)
 
 # Properties can also have a 'missing' default value, making them
 # required arguments to the default constructor.

From 299ae86cb922cab20e4893213d968acbfb0c8c6d Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Tue, 10 Sep 2024 16:51:26 -0400
Subject: [PATCH 28/29] move `%||%` into `aaa.R`

---
 R/aaa.R   | 2 ++
 R/utils.R | 1 -
 2 files changed, 2 insertions(+), 1 deletion(-)

diff --git a/R/aaa.R b/R/aaa.R
index b9a28394..6b33979d 100644
--- a/R/aaa.R
+++ b/R/aaa.R
@@ -1,5 +1,7 @@
 
 
+`%||%` <- function(x, y) if (is.null(x)) y else x
+
 new_function <- function(args = NULL,
                          body = NULL,
                          env = asNamespace("S7")) {
diff --git a/R/utils.R b/R/utils.R
index d54bd2e5..e04ec31b 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -11,7 +11,6 @@ global_variables <- function(names) {
 
 vlapply <- function(X, FUN, ...) vapply(X = X, FUN = FUN, FUN.VALUE = logical(1), ...)
 vcapply <- function(X, FUN, ...) vapply(X = X, FUN = FUN, FUN.VALUE = character(1), ...)
-`%||%` <- function(x, y) if (is.null(x)) y else x
 
 method_signature <- function(generic, signature) {
   single <- length(generic@dispatch_args) == 1

From 9cfbd6ee5c4bc85daf4e249fbe09d53082df60ee Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Tue, 10 Sep 2024 17:04:02 -0400
Subject: [PATCH 29/29] Can't use `\()` yet.

---
 tests/testthat/test-constructor.R | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/tests/testthat/test-constructor.R b/tests/testthat/test-constructor.R
index d577bc8a..0796ece5 100644
--- a/tests/testthat/test-constructor.R
+++ b/tests/testthat/test-constructor.R
@@ -116,7 +116,7 @@ test_that("can create constructors with missing or lazy defaults", {
       ),
 
       # dynamic property, not a constructor argument
-      age = new_property(class = class_any, getter = \(self) {
+      age = new_property(class = class_any, getter = function(self) {
         Sys.Date() - self@birthdate
       })
     )