From c1470db6785968e78a9c70c497ba17f4b2a6b4bb Mon Sep 17 00:00:00 2001
From: Michael Lawrence <lawremi@gmail.com>
Date: Tue, 2 Jun 2026 16:08:12 -0700
Subject: [PATCH 1/4] use isClassUnion() instead of direct class check

---
 R/S4.R | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/R/S4.R b/R/S4.R
index 88937ba9..6dfd0fae 100644
--- a/R/S4.R
+++ b/R/S4.R
@@ -51,7 +51,7 @@ S4_to_S7_class <- function(x, error_base = "", call = sys.call(-1L)) {
     ))
   }
 
-  if (methods::is(x, "ClassUnionRepresentation")) {
+  if (methods::isClassUnion(x)) {
     subclasses <- Filter(function(y) y@distance == 1, x@subclasses)
     subclasses <- lapply(subclasses, function(x) methods::getClass(x@subClass))
     do.call("new_union", subclasses)

From e82f979406cb91a53d44417dcb1f31787512ac68 Mon Sep 17 00:00:00 2001
From: Michael Lawrence <lawremi@gmail.com>
Date: Tue, 2 Jun 2026 16:27:09 -0700
Subject: [PATCH 2/4] pass className attribute directly to preserve package

---
 R/S4.R | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/R/S4.R b/R/S4.R
index 6dfd0fae..4f1b049d 100644
--- a/R/S4.R
+++ b/R/S4.R
@@ -45,7 +45,7 @@ S4_to_S7_class <- function(x, error_base = "", call = sys.call(-1L)) {
   # Convert generator function to class
   if (methods::is(x, "classGeneratorFunction")) {
     return(S4_to_S7_class(
-      methods::getClass(as.character(x@className)),
+      methods::getClass(x@className),
       error_base,
       call = call
     ))

From 8a61421b0796ebac9b6c3e09aa0ec44c39ed0004 Mon Sep 17 00:00:00 2001
From: Michael Lawrence <lawremi@gmail.com>
Date: Tue, 2 Jun 2026 16:32:02 -0700
Subject: [PATCH 3/4] since proper S4 classes can extend old classes, be
 stricter when reducing to an S3 class, and use methods::extends() to capture
 the entire class vector, not just the first class

---
 R/S4.R | 7 +++++--
 1 file changed, 5 insertions(+), 2 deletions(-)

diff --git a/R/S4.R b/R/S4.R
index 4f1b049d..f3ac30ff 100644
--- a/R/S4.R
+++ b/R/S4.R
@@ -62,8 +62,11 @@ S4_to_S7_class <- function(x, error_base = "", call = sys.call(-1L)) {
         return(basic_classes[[x@className]])
       }
     }
-    if (methods::extends(x, "oldClass")) {
-      new_S3_class(as.character(x@className))
+    if (
+      methods::extends(x, "oldClass") &&
+        x@className %in% attr(x@prototype, ".S3Class")
+    ) {
+      new_S3_class(methods::extends(x))
     } else {
       x
     }

From 88a537467691631f68b168e87d55038bbe967e49 Mon Sep 17 00:00:00 2001
From: Michael Lawrence <lawremi@gmail.com>
Date: Tue, 2 Jun 2026 17:23:14 -0700
Subject: [PATCH 4/4] fix is_oldClass() and use it in S4_to_S7_class()

---
 R/S4.R                   |  8 +++-----
 tests/testthat/test-S4.R | 15 +++++++++++++++
 2 files changed, 18 insertions(+), 5 deletions(-)

diff --git a/R/S4.R b/R/S4.R
index f3ac30ff..f01179ba 100644
--- a/R/S4.R
+++ b/R/S4.R
@@ -62,10 +62,7 @@ S4_to_S7_class <- function(x, error_base = "", call = sys.call(-1L)) {
         return(basic_classes[[x@className]])
       }
     }
-    if (
-      methods::extends(x, "oldClass") &&
-        x@className %in% attr(x@prototype, ".S3Class")
-    ) {
+    if (is_oldClass(x)) {
       new_S3_class(methods::extends(x))
     } else {
       x
@@ -132,7 +129,8 @@ S4_class_dispatch <- function(x) {
 }
 
 is_oldClass <- function(x) {
-  x@virtual && methods::extends(x, "oldClass") && x@className != "oldClass"
+  methods::extends(x, "oldClass") &&
+    x@className %in% attr(x@prototype, ".S3Class")
 }
 
 S4_class_name <- function(x) {
diff --git a/tests/testthat/test-S4.R b/tests/testthat/test-S4.R
index 7b01a6a0..56c37210 100644
--- a/tests/testthat/test-S4.R
+++ b/tests/testthat/test-S4.R
@@ -124,6 +124,21 @@ describe("S4_class_dispatch", {
     )
   })
 
+  it("dispatches through the full S3 old-class hierarchy", {
+    on.exit(S4_remove_classes(c("S4OldS3Child", "S4OldS3a", "S4OldS3b")))
+
+    setOldClass(c("S4OldS3a", "S4OldS3b"))
+    setClass("S4OldS3Child", contains = "S4OldS3a")
+
+    generic <- new_generic("S4OldS3Generic", "x")
+    method(generic, new_S3_class("S4OldS3b")) <- function(x) "S3 parent"
+
+    object <- methods::new("S4OldS3Child")
+
+    expect_contains(obj_dispatch(object), "S4OldS3b")
+    expect_equal(generic(object), "S3 parent")
+  })
+
   it("ignores unions", {
     on.exit(S4_remove_classes(c("Foo1", "Foo2", "Foo3")))