diff --git a/crates/ark/src/modules/positron/methods.R b/crates/ark/src/modules/positron/methods.R index 122cb4c3d..31128fa38 100644 --- a/crates/ark/src/modules/positron/methods.R +++ b/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]] diff --git a/crates/ark/src/variables/variable.rs b/crates/ark/src/variables/variable.rs index 0304e5e91..48cb9cee2 100644 --- a/crates/ark/src/variables/variable.rs +++ b/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(); }) }