Skip to content

Commit

Permalink
Take list name from property name
Browse files Browse the repository at this point in the history
Fixes #371
  • Loading branch information
hadley committed Nov 22, 2023
1 parent 3d6c6d7 commit 11fa185
Show file tree
Hide file tree
Showing 4 changed files with 22 additions and 8 deletions.
3 changes: 3 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
@@ -1,5 +1,8 @@
# S7 (development version)

* In `new_class()`, properties can either be named by naming the element
of the list or by supplying the `name` argument to `new_property()` (#371).

* S7 provides a new automatic backward compatibility mechanism to provide
a version of `@` that works in R before version 4.3 (#326).

Expand Down
19 changes: 13 additions & 6 deletions R/property.R
Original file line number Diff line number Diff line change
Expand Up @@ -393,7 +393,7 @@ as_properties <- function(x) {
}

out <- Map(as_property, x, names2(x), seq_along(x))
names(out) <- names2(x)
names(out) <- vapply(out, function(x) x$name, FUN.VALUE = character(1))

if (anyDuplicated(names(out))) {
stop("`properties` names must be unique", call. = FALSE)
Expand All @@ -403,15 +403,22 @@ as_properties <- function(x) {
}

as_property <- function(x, name, i) {
if (name == "") {
msg <- sprintf("`property[[%i]]` is missing a name", i)
stop(msg, call. = FALSE)
}

if (is_property(x)) {
x$name <- name
if (is.null(x$name)) {
if (name == "") {
msg <- sprintf("`property[[%i]]` must have a name or be named.", i)
stop(msg, call. = FALSE)
}
x$name <- name
}
x
} else {
if (name == "") {
msg <- sprintf("`property[[%i]]` must be named.", i)
stop(msg, call. = FALSE)
}

class <- as_class(x, arg = paste0("property$", name))
new_property(x, name = name)
}
Expand Down
4 changes: 2 additions & 2 deletions tests/testthat/_snaps/property.md
Original file line number Diff line number Diff line change
Expand Up @@ -160,12 +160,12 @@
as_properties(list(1))
Condition
Error:
! `property[[1]]` is missing a name
! `property[[1]]` must be named.
Code
as_properties(list(new_property(class_character)))
Condition
Error:
! `property[[1]]` is missing a name
! `property[[1]]` must have a name or be named.
Code
as_properties(list(x = 1))
Condition
Expand Down
4 changes: 4 additions & 0 deletions tests/testthat/test-property.R
Original file line number Diff line number Diff line change
Expand Up @@ -287,6 +287,10 @@ test_that("as_properties normalises properties", {
as_properties(list(x = new_property(class = class_numeric))),
list(x = new_property(class_numeric, name = "x")
))
expect_equal(
as_properties(list(new_property(name = "y"))),
list(y = new_property(name = "y")
))
})

test_that("as_properties() gives useful error messages", {
Expand Down

0 comments on commit 11fa185

Please sign in to comment.