update for rename of @S7_class to @_S7_class

Author: lawremi

R/S4.R

@@ -9,7 +9,7 @@
 #' `S4_register()` registers an S7 class, S3 class, or S7 union with S4 and
 #' invisibly returns the registered S4 class name.
 #' For S7 classes, this creates a virtual S4 old class that exposes stored S7
-#' properties as S4 slots and carries the `S7_class` slot needed for S7 dispatch
+#' properties as S4 slots and carries the `_S7_class` slot needed for S7 dispatch
 #' and validation.
 #'
 #' After registration, `S4_contains()` returns the virtual S4 class name to use
@@ -270,7 +270,7 @@ S4_properties_prototype <- function(
     }
   }
   if (include_S7_class) {
-    args$S7_class <- class
+    args$`_S7_class` <- class
   }
   do.call(methods::prototype, args)
 }
@@ -320,9 +320,9 @@ S4_register_class <- function(class, env = parent.frame()) {
   properties <- class@properties
   properties <- properties[setdiff(names(properties), parent_slot_names)]
   slots <- lapply(properties, S4_property_class, S4_env = where)
-  needs_S7_class_slot <- !"S7_class" %in% parent_slot_names
+  needs_S7_class_slot <- !"_S7_class" %in% parent_slot_names
   if (needs_S7_class_slot) {
-    slots$S7_class <- "S7_class"
+    slots$`_S7_class` <- "S7_class"
   }
 
   methods::setClass(

R/convert.R

@@ -187,7 +187,10 @@ convert_up <- function(from, to, call = sys.call(-1L)) {
       stop2(msg, call = call)
     }
 
-    from <- zap_attr(from, c(setdiff(from_props, to_props), "S7_class"))
+    from <- zap_attr(
+      from,
+      c(setdiff(from_props, to_props), "_S7_class", "S7_class")
+    )
     attr(from, "_S7_class") <- to
     class(from) <- class_dispatch(to)
   } else if (is_S4_coerce(from, to)) {

R/inherits.R

@@ -49,7 +49,7 @@ S7_inherits <- function(x, class = NULL) {
 has_S7_class <- function(x) {
   identical(class(x), "S7_object") ||
     inherits(x, "S7_class") ||
-    !is.null(attr(x, "S7_class", exact = TRUE))
+    !is.null(.Call(S7_class_, x))
 }
 
 #' @export

R/property.R

@@ -365,7 +365,7 @@ prop_call <- function(object, name) {
 
 #' @rawNamespace S3method("@<-",S7_object)
 `@<-.S7_object` <- function(object, name, value) {
-  if (isS4(object) && !name %in% names(slot(object, "S7_class")@properties)) {
+  if (isS4(object) && !name %in% names(S7_class(object)@properties)) {
     methods::slot(object, name) <- value
     return(object)
   }

man/S4_register.Rd

@@ -43,7 +43,7 @@ test_that("S4_register registers S4 old classes as virtual S7_object descendants
     "trying to generate an object from a virtual class"
   )
   expect_true(methods::extends("S4regS7New", "S7_object"))
-  expect_true("S7_class" %in% methods::slotNames("S4regS7New"))
+  expect_true("_S7_class" %in% methods::slotNames("S4regS7New"))
 })
 
 test_that("S4_register registers an S3 class so it can be used with S4 methods", {
@@ -116,7 +116,7 @@ test_that("S4_register can reify S7 properties as slots for S4 subclasses", {
   expect_equal(S4regContainsChild_S4, "S7::S4regContainsChild")
   expect_equal(
     methods::slotNames(S4regContainsChild_S4),
-    c("y", "x", "S7_class", ".S3Class")
+    c("y", "x", "_S7_class", ".S3Class")
   )
   expect_contains(
     methods::extends(S4regContainsChild_S4),
@@ -138,7 +138,7 @@ test_that("S4_register can reify S7 properties as slots for S4 subclasses", {
   expect_equal(methods::slot(object, "x"), 1)
   expect_equal(methods::slot(object, "y"), "a")
   expect_equal(methods::slot(object, "z"), TRUE)
-  expect_equal(methods::slot(object, "S7_class"), S4regContainsChild)
+  expect_equal(methods::slot(object, "_S7_class"), S4regContainsChild)
   expect_equal(prop_names(object), c("x", "y"))
   expect_equal(prop(object, "x"), 1)
   expect_equal(prop(object, "y"), "a")
@@ -224,11 +224,11 @@ test_that("S4_register constructs S4 subclasses of S7 classes that extend S4 cla
   S4regNewChild_S4 <- S4_contains(S4regNewChild)
   expect_equal(
     methods::slotNames("S4regNewChild"),
-    c("status", "metadata", "S7_class", "assays", "rowData", ".S3Class")
+    c("status", "metadata", "_S7_class", "assays", "rowData", ".S3Class")
   )
   expect_contains(
     methods::slotNames(S4regNewChild_S4),
-    c("assays", "rowData", "metadata", "status", "S7_class")
+    c("assays", "rowData", "metadata", "status", "_S7_class")
   )
   setClass(
     "S4regNewGrandChild",
@@ -242,7 +242,7 @@ test_that("S4_register constructs S4 subclasses of S7 classes that extend S4 cla
   expect_true(methods::is(object, "S4regNewParent"))
   expect_true(methods::is(object, S4regNewChild_S4))
   expect_true(S7_inherits(object, S4regNewChild))
-  expect_equal(methods::slot(object, "S7_class"), S4regNewChild)
+  expect_equal(methods::slot(object, "_S7_class"), S4regNewChild)
   expect_equal(methods::slot(object, "assays"), list())
   expect_equal(methods::slot(object, "rowData"), character())
   expect_equal(methods::slot(object, "metadata"), character())
@@ -364,12 +364,12 @@ test_that("S4_register registers abstract S7 classes as virtual S4 classes", {
   concrete_prototype <- methods::getClass("S4regAbstractConcrete")@prototype
 
   expect_true(methods::isVirtualClass("S4regAbstract"))
-  expect_true("S7_class" %in% methods::slotNames("S4regAbstract"))
-  expect_equal(methods::slot(abstract_prototype, "S7_class"), S4regAbstract)
+  expect_true("_S7_class" %in% methods::slotNames("S4regAbstract"))
+  expect_equal(methods::slot(abstract_prototype, "_S7_class"), S4regAbstract)
   expect_false(methods::extends("S4regAbstract", "oldClass"))
   expect_false(methods::extends("S4regAbstract", "S7_object"))
   expect_equal(
-    methods::slot(concrete_prototype, "S7_class"),
+    methods::slot(concrete_prototype, "_S7_class"),
     S4regAbstractConcrete
   )
   expect_false("S4regAbstract" %in% attr(concrete_prototype, ".S3Class"))
@@ -672,7 +672,10 @@ test_that("S7 classes can extend S4 classes", {
   expect_true(methods::is(child, "Parent"))
   expect_true(methods::validObject(child))
   expect_equal(as.character(methods::getClass("Child")@className), "Child")
-  expect_equal(methods::slotNames("Child"), c("y", "S7_class", "x", ".S3Class"))
+  expect_equal(
+    methods::slotNames("Child"),
+    c("y", "_S7_class", "x", ".S3Class")
+  )
   expect_equal(methods::slot(child, "x"), 2)
   expect_equal(methods::slot(child, "y"), "b")
 

tests/testthat/test-S4.R

@@ -26,7 +26,7 @@ library(S7)
 S7 objects *are* S3 objects, because S7 is implemented on top of S3.
 There are two main differences between an S7 object and an S3 object:
 
--   As well as the `class` attribute possessed by S3 objects, S7 objects have an additional `S7_class` attribute that contains the object that defines the class.
+-   As well as the `class` attribute possessed by S3 objects, S7 objects have an additional `_S7_class` attribute that contains the object that defines the class.
 
 -   S7 objects have properties; S3 objects have attributes.
     Properties are implemented on top of attributes, so you can access them directly with `attr` and friends.
@@ -219,7 +219,7 @@ There are a few important caveats:
 After calling `S4_register()`, use `S4_contains()` when an S4 class should
 extend an S7 class. It returns the virtual S4 class name for
 `methods::setClass(contains = )`. This class exposes stored S7 properties as
-formal S4 slots and carries the `S7_class` slot that S7 uses for dispatch and
+formal S4 slots and carries the `_S7_class` slot that S7 uses for dispatch and
 validation.
 
 ```{r}