isGeneric(<primitive>, fdef=*, getName=TRUE) fix

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

Author: maechler

doc/NEWS.Rd

@@ -408,7 +408,7 @@
       \item Fix segfault on \code{quartz()} from \code{grid.glyph()}
       call with \code{glyphInfo()} that describes non-existent font
       (\PR{18784}).  Thanks to \I{Tomek Gieorgijewski}.
-  
+
     }
   }
 }
@@ -449,9 +449,13 @@
       vector and a logical, integer or double vector -- previously the
       inclusion of the latter was garbled.
 
-      \item \code{smooth.spline()} checks validoity of its arguements
+      \item \code{smooth.spline()} checks validity of its arguments
       \code{df.offset} and \code{penalty}: it could segfault if they
       were \code{NULL}.
+
+      \item \code{isGeneric(<primitive>, fdef=*, getName=TRUE)} now also
+      returns the name instead of just \code{TRUE}, fixing \PR{18829}
+      reported by \I{Mikael Jagan}.
     }
   }
 }

src/library/methods/R/Methods.R

@@ -267,26 +267,26 @@ isGeneric <-
         ## a successful search will usually end here w/o other tests
          if(!is.null(fdef))
            return(if(getName) fdef@generic else TRUE)
-     }
+    }
     if(is.null(fdef))
         fdef <- getFunction(f, where=where, mustFind = FALSE)
     if(is.null(fdef))
       return(FALSE)
     ## check primitives. These are never found as explicit generic functions.
     if(is.primitive(fdef)) {
-        ## the definition of isGeneric() for a base function is that methods are defined
+        ## the definition of isGeneric() for such a function is that methods are defined
         ## (other than the default primitive)
         gen <- genericForBasic(.primname(fdef), mustFind = FALSE)
-        return(is.function(gen) && length(names(.getMethodsTable(gen))) > 1L)
+        return(
+            if(is.function(gen) && length(names(.getMethodsTable(gen))) > 1L)
+                if(getName) gen@generic else TRUE
+            else FALSE)
     }
     if(!is(fdef, "genericFunction"))
         return(FALSE)
     gen <- fdef@generic # the name with package attribute
     if(missing(f) || .identC(gen, f)) {
-	if(getName)
-	    gen
-	else
-	    TRUE
+	if(getName) gen else TRUE
     }
     else {
         warning(gettextf(

tests/reg-tests-1e.R

@@ -1661,6 +1661,16 @@ stopifnot(
 )
 
 
+## isGeneric(., getName = TRUE, ..) w/ or w/o fdef -- PR#18829
+setClass("zzz")
+setMethod("+", c(e1 = "zzz", e2 = "missing"), function(e1, e2) e1)
+(gen <- isGeneric("+", fdef = `+`, getName = TRUE)) # wrongly returned just TRUE
+stopifnot(identical(gen, isGeneric("+", getName = TRUE)), # the latter always worked
+          identical(gen, structure("+", package = "base")),
+          isGeneric("+"), isGeneric("+", fdef = `+`))
+
+
+
 ## keep at end
 rbind(last =  proc.time() - .pt,
       total = proc.time())