Better hygiene around S3 methods in tests

crates/ark/src/modules/positron/methods.R

@@ -1,7 +1,7 @@
 #
 # methods.R
 #
-# Copyright (C) 2024 Posit Software, PBC. All rights reserved.
+# Copyright (C) 2024-2025 Posit Software, PBC. All rights reserved.
 #
 #
 
@@ -26,38 +26,64 @@ lockEnvironment(ark_methods_table, TRUE)
 
 ark_methods_allowed_packages <- c("torch", "reticulate")
 
-#' Register the methods with the Positron runtime
-#'
-#' @param generic Generic function name as a character to register
-#' @param class Class name as a character
-#' @param method A method to be registered. Should be a call object.
-#' @export
-.ark.register_method <- function(generic, class, method) {
-    # Check if the caller is an allowed package
+# check if the calling package is allowed to touch the methods table
+check_caller_allowed <- function() {
     if (!in_ark_tests()) {
-        calling_env <- .ps.env_name(topenv(parent.frame()))
+        # we want the caller of the caller
+        calling_env <- .ps.env_name(topenv(parent.frame(2)))
         if (
             !(calling_env %in%
                 paste0("namespace:", ark_methods_allowed_packages))
         ) {
             stop(
-                "Only allowed packages can register methods. Called from ",
+                "Only allowed packages can (un)register methods. Called from ",
                 calling_env
             )
         }
     }
+}
 
+check_register_args <- function(generic, class) {
     stopifnot(
         is_string(generic),
         generic %in% names(ark_methods_table),
         typeof(class) == "character"
     )
+}
+
+#' Register the methods with the Positron runtime
+#'
+#' @param generic Generic function name as a character to register
+#' @param class Class name as a character
+#' @param method A method to be registered. Should be a call object.
+#' @export
+.ark.register_method <- function(generic, class, method) {
+    check_caller_allowed()
+    check_register_args(generic, class)
+
     for (cls in class) {
         assign(cls, method, envir = ark_methods_table[[generic]])
     }
     invisible()
 }
 
+#' Unregister a method from the Positron runtime
+#'
+#' @param generic Generic function name as a character
+#' @param class Class name as a character
+#' @export
+.ark.unregister_method <- function(generic, class) {
+    check_caller_allowed()
+    check_register_args(generic, class)
+
+    for (cls in class) {
+        if (exists(cls, envir = ark_methods_table[[generic]], inherits = FALSE)) {
+            remove(list = cls, envir = ark_methods_table[[generic]])
+        }
+    }
+    invisible()
+}
+
 call_ark_method <- function(generic, object, ...) {
     methods_table <- ark_methods_table[[generic]]
 

crates/ark/src/variables/variable.rs

@@ -1749,6 +1749,19 @@ mod tests {
             let path = vec![String::from("x"), variables[3].access_key.clone()];
             let vector = PositronVariable::inspect(env, &path).unwrap();
             assert_eq!(vector.len(), 4);
+
+            // avoid interference with other tests that might use a "foo" class
+            harp::parse_eval_global(
+                r#"
+                .ark.unregister_method("ark_positron_variable_display_value", "foo")
+                .ark.unregister_method("ark_positron_variable_display_type", "foo")
+                .ark.unregister_method("ark_positron_variable_has_children", "foo")
+                .ark.unregister_method("ark_positron_variable_kind", "foo")
+                .ark.unregister_method("ark_positron_variable_get_children", "foo")
+                .ark.unregister_method("ark_positron_variable_get_child_at", "foo")
+                "#,
+            )
+            .unwrap();
         })
     }