From 56bbc45ea36f652bfa5fc238de7e34cc6d56c63c Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Sun, 31 May 2026 20:08:54 -0500 Subject: [PATCH 1/2] Run `class_validate()` on properties * Fix bug in `class_POSIXct` thus revealed * Fix bug in S4 validation thus revealed --- NEWS.md | 2 ++ R/S3.R | 6 +++--- R/class-spec.R | 5 ++++- R/property.R | 5 +++++ tests/testthat/_snaps/S3.md | 6 +++--- tests/testthat/_snaps/property.md | 18 ++++++++++++++++++ tests/testthat/test-S3.R | 5 +++-- tests/testthat/test-property.R | 27 +++++++++++++++++++++++++++ 8 files changed, 65 insertions(+), 9 deletions(-) diff --git a/NEWS.md b/NEWS.md index cd091f86..e02ce7e8 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,7 @@ # S7 (development version) * Errors thrown by S7 now report the function where they occurred, making it easier to track down the source of a problem (#646). +* `class_POSIXct` no longer rejects a date-time that lacks a `tzone` attribute (e.g. the result of `Sys.time()`), which represents the local time zone (#401). * `method<-` now accepts `NULL` to unregister an existing method, e.g. `method(foo, class_character) <- NULL` (#613). * `new_object()` no longer materialises ALTREP parent values (e.g. `seq_len()`), so constructing an S7 object that wraps a large compact integer sequence is now O(1) in memory instead of O(n) (@kschaubroeck, #607). * Method dispatch on `class_missing` now correctly handles missing arguments forwarded through a wrapper functions (#595). @@ -17,6 +18,7 @@ * `super()` now works with S3 and S4 objects, not just S7 objects (#500). * `new_object()` no longer materialises ALTREP parent values (e.g. `seq_len()`), so constructing an S7 object that wraps a large compact integer sequence is now O(1) in memory instead of O(n) (@kschaubroeck, #607). * `new_object()` no longer re-runs property validators for properties inherited unchanged from an already-validated parent class, so constructing an instance of a deeply nested class hierarchy validates each property exactly once (#539). +* `new_property()` now runs the property class's own validator when checking a value, not just the structural class check, so a property restricted to an S3 class (e.g. `class_factor`) now enforces constraints that aren't visible in `class()` (#401). * `new_property()` now accepts a `setter` that takes `self`, `name`, and `value` making it easy to reuse the same definition for multiple properties (#552). * `new_S3_class()` objects now work with `inherits()` (and other functions that use `nameOfClass()`) in R 4.3 and later (@lawremi, #521). * New `prop_info()` returns a data frame summarising the properties of an S7 object or class, with one row per property and columns for name, default, class, getter, setter, and validator (#551). diff --git a/R/S3.R b/R/S3.R index 0932841e..9f979a7c 100644 --- a/R/S3.R +++ b/R/S3.R @@ -184,9 +184,9 @@ validate_POSIXct <- function(self) { return("Underlying data must be numeric") } - tz <- attr(self, "tz") - if (!is.character(tz) || length(tz) != 1) { - return("attr(, 'tz') must be a single string") + tz <- attr(self, "tzone", exact = TRUE) + if (!is.null(tz) && (!is.character(tz) || length(tz) != 1)) { + return("attr(, 'tzone') must be NULL or a single string") } } diff --git a/R/class-spec.R b/R/class-spec.R index a74c03a8..7d42609b 100644 --- a/R/class-spec.R +++ b/R/class-spec.R @@ -192,7 +192,10 @@ class_constructor <- function(.x) { class_validate <- function(class, object) { validator <- switch( class_type(class), - S4 = methods::validObject, + S4 = function(object) { + check <- methods::validObject(object, test = TRUE) + if (isTRUE(check)) NULL else check + }, S7 = class@validator, S7_base = class$validator, S7_S3 = class$validator, diff --git a/R/property.R b/R/property.R index 6aa2e971..1092fa62 100644 --- a/R/property.R +++ b/R/property.R @@ -250,6 +250,11 @@ prop_validate <- function(prop, value, object = NULL) { )) } + class_error <- class_validate(prop$class, value) + if (length(class_error) > 0) { + return(paste0(prop_label(object, prop$name), ": ", class_error)) + } + if (is.null(validator <- prop$validator)) { return(NULL) } diff --git a/tests/testthat/_snaps/S3.md b/tests/testthat/_snaps/S3.md index b57ba962..f6c703a4 100644 --- a/tests/testthat/_snaps/S3.md +++ b/tests/testthat/_snaps/S3.md @@ -63,13 +63,13 @@ # catches invalid POSIXct Code - validate_POSIXct(structure("x", tz = "UTC")) + validate_POSIXct(structure("x", tzone = "UTC")) Output [1] "Underlying data must be numeric" Code - validate_POSIXct(structure(1, tz = 1)) + validate_POSIXct(structure(1, tzone = 1)) Output - [1] "attr(, 'tz') must be a single string" + [1] "attr(, 'tzone') must be NULL or a single string" # catches invalid data.frame diff --git a/tests/testthat/_snaps/property.md b/tests/testthat/_snaps/property.md index bbb0ce25..79900fff 100644 --- a/tests/testthat/_snaps/property.md +++ b/tests/testthat/_snaps/property.md @@ -199,6 +199,24 @@ ! object properties are invalid: - @x must be length 1 +# property validation runs the class's own validator + + Code + Foo(x = bad) + Condition + Error in `Foo()`: + ! object properties are invalid: + - @x: Not enough 'levels' for underlying data + +# property validation runs an S4 class's validity method + + Code + Foo(x = bad) + Condition + Error in `Foo()`: + ! object properties are invalid: + - @x: n must be positive + # prop<- won't infinitly recurse on a custom setter Code diff --git a/tests/testthat/test-S3.R b/tests/testthat/test-S3.R index 49c0f2e4..43923327 100644 --- a/tests/testthat/test-S3.R +++ b/tests/testthat/test-S3.R @@ -67,9 +67,10 @@ test_that("catches invalid dates", { test_that("catches invalid POSIXct", { expect_snapshot({ - validate_POSIXct(structure("x", tz = "UTC")) - validate_POSIXct(structure(1, tz = 1)) + validate_POSIXct(structure("x", tzone = "UTC")) + validate_POSIXct(structure(1, tzone = 1)) }) + expect_null(validate_POSIXct(Sys.time())) }) test_that("catches invalid data.frame", { diff --git a/tests/testthat/test-property.R b/tests/testthat/test-property.R index 9bf6badb..ecc1fc6c 100644 --- a/tests/testthat/test-property.R +++ b/tests/testthat/test-property.R @@ -466,6 +466,33 @@ test_that("can validate with custom validator", { }) }) +test_that("property validation runs the class's own validator", { + Foo <- new_class("Foo", package = NULL, properties = list(x = class_factor)) + + # A malformed factor passes the structural check (its class is "factor") + # but fails the factor validator because it has too few levels. + bad <- structure(1:3, levels = "a", class = "factor") + expect_snapshot(Foo(x = bad), error = TRUE) +}) + +test_that("property validation runs an S4 class's validity method", { + PosNum <- methods::setClass( + "PosNum", + slots = c(n = "numeric"), + validity = function(object) { + if (object@n <= 0) "n must be positive" else TRUE + } + ) + on.exit(S4_remove_classes("PosNum")) + Foo <- new_class("Foo", package = NULL, properties = list(x = PosNum)) + + # An S4 object that passes the structural check but fails its own validity + # method is rejected + bad <- PosNum(n = 1) + bad@n <- -5 + expect_snapshot(Foo(x = bad), error = TRUE) +}) + test_that("prop<- won't infinitly recurse on a custom setter", { chattily_sync_ab <- function(self, value) { cat("Starting syncup with value:", value, "\n") From e2d6c8a28a5b0a3d999d2301747dd4a4f7ed0d05 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Sun, 31 May 2026 20:16:33 -0500 Subject: [PATCH 2/2] Tweak news --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index e02ce7e8..210f8401 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,7 +1,7 @@ # S7 (development version) * Errors thrown by S7 now report the function where they occurred, making it easier to track down the source of a problem (#646). -* `class_POSIXct` no longer rejects a date-time that lacks a `tzone` attribute (e.g. the result of `Sys.time()`), which represents the local time zone (#401). +* `class_POSIXct` uses the `tzone` attribute (not `tz`), and allows it to be absent (#401). * `method<-` now accepts `NULL` to unregister an existing method, e.g. `method(foo, class_character) <- NULL` (#613). * `new_object()` no longer materialises ALTREP parent values (e.g. `seq_len()`), so constructing an S7 object that wraps a large compact integer sequence is now O(1) in memory instead of O(n) (@kschaubroeck, #607). * Method dispatch on `class_missing` now correctly handles missing arguments forwarded through a wrapper functions (#595).