fix PR#4275: getAnywhere("*.*.*")

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

NEWS

@@ -630,6 +630,9 @@ BUG FIXES
     o	dotchart() now does recycle the `color' argument and better
 	documents the `bg' one (PR#4343).
 
+    o	getAnywhere() didn't not correctly check for S3 methods, when
+	the generic or the class name contains a "." (PR#4275).
+
     o	file.copy() ignored the overwrite argument.  (PR#3529)
 
     o	filter(method="recursive") was unnecessarily requiring the

src/library/base/R/objects.R

@@ -300,10 +300,10 @@ getAnywhere <- function(x)
     }
     ## next look for methods
     if(length(grep("\\.", x))) {
-        parts <- strsplit(x, "\\.")[[1]]
-        for(i in 2:length(parts)) {
-            gen <- paste(parts[1:(i-1)], collapse="")
-            cl <- paste(parts[2:length(parts)], collapse="")
+        np <- length(parts <- strsplit(x, "\\.")[[1]])
+        for(i in 2:np) {
+            gen <- paste(parts[1:(i-1)], collapse=".")
+            cl <- paste(parts[i:np], collapse=".")
             if(!is.null(f <- getS3method(gen, cl, TRUE))) {
                 ev <- topenv(environment(f), NULL)
                 nmev <- if(isNamespace(ev)) getNamespaceName(ev) else NULL

tests/reg-tests-1.R

@@ -2669,6 +2669,16 @@ stopifnot(crossprod(z) == cz,# the first has NULL dimnames
 stopifnot(!is.na(rmultinom(12,100, c(3, 4, 2, 0,0))))
 ## 3rd line was all NA before 1.8.0
 
+## PR#4275: getAnywhere with extra "."
+g0 <- getAnywhere("predict.loess")
+g1 <- getAnywhere("as.dendrogram.hclust")
+g2 <- getAnywhere("predict.smooth.spline")
+g3 <- getAnywhere("print.data.frame")
+is.S3meth <- function(ga) any(substr(ga$where, 1,20) == "registered S3 method")
+stopifnot(is.S3meth(g0), is.S3meth(g1),
+          is.S3meth(g2), is.S3meth(g3))
+## all but g0 failed until 1.8.0 (Oct 6)
+
 ## keep at end, as package `methods' has had persistent side effects
 library(methods)
 stopifnot(all.equal(3:3, 3.), all.equal(1., 1:1))