fixInNamespace("<S3method>", ns) gets generic from 'ns' (or parents)

git-svn-id: https://svn.r-project.org/R/trunk@88423 00db46b3-68df-0310-9c12-caf00c1e9a41

Author: smeyer

doc/NEWS.Rd

@@ -223,6 +223,10 @@
       \file{doc/index.html} page now also work for packages not installed
       in the default \code{.Library},
       thanks to a report by \I{Patrice Kiener}.
+
+      \item %\code{assignInNamespace("\var{S3method}")} and thus
+      \code{fixInNamespace("\var{S3method}")} failed to update the S3
+      methods table when the generic was not on the search path.
     }
   }
 }

src/library/utils/R/objects.R

@@ -1,7 +1,7 @@
 #  File src/library/utils/R/objects.R
 #  Part of the R package, https://www.R-project.org
 #
-#  Copyright (C) 1995-2024 The R Core Team
+#  Copyright (C) 1995-2025 The R Core Team
 #
 #  This program is free software; you can redistribute it and/or modify
 #  it under the terms of the GNU General Public License as published by
@@ -419,7 +419,7 @@ function(x, value)
         S3names <- S3[, 3L]
         if(x %in% S3names) {
             i <- match(x, S3names)
-            genfun <- get(S3[i, 1L], mode = "function", envir = parent.frame())
+            genfun <- get(S3[i, 1L], mode = "function", envir = ns)
             if(.isMethodsDispatchOn() && methods::is(genfun, "genericFunction"))
                 genfun <- methods::slot(genfun, "default")@methods$ANY
             defenv <- .defenv_for_S3_registry(genfun)
@@ -479,7 +479,7 @@ function(x, value, ns, pos = -1, envir = as.environment(pos))
         S3names <- S3[, 3L]
         if(x %in% S3names) {
             i <- match(x, S3names)
-            genfun <- get(S3[i, 1L], mode = "function", envir = parent.frame())
+            genfun <- get(S3[i, 1L], mode = "function", envir = ns)
             if(.isMethodsDispatchOn() && methods::is(genfun, "genericFunction"))
                 genfun <- methods::slot(genfun, "default")@methods$ANY
             defenv <- .defenv_for_S3_registry(genfun)

tests/reg-tests-1e.R

@@ -2028,6 +2028,23 @@ stopifnot(identical(x, expression()),
           identical(`length<-`(x, 2L), expression(NULL, NULL)))
 
 
+## (fix|assign)InNamespace(<S3method>) when the generic is not in search()
+try(detach("package:tools"), silent = TRUE) # just in case
+assertValueIs <- function (value) stopifnot(exprs = {
+    identical(tools:::toRd.default(1), value)
+    identical(tools::toRd(1), value)
+})
+assertValueIs("1")
+## modify the default method to return an empty string:
+omethod <- tools:::toRd.default
+assignInNamespace("toRd.default", `body<-`(omethod, value = ""), "tools")
+## R <= 4.5.1 gave Error: object 'toRd' of mode 'function' was not found
+assertValueIs("")  # failed for tools::toRd(1): S3 table was not updated
+## now restore the original definition:
+assignInNamespace("toRd.default", omethod, "tools")
+assertValueIs("1")
+
+
 
 ## keep at end
 rbind(last =  proc.time() - .pt,