The R Project SVN R

Rev

Rev 61605 | Rev 68233 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 61605 Rev 61876
Line 63... Line 63...
63 
stopifnot(ff %in% known, known %in% ff)
 63 
stopifnot(ff %in% known, known %in% ff)
64 
 
 64 
 
65 
 
 65 
 
66 
## check which are not considered as possibles for S4 generic
 66 
## check which are not considered as possibles for S4 generic
67 
ff4 <- names(methods:::.BasicFunsList)
 67 
ff4 <- names(methods:::.BasicFunsList)
68 
# as.double and as.real are the same as as.numeric
 68 
# as.double is the same as as.numeric
69 
S4generic <- ff %in% c(ff4, "as.double", "as.real")
 69 
S4generic <- ff %in% c(ff4, "as.double")
70 
notS4 <- ff[!S4generic]
 70 
notS4 <- ff[!S4generic]
71 
if(length(notS4))
 71 
if(length(notS4))
72 
    cat("primitives not covered in methods:::.BasicFunsList:",
 72 
    cat("primitives not covered in methods:::.BasicFunsList:",
73 
        paste(sQuote(notS4), collapse=", "), "\n")
 73 
        paste(sQuote(notS4), collapse=", "), "\n")
74 
stopifnot(S4generic)
 74 
stopifnot(S4generic)
Line 93... Line 93...
93 
## Now check that (most of) those which are listed really are generic.
 93 
## Now check that (most of) those which are listed really are generic.
94 
require(methods)
 94 
require(methods)
95 
setClass("foo", representation(x="numeric", y="numeric"))
 95 
setClass("foo", representation(x="numeric", y="numeric"))
96 
xx <- new("foo",  x=1, y=2)
 96 
xx <- new("foo",  x=1, y=2)
97 
S4gen <- names(methods:::.BasicFunsList)[sapply(methods:::.BasicFunsList, function(x) is.function(x))]
 97 
S4gen <- names(methods:::.BasicFunsList)[sapply(methods:::.BasicFunsList, function(x) is.function(x))]
98 
S4gen <- setdiff(S4gen, "as.real") # deprecated
 - 
 
99 
for(f in S4gen) {
 98 
for(f in S4gen) {
100 
    g <- get(f)
 99 
    g <- get(f)
101 
    if(is.primitive(g)) g <- getGeneric(f) # should error on non-Generics.
 100 
    if(is.primitive(g)) g <- getGeneric(f) # should error on non-Generics.
102 
    ff <- args(g)
 101 
    ff <- args(g)
103 
    body(ff) <- "testit"
 102 
    body(ff) <- "testit"