The R Project SVN R

Rev

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

Rev 90169 Rev 90183
Line 214... Line 214...
214 
        identical(as.character(class(grandparent)), "GrandParentShimForAs")
 214 
        identical(as.character(class(grandparent)), "GrandParentShimForAs")
215 
    )
 215 
    )
216 
})
 216 
})
217 
 
 217 
 
218 
 
 218 
 
- 
 
 219 
## Registering an old class from an existing S4 class should update class
- 
 
 220 
## union subclass caches after the old class definition itself is available.
- 
 
 221 
local({
- 
 
 222 
    where <- environment()
- 
 
 223 
    setClass("UnionMemberForOldClassRecache", contains = "VIRTUAL", where = where)
- 
 
 224 
    setClassUnion("UnionForOldClassRecache", "UnionMemberForOldClassRecache",
- 
 
 225 
                  where = where)
- 
 
 226 
    setClass("ParentForOldClassRecache",
- 
 
 227 
             contains = c("UnionForOldClassRecache", "VIRTUAL"), where = where)
- 
 
 228 
    setClass("ChildForOldClassRecache",
- 
 
 229 
             contains = c("ParentForOldClassRecache", "VIRTUAL"), where = where)
- 
 
 230 
    setOldClass(c("ChildForOldClassRecache", "oldClass"),
- 
 
 231 
                S4Class = "ChildForOldClassRecache", where = where)
- 
 
 232 
 
- 
 
 233 
    union <- getClass("UnionForOldClassRecache", where = where)
- 
 
 234 
    child <- getClass("ChildForOldClassRecache", where = where)
- 
 
 235 
    stopifnot(
- 
 
 236 
        "ChildForOldClassRecache" %in% names(union@subclasses),
- 
 
 237 
        "UnionForOldClassRecache" %in% names(child@contains)
- 
 
 238 
    )
- 
 
 239 
})
- 
 
 240 
 
- 
 
 241 
 
219 
## canCoerce(obj, .)  when length(class(obj)) > 1 :
 242 
## canCoerce(obj, .)  when length(class(obj)) > 1 :
220 
setOldClass("foo")
 243 
setOldClass("foo")
221 
setAs("foo", "A", function(from) new("A", foo=from))
 244 
setAs("foo", "A", function(from) new("A", foo=from))
222 
o3 <- structure(1:7, class = c("foo", "bar"))
 245 
o3 <- structure(1:7, class = c("foo", "bar"))
223 
stopifnot( canCoerce(o3, "A") )
 246 
stopifnot( canCoerce(o3, "A") )