Add comprehensive S4 formatter tests for setClass, setGeneric, and setMethod

Co-authored-by: felix-andreas <[email protected]>

Author: Copilot

crates/roughly/tests/format/special.R.test

@@ -221,3 +221,68 @@ library(purrr)
 map(\(df) lm(mpg~wt, data    = df)) |>
 map(summary  ) |>
 map_dbl("r.squared"  )
+
+#---- s4_classes
+setClass("Person",
+    slots = list(
+        name = "character",
+        age = "numeric"
+    ),
+    prototype = list(
+        name = character(0),
+        age = numeric(0)
+    )
+)
+
+setClass("Employee",
+    contains = "Person",
+    slots = list(
+        department = "character",
+        salary = "numeric"
+    ),
+    validity = function(object) {
+        if (object@salary < 0) "Salary must be non-negative"
+        else TRUE
+    }
+)
+
+#---- s4_generics
+setGeneric("show",
+    function(object) standardGeneric("show")
+)
+
+setGeneric("getName", function(x) {
+    standardGeneric("getName")
+})
+
+setGeneric("setName<-",
+    function(x, value) standardGeneric("setName<-")
+)
+
+#---- s4_methods
+setMethod("show", "Person",
+    function(object) {
+        cat("Person object:\n")
+        cat("  Name:", object@name, "\n")
+        cat("  Age:", object@age, "\n")
+    }
+)
+
+setMethod("getName", "Person",
+    function(x) x@name
+)
+
+setMethod("setName<-", "Person",
+    function(x, value) {
+        x@name <- value
+        x
+    }
+)
+
+setMethod("show", "Employee",
+    function(object) {
+        callNextMethod()
+        cat("  Department:", object@department, "\n")
+        cat("  Salary:", object@salary, "\n")
+    }
+)

crates/roughly/tests/snapshots/test_format__libraries__s4_classes.snap

@@ -0,0 +1,31 @@
+---
+source: crates/roughly/tests/test_format.rs
+expression: code
+---
+setClass(
+  "Person",
+  slots = list(
+    name = "character",
+    age = "numeric"
+  ),
+  prototype = list(
+    name = character(0),
+    age = numeric(0)
+  )
+)
+
+setClass(
+  "Employee",
+  contains = "Person",
+  slots = list(
+    department = "character",
+    salary = "numeric"
+  ),
+  validity = function(object) {
+    if (object@salary < 0) {
+      "Salary must be non-negative"
+    } else {
+      TRUE
+    }
+  }
+)

crates/roughly/tests/snapshots/test_format__libraries__s4_generics.snap

@@ -0,0 +1,17 @@
+---
+source: crates/roughly/tests/test_format.rs
+expression: code
+---
+setGeneric(
+  "show",
+  function(object) standardGeneric("show")
+)
+
+setGeneric("getName", function(x) {
+  standardGeneric("getName")
+})
+
+setGeneric(
+  "setName<-",
+  function(x, value) standardGeneric("setName<-")
+)

crates/roughly/tests/snapshots/test_format__libraries__s4_methods.snap

@@ -0,0 +1,38 @@
+---
+source: crates/roughly/tests/test_format.rs
+expression: code
+---
+setMethod(
+  "show",
+  "Person",
+  function(object) {
+    cat("Person object:\n")
+    cat("  Name:", object@name, "\n")
+    cat("  Age:", object@age, "\n")
+  }
+)
+
+setMethod(
+  "getName",
+  "Person",
+  function(x) x@name
+)
+
+setMethod(
+  "setName<-",
+  "Person",
+  function(x, value) {
+    x@name <- value
+    x
+  }
+)
+
+setMethod(
+  "show",
+  "Employee",
+  function(object) {
+    callNextMethod()
+    cat("  Department:", object@department, "\n")
+    cat("  Salary:", object@salary, "\n")
+  }
+)