View | Details | Raw Unified | Return to bug 16490 | Differences between
and this patch

Collapse All | Expand All

(-)src/library/methods/R/is.R (-28 / +13 lines)
Lines 16-57 Link Here
16
#  A copy of the GNU General Public License is available at
16
#  A copy of the GNU General Public License is available at
17
#  https://www.R-project.org/Licenses/
17
#  https://www.R-project.org/Licenses/
18
18
19
# With two arguments, tests whether `object' can be treated as from `class2'.
19
is <-
20
is <-
20
  # With two arguments, tests whether `object' can be treated as from `class2'.
21
  #
22
  # With one argument, returns all the super-classes of this object's class.
23
function(object, class2)
21
function(object, class2)
24
{
22
{
25
    cl <- class(object)
23
26
    S3Case <- length(cl) > 1L
24
    # The behaviors of this block should all be deprecated
27
    if(S3Case)
25
    # We should require direct use of 'extends'. This alternate usage
28
        cl <- cl[[1L]]
26
    # does not appear to be documented.
27
    # base and methods never pass a classDef for class2 
29
    if(missing(class2))
28
    if(missing(class2))
30
        return(extends(cl))
29
        return(extends(class(object)))
31
    class1Def <- getClassDef(cl)
30
    else if (!is.character(class2))
32
    if(is.null(class1Def)) # an unregistered S3 class
33
        return(inherits(object, class2))
34
    if(is.character(class2))
35
        class2Def <- getClassDef(class2, .classDefEnv(class1Def))
36
    else {
37
        class2Def <- class2
38
        class2 <- class2Def@ className
31
        class2 <- class2Def@ className
39
    }
32
40
    ## S3 inheritance is applied if the object is not S4 and class2 is either a basic
33
    if (inherits(object, class2)) { # Use for S3 and use the inherits cache for S4
41
    ## class or an S3 class (registered or not)
42
    S3Case <- S3Case || (is.object(object) && !isS4(object)) # first requirement
43
    S3Case <- S3Case && (is.null(class2Def) || class2 %in% .BasicClasses ||
44
			 extends(class2Def, "oldClass"))
45
    if(S3Case)
46
        inherits(object, class2)
47
    else if(.identC(cl, class2) || .identC(class2, "ANY"))
48
        TRUE
34
        TRUE
49
    else if(is.logical(ext <- possibleExtends(cl, class2, class1Def, class2Def)))
35
    } else # S4 and some special cases need more chances to find a TRUE, S3 will return FALSE promptly
36
        if(is.logical(ext <- possibleExtends(class(object), class2))) # Perhaps we should inline the relevant parts of possbibleExtends here?
50
        ext
37
        ext
51
    else if(ext@simple)
52
        TRUE
53
    else
38
    else
54
        ext@test(object)
39
            ext@simple || ext@test(object)
55
}
40
}
56
41
57
extends <-
42
extends <-

Return to bug 16490