From 02c1e784b68542a2eeba55087805606491f91c19 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Fri, 25 Oct 2024 07:58:46 -0400
Subject: [PATCH 1/2] set updated attributes in `S7_data<-`

closes #478
---
 R/data.R | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/R/data.R b/R/data.R
index 6243fdfa..0478ed85 100644
--- a/R/data.R
+++ b/R/data.R
@@ -29,7 +29,7 @@ S7_data <- function(object) {
 `S7_data<-` <- function(object, check = TRUE, value) {
   attrs <- attributes(object)
   object <- value
-  attributes(object) <- attrs
+  attributes(object) <- modify_list(attrs, attributes(value))
   if (isTRUE(check)) {
     validate(object)
   }

From 3d4bfd7fdfc7a02c29b0274a2242f0a8fa428c9c Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <tomasz@posit.co>
Date: Fri, 25 Oct 2024 08:12:23 -0400
Subject: [PATCH 2/2] add test

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

diff --git a/tests/testthat/test-data.R b/tests/testthat/test-data.R
index d25990d6..97d89be8 100644
--- a/tests/testthat/test-data.R
+++ b/tests/testthat/test-data.R
@@ -20,3 +20,32 @@ describe("S7_data", {
     expect_equal(S7_data(x), "bar")
   })
 })
+
+
+describe("S7_data<-", {
+
+  it("uses updated 'names'", {
+    # local_methods(`$<-`, `[[<-`) # no support for unregistering S3 generic methods
+
+    write_once_list <- new_class("write_once_list", class_list,
+      constructor = function(...) new_object(list(...))
+    )
+
+    method(`$<-`, write_once_list) <-
+    method(`[[<-`, write_once_list) <- function(x, name, value) {
+      .x <- S7_data(x)
+      stopifnot(is_string(name))
+      if (hasName(.x, name))
+        stop("entry exists: ", name)
+      .x[[name]] <- value
+      S7_data(x) <- .x
+      x
+    }
+    w <- write_once_list(x = 3, y = 4)
+    w$bar <- 1
+    expect_equal(names(w), c("x", "y", "bar"))
+    expect_error(w$bar <- 2, "entry exists:")
+
+  })
+
+})