Resolve named handlers by name at dispatch, like dest_infer

`register_r2f_handler()` stores the handler as a function object captured at
build time. covr rebinds its instrumented copies into the namespace after the
package has loaded, so a handler registered as a top-level named function keeps
dispatching the copy taken at registration: the instrumented copy never runs and
the handler reads as 0% covered however well it is tested. Its callees still
read as covered, because their names resolve from the namespace at call time --
which is what makes the pattern recognisable.

The file already documents this hazard and works around it for `dest_infer`, by
recording `dest_infer_name` and resolving it at call time. Do the same for the
handler itself: record `fun_name` at registration and let `get_r2f_handler()`
swap in the current namespace binding.

The object stays authoritative. Of the registrations in the tree, 27 pass an
anonymous function literal, which has no name to resolve; the name is a
supplement for the ones that don't. Recording it is deliberately stricter than
`dest_infer_name`: the argument must be a symbol *and* name this same function
in a namespace, since that is the only environment covr rebinds into. That
excludes the local `handler` closure built by `register_unary_intrinsic()`,
whose name means something else on the next call, and `r2f_handlers[["<-"]]`,
which is not a symbol at all. `dest_infer` is left as it is; it is advisory,
whereas the handler is called, so a wrong resolution there would be a bug.

No handler in the tree is currently registered by name, so nothing changes
today. It is what lets a handler be extracted into a named function without
the extraction reading as untested.

Author: mns-nordicals

R/classes.R

@@ -426,6 +426,9 @@ R2FHandler := new_class(
     dest_supported = prop_bool(default = FALSE),
     dest_infer = new_property(NULL | class_function),
     dest_infer_name = prop_string(default = NULL, allow_null = TRUE),
+    # Set when the handler was registered as a namespace-level named function,
+    # so dispatch can re-resolve it by name. See register_r2f_handler().
+    fun_name = prop_string(default = NULL, allow_null = TRUE),
     # When NULL, r2f will resolve the callable by name and use match.call().
     # When FALSE, r2f will not attempt match.call().
     match_fun = new_property(

R/r2f-aaa-registry.R

@@ -14,6 +14,15 @@ register_r2f_handler <- function(
 
   handler <- if (inherits(fun, R2FHandler)) fun else R2FHandler(fun)
 
+  # Same hazard as `dest_infer` below, for the handler itself: the function
+  # object is captured here, at build time, while covr rebinds its instrumented
+  # copies into the namespace after the package has loaded. A handler registered
+  # as a top-level named function would keep dispatching the copy taken here and
+  # read as 0% covered however well it is tested. Record the name so
+  # get_r2f_handler() can re-resolve it; the object stays authoritative, since
+  # most handlers are anonymous literals with no name to resolve.
+  handler@fun_name <- registered_fun_name(substitute(fun), fun)
+
   if (!is.null(dest_supported)) {
     handler@dest_supported <- isTRUE(dest_supported)
   }
@@ -47,3 +56,28 @@ register_r2f_handler <- function(
   }
   invisible(handler)
 }
+
+
+# The name to re-resolve a registered handler by, or NULL if there isn't one.
+#
+# `expr` is the unevaluated `fun` argument and `fun` its value. A name is only
+# usable if `expr` is a symbol *and* it names this same function in a namespace
+# -- the only environment covr rebinds into. That rules out the two non-literal
+# registrations that are not namespace-level functions: the local `handler`
+# closure built by register_unary_intrinsic() (a symbol, but bound in a call
+# frame, where the name would mean something else on a later call) and
+# `r2f_handlers[["<-"]]` (not a symbol at all).
+registered_fun_name <- function(expr, fun) {
+  if (!is.symbol(expr)) {
+    return(NULL)
+  }
+  name <- as.character(expr)
+  env <- environment(fun)
+  if (!is.environment(env) || !isNamespace(env)) {
+    return(NULL)
+  }
+  if (!identical(get0(name, envir = env, mode = "function"), fun)) {
+    return(NULL)
+  }
+  name
+}

R/r2f-aab-core.R

@@ -380,8 +380,31 @@ num2fortran <- function(x) {
 
 get_r2f_handler <- function(name) {
   stopifnot("All functions called must be named as symbols" = is.symbol(name))
-  get0(name, r2f_handlers) %||%
+  handler <- get0(name, r2f_handlers) %||%
     stop("Unsupported function: ", name, call. = FALSE)
+  resolve_handler_fun(handler)
+}
+
+
+# Swap in the handler's current namespace binding, so an instrumented or
+# otherwise rebound copy is dispatched instead of the one captured at
+# registration. Only handlers registered as namespace-level named functions
+# carry a `fun_name`; for every other handler this is a property read and a
+# return. See register_r2f_handler() for why the name is recorded.
+resolve_handler_fun <- function(handler) {
+  if (!inherits(handler, R2FHandler)) {
+    return(handler)
+  }
+  name <- handler@fun_name
+  if (!is_string(name)) {
+    return(handler)
+  }
+  current <- get0(name, envir = environment(handler), mode = "function")
+  if (is.null(current) || identical(current, S7_data(handler))) {
+    return(handler)
+  }
+  S7_data(handler) <- current
+  handler
 }
 
 

tests/testthat/test-r2f-registry.R

@@ -62,6 +62,75 @@ test_that("register_r2f_handler does not set match.fun when TRUE", {
   expect_null(result@match_fun)
 })
 
+test_that("register_r2f_handler records the name of a namespace-level handler", {
+  withr::defer(
+    rm(list = "test_handler_named", envir = quickr:::r2f_handlers),
+    envir = environment()
+  )
+  # Passed as a bare symbol, the way the package's own top-level registrations
+  # do it -- `quickr:::last` would be a call, with no name to record.
+  result <- quickr:::register_r2f_handler("test_handler_named", last)
+  expect_identical(result@fun_name, "last")
+})
+
+test_that("register_r2f_handler leaves anonymous and local handlers unnamed", {
+  local_handler <- function(e, scope, ...) NULL
+  withr::defer(
+    rm(
+      list = c("test_handler_unnamed_anon", "test_handler_unnamed_local"),
+      envir = quickr:::r2f_handlers
+    ),
+    envir = environment()
+  )
+  anon <- quickr:::register_r2f_handler(
+    "test_handler_unnamed_anon",
+    function(e, scope, ...) NULL
+  )
+  # A symbol, but bound in a call frame rather than a namespace, so the name
+  # would mean something else the next time the frame is entered.
+  local <- quickr:::register_r2f_handler(
+    "test_handler_unnamed_local",
+    local_handler
+  )
+  expect_null(anon@fun_name)
+  expect_null(local@fun_name)
+})
+
+test_that("dispatch re-resolves a named handler's namespace binding", {
+  # covr rebinds its instrumented copies into the namespace after the package
+  # has loaded -- that is, after registration captured the function object.
+  # Mocking the binding reproduces that sequence exactly.
+  original <- last
+  withr::defer(
+    rm(list = "test_handler_rebound", envir = quickr:::r2f_handlers),
+    envir = environment()
+  )
+  registered <- quickr:::register_r2f_handler("test_handler_rebound", last)
+  expect_identical(registered@fun_name, "last")
+
+  local_mocked_bindings(last = function(x) "rebound")
+  resolved <- quickr:::get_r2f_handler(quote(test_handler_rebound))
+  expect_identical(resolved("ignored"), "rebound")
+
+  # Resolving hands back a copy; the registry still holds what was registered.
+  expect_identical(
+    S7::S7_data(quickr:::r2f_handlers[["test_handler_rebound"]]),
+    original
+  )
+})
+
+test_that("dispatch leaves unnamed handlers alone", {
+  handler <- function(e, scope, ...) "anonymous"
+  withr::defer(
+    rm(list = "test_handler_untouched", envir = quickr:::r2f_handlers),
+    envir = environment()
+  )
+  quickr:::register_r2f_handler("test_handler_untouched", handler)
+  resolved <- quickr:::get_r2f_handler(quote(test_handler_untouched))
+  expect_null(resolved@fun_name)
+  expect_identical(S7::S7_data(resolved), handler)
+})
+
 test_that("register_r2f_handler registers multiple names", {
   handler <- function(e, scope, ...) NULL
   withr::defer(