Ensure that dynamic properties also narrow the parent

NEWS.md

@@ -19,7 +19,7 @@
 * `new_object()` now names its first argument `_parent` to minimise the chance of a clash with a property (#423). It also accepts a single unnamed named list as a shortcut for splicing property values, making it easier to programmatically construct an object from a list of properties (#497).
 * `method<-` can now register methods on S3 and S4 generics with base types (e.g. `class_character`), S3 classes (`new_S3_class()`, `class_factor`, etc.), S7 unions (expanded to one registration per class), `class_any` (registered as the `default` method), and `NULL` (registered as the `NULL` method) (#455).
 * `method<-` no longer emits an "Overwriting method" message when re-registering an identical method, eliminating spurious messages from `devtools::load_all()` (#474).
-* `new_class()` now errors if a child class overrides a parent property with a type that doesn't extend the parent's type, since such a class could never be instantiated. Narrowing the type is still allowed, as are dynamic (getter) properties (#352).
+* `new_class()` now errors if a child class overrides a parent property with a type that doesn't extend the parent's type, since such a class could never be instantiated (#352, #708).
 * `new_class()` now allows properties named `names`, `dim`, `dimnames`, `class`, `comment`, `tsp`, and `row.names`. But property names beginning with `_` are now reserved for internal use (#579).
 * `new_class()` experimentally allows `class_environment` as a parent again, so you can build S7 objects that share R's reference semantics for environments. This support is provisional: because environments are mutated in place, some operations behave differently than for value-typed S7 objects, and the API may change. `S7_data()` and `S7_data<-()` error on environment-based objects, since they would otherwise destroy the object's S7 attributes in place (#590).
 * `new_class()`'s default constructor now respects properties overridden in a subclass: the subclass's default is used (#467) and its setter is run during construction (#585). Values for overridden properties are passed to both the parent constructor and the new object, so a subclass can override a parent property whose default is mandatory.

R/class.R

@@ -454,15 +454,15 @@ check_prop_overrides <- function(
   for (prop in overridden) {
     child_prop <- child_props[[prop]]
 
-    # Dynamic properties are computed, not stored, so they're never validated
-    # against the parent's type
-    if (prop_is_dynamic(child_prop)) {
-      next
-    }
-
     child_class <- child_prop$class
     parent_class <- parent_props[[prop]]$class
 
+    # Read-only properties are computed, not stored, so when the user hasn't
+    # declared a type there's nothing to narrow.
+    if (prop_is_read_only(child_prop) && is_class_any(child_class)) {
+      next
+    }
+
     if (!class_extends(child_class, parent_class)) {
       child_desc <- paste0("<", name, ">")
       parent_desc <- class_desc(parent)

R/property.R

@@ -598,5 +598,3 @@ prop_is_read_only <- function(prop) {
 }
 
 prop_has_setter <- function(prop) is.function(prop$setter)
-
-prop_is_dynamic <- function(prop) is.function(prop$getter)

tests/testthat/_snaps/class.md

@@ -149,6 +149,16 @@
       - <foo1>@x is <integer>.
       - <foo4>@x is <ANY>.
 
+# dynamic child properties must also narrow the parent's type (#708)
+
+    Code
+      new_class("foo2", foo1, properties = list(x = widen))
+    Condition
+      Error in `new_class()`:
+      ! <foo2>@x must narrow <foo1>@x.
+      - <foo1>@x is <integer>.
+      - <foo2>@x is <character>.
+
 # abstract classes can't be instantiated
 
     Code

tests/testthat/test-class.R

@@ -193,10 +193,21 @@ test_that("inheritance doesn't let child properties widen or change the parent's
   })
 })
 
-test_that("inheritance lets dynamic child properties override any parent type", {
-  foo1 <- new_class("foo1", properties = list(x = class_integer))
-  readonly <- new_property(class_character, getter = function(self) "x")
-  expect_no_error(new_class("foo2", foo1, properties = list(x = readonly)))
+test_that("dynamic child properties must also narrow the parent's type (#708)", {
+  foo1 <- new_class(
+    "foo1",
+    properties = list(x = class_integer),
+    package = NULL
+  )
+
+  widen <- new_property(class_character, getter = function(self) "x")
+  expect_snapshot(
+    error = TRUE,
+    new_class("foo2", foo1, properties = list(x = widen))
+  )
+
+  narrow <- new_property(class_integer, getter = function(self) 1L)
+  expect_no_error(new_class("foo3", foo1, properties = list(x = narrow)))
 })
 
 test_that("abstract classes can't be instantiated", {