The R Project SVN R

Rev

Rev 84054 | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 84054 Rev 84152
Line 60... Line 60...
60 
abc(e1)
 60 
abc(e1)
61 
abc(e0[[1]])
 61 
abc(e0[[1]])
62 
abc(e1[[1]])
 62 
abc(e1[[1]])
63 
 
 63 
 
64 
 
 64 
 
- 
 
 65 
## Some tests for `nameOfClass()`, called from inherits()
- 
 
 66 
ClassX <- structure(list(), name = "ClassX",
- 
 
 67 
                    class = c("S3pp_class", "S3pp_object"))
- 
 
 68 
 
- 
 
 69 
classx_instance <- structure(list(), class = c("ClassX", "S3pp_object"))
- 
 
 70 
 
- 
 
 71 
nameOfClass.S3pp_class <- function(x) attr(x, "name", TRUE)
- 
 
 72 
nameOfClass.foo <- function(x) "bar"
- 
 
 73 
 
- 
 
 74 
stopifnot(exprs = {
- 
 
 75 
    inherits(classx_instance, "ClassX")
- 
 
 76 
    inherits(classx_instance, ClassX)
- 
 
 77 
    ## ignore class on a character object
- 
 
 78 
    isTRUE(inherits(1, structure("numeric", class = "foo")))
- 
 
 79 
    ## make sure class is nor evaluated in calling nameOfClass
- 
 
 80 
    isFALSE(inherits(1, structure(quote(stop("should not be evaluated")),
- 
 
 81 
                                  class = "foo")))
- 
 
 82 
})
- 
 
 83 
 
- 
 
 84 
 
65 
## Some tests for `@` dispatching
 85 
## Some tests for `@` dispatching
66 
## make sure that
 86 
## make sure that
67 
## - `@` evals the first args only once,
 87 
## - `@` evals the first args only once,
68 
## -  doesn't dispatch for S4
 88 
## -  doesn't dispatch for S4
69 
## -  works on `.Data` even for nonS4 objects
 89 
## -  works on `.Data` even for nonS4 objects
Line 115... Line 135...
115 
  stop("called @.Person()\n")
 135 
  stop("called @.Person()\n")
116 
}
 136 
}
117 
 
 137 
 
118 
p <- new("Person", name = "Who", age = -1)
 138 
p <- new("Person", name = "Who", age = -1)
119 
stopifnot(p@name == "Who")
 139 
stopifnot(p@name == "Who")
- 
 
 140 
 
- 
 
 141 
 
- 
 
 142 
## Some tests for `chooseOpsMethod()`, called from C DispatchGroup() when
- 
 
 143 
## 2 methods are found
- 
 
 144 
foo_obj <- structure(1, class = "foo")
- 
 
 145 
bar_obj <- structure(1, class = "bar")
- 
 
 146 
 
- 
 
 147 
`+.foo` <- function(e1, e2) "foo"
- 
 
 148 
`+.bar` <- function(e1, e2) "bar"
- 
 
 149 
 
- 
 
 150 
invisible(foo_obj + bar_obj)  # Warning: Incompatible methods
- 
 
 151 
 
- 
 
 152 
chooseOpsMethod.bar <- function(x, y, mx, my, cl, reverse) TRUE
- 
 
 153 
 
- 
 
 154 
stopifnot(exprs = {
- 
 
 155 
    identical(foo_obj + bar_obj, "bar")
- 
 
 156 
    identical(bar_obj + foo_obj, "bar")
- 
 
 157 
})