Start making the methods package more robust to not being on the sear…

…ch path

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

doc/NEWS.Rd

@@ -353,6 +353,9 @@
 
   \subsection{BUG FIXES}{
     \itemize{
+      \item The methods package is more robust to not being attached to
+      the search path. More work needs to be done.
+      
       \item \code{pairwise.t.test()} misbehaved when subgroups had 0 DF
       for variance, even with \code{pool.sd=TRUE} \PR{18594} (Jack Berry).
 

src/library/methods/R/BasicClasses.R

@@ -196,7 +196,7 @@
     ## not defined at the time these are done).
     setMethod("coerce", c("ANY", "ts"), function (from, to, strict = TRUE)
               {
-                  value <- as.ts(from)
+                  value <- stats::as.ts(from)
                   if(strict) {
                       attrs <- attributes(value)
                       if(length(attrs) > 2)

src/library/methods/R/ClassExtensions.R

@@ -41,8 +41,8 @@
 ## these cases is less likely but needs to be tested (below) and a suitable
 ## replace function inserted.
 .simpleExtReplace <- function(from, to, value){
-    for(what in .InhSlotNames(to))
-        slot(from, what) <- slot(value, what)
+    for(what in methods:::.InhSlotNames(to))
+        methods::slot(from, what) <- methods::slot(value, what)
     from
 }
 ## slot names for inheritance (to be used in replace methods).  Extends slots to implicit
@@ -61,7 +61,7 @@
 },
 
 f2 = function(from, to, value){
-    from@.Data <- as(value, THISCLASS, strict = FALSE)
+    from@.Data <- methods::as(value, THISCLASS, strict = FALSE)
     from
 },
 
@@ -135,12 +135,12 @@ S3Part <- function(object, strictS3 = FALSE, S3Class) {
 .S3replace <-
     list(e1 =
          quote( {
-             S3Part(from, needClass = NEED) <- value
+             methods::S3Part(from, needClass = NEED) <- value
              from
          }),
          e2 = quote( {
-             if(is(value, CLASS)) {
-                 S3Part(from,  needClass = NEED) <- value
+             if(methods::is(value, CLASS)) {
+                 methods::S3Part(from,  needClass = NEED) <- value
                  from
              }
              else
@@ -152,7 +152,7 @@ S3Part <- function(object, strictS3 = FALSE, S3Class) {
          )
 
 .S3coerce <- function(from, to) {
-    S3Part(from)
+    methods::S3Part(from)
 }
 
 .ErrorReplace <- function(from, to, value)
@@ -207,7 +207,7 @@ makeExtends <- function(Class,
 ##            allNames <- names(slots)
             body(coerce, envir = packageEnv) <-
                 substitute({
-                    if(strict) S3Part(from, S3Class = S3CLASS)
+                    if(strict) methods::S3Part(from, S3Class = S3CLASS)
                     else from
                 }, list(S3CLASS =  to))
         }
@@ -262,7 +262,7 @@ makeExtends <- function(Class,
                   S3Class <- to
                 body(replace, envir = packageEnv) <-
                   quote({
-                      S3Part(from) <- value
+                      methods::S3Part(from) <- value
                       from
                   })
             }

src/library/methods/R/RClassUtils.R

@@ -1596,12 +1596,14 @@ setDataPart <- function(object, value, check = TRUE) {
             skipExt <- skipDef@contains[[to]]
             if (!is.null(skipExt)) {
                 body(f, envir = environment(f)) <-
-                    call("as", body(skipExt@replace), byExt@subClass)
+                    substitute(methods::as(BODY, TO),
+                               list(BODY = body(skipExt@replace),
+                                    TO = byExt@subClass))
             }
         } else {
             expr <- substitute({
-                .value <- as(from, BY, STRICT)
-                as(.value, TO) <- value
+                .value <- methods::as(from, BY, STRICT)
+                methods::as(.value, TO) <- value
                 value <- .value
                 BYEXPR
             }, list(BY=by, TO = to, BYEXPR = byExpr, STRICT = strictBy))
@@ -1659,9 +1661,9 @@ setDataPart <- function(object, value, check = TRUE) {
 	}
     }
     else {
-	substitute({ value <- new(CLASS)
+	substitute({ value <- methods::new(CLASS)
 		     for(what in TOSLOTS)
-			 slot(value, what) <- slot(from, what)
+                         methods::slot(value, what) <- methods::slot(from, what)
 		     value },
 		   list(CLASS = chClass, TOSLOTS = toSlots))
     }
@@ -1671,7 +1673,7 @@ setDataPart <- function(object, value, check = TRUE) {
     toSlots <- names(toDef@slots)
     substitute({
         for(what in TOSLOTS)
-            slot(from, what) <- slot(value, what)
+            methods::slot(from, what) <- methods::slot(value, what)
         from
     }, list(TOSLOTS = toSlots))
 }

src/library/methods/R/as.R

@@ -320,11 +320,11 @@ setAs <-
 	     }, list(AS = as.name(paste0("as.", what)))),
 	     ##
 	     ts = body(method, envir = environment(method)) <- quote({
-		 value <- as.ts(from)
+		 value <- stats::as.ts(from)
 		 if(strict) {
 		     attributes(value) <- NULL
 		     class(value) <- class(new("ts"))
-		     tsp(value) <- tsp(from)
+		     stats::tsp(value) <- stats::tsp(from)
 		 }
 		 value
 	     }),

src/library/methods/R/zzz.R

@@ -22,6 +22,9 @@
   function(libname, pkgname)
 {
     where <- environment(sys.function())  # the namespace
+    coerceVars <- c("as", "as<-", "is", "new", "S3Part", "S3Part<-", "slot",
+                    "slot<-")
+    namespaceExport(where, coerceVars)
     initMethodDispatch(where)
     ## temporary empty reference to the package's own namespace
     assign(".methodsNamespace", new.env(), envir = where)
@@ -84,6 +87,7 @@
        .InitS3Classes, .InitSpecialTypesAndClasses, .InitTraceFunctions,
        .InitRefClasses, .initImplicitGenerics,
        envir = where)
+    rm(list = coerceVars, envir = .getNamespaceInfo(where, "exports"))
     ## unlock some bindings that must be modifiable
     unlockBinding(".BasicFunsList", where)
     assign(".saveImage", TRUE, envir = where)

src/library/tools/R/QC.R

@@ -6221,7 +6221,8 @@ function(package, dir, lib.loc = NULL)
                        (imp3f %notin% c(".class1",
                                         ".missingMethod",
                                         ".selectDotsMethod",
-                                        ".setDummyField"))]
+                                        ".setDummyField",
+                                        ".InhSlotNames"))]
         imp3 <- names(imp3f)
     }
     imp3 <- unique(imp3)

tests/reg-S4.R

@@ -869,7 +869,7 @@ stopifnot(identical(alsofirstclass, class.list[[1]]))
 setClass("A", slots = c(foo = "numeric"))
 setClass("Ap", contains = "A", slots = c(p = "character"))
 cd <- getClassDef("Ap")
-body(cd@contains[["A"]]@coerce)[[2]] ## >>   value <- new("A")
+body(cd@contains[["A"]]@coerce)[[2]] ## >>   value <- methods::new("A")
 ## was ... <-  new(structure("A", package = ".GlobalEnv"))
 ## for a few days in R-devel (Nov.2017)
 

tests/reg-S4.Rout.save

@@ -1165,8 +1165,8 @@ Also defined by 'package2'
 > setClass("A", slots = c(foo = "numeric"))
 > setClass("Ap", contains = "A", slots = c(p = "character"))
 > cd <- getClassDef("Ap")
-> body(cd@contains[["A"]]@coerce)[[2]] ## >>   value <- new("A")
-value <- new("A")
+> body(cd@contains[["A"]]@coerce)[[2]] ## >>   value <- methods::new("A")
+value <- methods::new("A")
 > ## was ... <-  new(structure("A", package = ".GlobalEnv"))
 > ## for a few days in R-devel (Nov.2017)
 >