Index: src/library/methods/R/SClasses.R =================================================================== --- src/library/methods/R/SClasses.R (revision 69088) +++ src/library/methods/R/SClasses.R (working copy) @@ -127,7 +127,7 @@ ## since set SClass works separately with the slots and extends arguments. anames <- allNames(value) for(i in seq_along(value)) { - ei <- el(value, i) + ei <- value[[i]] if(!is.character(ei) || length(ei) != 1L) stop(gettextf("element %d of the representation was not a single character string", i), domain = NA) } @@ -205,7 +205,7 @@ what <- whatClassDef@className # includes package name as attribute ## Create the SClassExtension objects (will be simple, possibly dataPart). ## The slots are supplied explicitly, since `name' is currently an undefined class - elNamed(contains, what) <- makeExtends(name, what, slots = slots, + contains[[what]] <- makeExtends(name, what, slots = slots, classDef2 = whatClassDef, package = package) } validity <- .makeValidityMethod(name, validity) @@ -212,7 +212,7 @@ if(is.na(virtual)) { virtual <- testVirtual(slots, contains, prototype, where) if(virtual && !is.na(match("VIRTUAL", superClasses))) - elNamed(contains, "VIRTUAL") <- NULL + contains[["VIRTUAL"]] <- NULL } # new() must return an S4 object, except perhaps for basic classes if(!is.null(prototype) && is.na(match(name, .BasicClasses))) @@ -239,14 +239,12 @@ .getClassFromCache(Class, where, package=package, resolve.msg=resolve.msg) ## else NULL # want to force a search for the metadata in this case (Why?) if(is.null(value)) { - cname <- - classMetaName(if(length(Class) > 1L) - ## S3 class; almost certainly has no packageSlot, + cname <- methodsPackageMetaName("C", Class[[1L]]) + ## if length(Class) > 1L then S3 class; almost certainly has no packageSlot, ## but we'll continue anyway - Class[[1L]] else Class) ## a string with a package slot strongly implies the class definition ## should be in that package. - if(identical(nzchar(package), TRUE)) { + if(!is.null(package) && !is.na(package) && nzchar(package)) { whereP <- .requirePackage(package) value <- get0(cname, whereP, inherits = inherits) # NULL if not existing } @@ -305,7 +303,7 @@ { cl <- class(obj) ClassDef <- getClass(cl) # fails if cl not a defined class (!) - slotClass <- elNamed(ClassDef@slots, name) + slotClass <- ClassDef@slots[[name]] if(is.null(slotClass)) stop(gettextf("%s is not a slot in class %s", sQuote(name), dQuote(cl)), @@ -331,7 +329,7 @@ checkAtAssignment <- function(cl, name, valueClass) { ClassDef <- getClass(cl) # fails if cl not a defined class (!) - slotClass <- elNamed(ClassDef@slots, name) + slotClass <- ClassDef@slots[[name]] if(is.null(slotClass)) stop(gettextf("%s is not a slot in class %s", sQuote(name), dQuote(cl)), @@ -445,11 +443,11 @@ evList <- .parentEnvList(where) clNames <- character() for(ev in evList) - clNames <- c(clNames, objects(ev, pattern = pat, all.names = TRUE)) + clNames <- c(clNames, grep(pat, names(ev), value=TRUE)) clNames <- unique(clNames) } else - clNames <- objects(where, pattern = pat, all.names = TRUE) + clNames <- grep(pat, names(where), value=TRUE) ## strip off the leading pattern (this implicitly assumes the characters ## in classMetaName("") are either "." or not metacharacters substring(clNames, nchar(pat, "c")) @@ -641,11 +639,11 @@ supers <- args[!which] thisExtends <- names(ClassDef@contains) slotDefs <- ClassDef@slots - dataPart <- elNamed(slotDefs, ".Data") + dataPart <- slotDefs[[".Data"]] if(is.null(dataPart)) dataPart <- "missing" if(length(supers)) { for(i in rev(seq_along(supers))) { - obj <- el(supers, i) + obj <- supers[[i]] Classi <- class(obj) if(length(Classi) > 1L) Classi <- Classi[[1L]] #possible S3 inheritance @@ -698,10 +696,10 @@ domain = NA) firstTime <- TRUE for(i in seq_along(snames)) { - slotName <- el(snames, i) - slotClass <- elNamed(slotDefs, slotName) + slotName <- snames[[i]] + slotClass <- slotDefs[[slotName]] slotClassDef <- getClassDef(slotClass, package = ClassDef@package) - slotVal <- el(elements, i) + slotVal <- elements[[i]] ## perform non-strict coercion, but leave the error messages for ## values not conforming to the slot definitions to validObject(), ## hence the check = FALSE argument in the slot assignment Index: src/library/methods/R/as.R =================================================================== --- src/library/methods/R/as.R (revision 69088) +++ src/library/methods/R/as.R (working copy) @@ -125,7 +125,7 @@ ## be the equivalent of new("toClass", fromObject) ## But must check that replacement is defined, in the case ## of nonstandard superclass relations - replaceMethod <- elNamed(ClassDef@contains, fromClass) + replaceMethod <- ClassDef@contains[[fromClass]] if(is(replaceMethod, "SClassExtension") && !identical(as(replaceMethod@replace, "function"), .ErrorReplace)) { f <- function(from, to) NULL Index: src/library/methods/R/is.R =================================================================== --- src/library/methods/R/is.R (revision 69088) +++ src/library/methods/R/is.R (working copy) @@ -23,11 +23,10 @@ function(object, class2) { cl <- class(object) - S3Case <- length(cl) > 1L - if(S3Case) - cl <- cl[[1L]] - if(missing(class2)) + if(missing(class2)) { + .Deprecated("extends", "Calling the 'is' function with one argument is simply a synonym for extends.") return(extends(cl)) + } class1Def <- getClassDef(cl) if(is.null(class1Def)) # an unregistered S3 class return(inherits(object, class2)) @@ -39,9 +38,8 @@ } ## S3 inheritance is applied if the object is not S4 and class2 is either a basic ## class or an S3 class (registered or not) - S3Case <- S3Case || (is.object(object) && !isS4(object)) # first requirement - S3Case <- S3Case && (is.null(class2Def) || class2 %in% .BasicClasses || - extends(class2Def, "oldClass")) + S3Case <- (length(cl) > 1L || (is.object(object) && !isS4(object))) && # first requirement + (is.null(class2Def) || class2 %in% .BasicClasses || extends(class2Def, "oldClass")) if(S3Case) inherits(object, class2) else if(.identC(cl, class2) || .identC(class2, "ANY"))