find class definitions with same name, different packages

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

doc/NEWS.Rd

@@ -474,6 +474,12 @@
       \item The formula methods for \code{lines()}, \code{points()} and
       \code{text()} now work even if package \pkg{stats} is not on the
       search path.
+
+      \item In principle, S4 classes from different packages could
+      have the same name.  This has never worked, but a first step has
+      been taken:  Classes should now be found correctly from each
+      package's namespace or given the package slot.  Methods for the
+      same generic function may still be selected incorrectly.
     }
   }
 }

src/library/methods/R/RClassUtils.R

@@ -1888,7 +1888,8 @@ substituteFunctionArgs <-
     if(exists(name, envir = .classTable, inherits = FALSE)) {
         newpkg <- def@package
         prev <- get(name, envir = .classTable)
-        if(is(prev, "classRepresentation"))  # we might worry if  prev not identical?
+        if(is(prev, "classRepresentation") &&
+           identical(prev@package, newpkg) )
             return(remove(list = name, envir = .classTable))
          i <- match(newpkg, names(prev))
         if(!is.na(i))

src/library/methods/R/SClasses.R

@@ -48,9 +48,8 @@ setClass <-
         superClasses <- names(classDef@contains)
     }
     classDef <- completeClassDefinition(Class, classDef, where, doExtends = FALSE)
-    oldDef <- getClassDef(Class, where)
-    if(is(oldDef, "classRepresentation"))
-      .uncacheClass(Class, oldDef)
+    ## uncache an old definition for this package, if one is cached
+    .uncacheClass(Class, classDef)
     if(length(superClasses) > 0L) {
         sealed <- classDef@sealed
         classDef@sealed <- FALSE # to allow setIs to work anyway; will be reset later

src/library/methods/src/methods_list_dispatch.c

@@ -824,9 +824,19 @@ SEXP R_getClassFromCache(SEXP class, SEXP table)
 {
     SEXP value;
     if(TYPEOF(class) == STRSXP) {
+	SEXP package = PACKAGE_SLOT(class);
 	value = findVarInFrame(table, install(CHAR(STRING_ELT(class, 0))));
 	if(value == R_UnboundValue)
 	    return R_NilValue;
+	else if(TYPEOF(package) == STRSXP) {
+	    SEXP defPkg = PACKAGE_SLOT(value);
+	    /* check equality of package */
+	    if(TYPEOF(defPkg) == STRSXP && length(defPkg) ==1 &&
+	       STRING_ELT(defPkg,0) != STRING_ELT(package, 0))
+		return R_NilValue;
+	    else
+		return value;
+	}
 	else /* may return a list if multiple instances of class */
 	    return value;
     }

src/library/methods/tests/duplicateClass.R

@@ -0,0 +1,42 @@
+## Tests for handling classes with same name & different package slots
+## First:  Can we define the classes and get the separate definitions
+## from the appropriate namespace or from the package slot in class(x)?
+stopifnot(require(Matrix))
+
+## from: example(chol)
+sy2 <- new("dsyMatrix", Dim = as.integer(c(2,2)), x = c(14, NA,32,77))
+c2 <- chol(sy2)
+
+clM <- getClass("Cholesky")
+
+setClass("Cholesky", contains = "numeric", representation(size = "integer"))
+
+clG <- getClass("Cholesky", where = .GlobalEnv)
+
+stopifnot(identical(getClass("Cholesky", where = asNamespace("Matrix")),
+                    clM))
+
+stopifnot(identical(getClass(class(c2)), clM))
+
+stopifnot(identical(evalq(getClass("Cholesky"), asNamespace("Matrix")),
+                    clM))
+stopifnot(identical(getClass("Cholesky"), clG))
+
+## Second:  tests of methods defined for the same generic
+## (NOT YET!)
+
+## setAs("Cholesky", "matrix",
+##       function(from) {
+##           p <- from@size
+##           value <- matrix(0, p, p)
+##           start <- 0
+##           for(i in seq(length = p)) {
+##               ii <- seq(length = i)
+##               value[i, ii] <- from[start + ii]
+##               start <- start + i
+##           }
+##           value
+##       },
+##       replace = function(from, value) stop("Sorry, not implemented")
+##       )
+