| Line 1... |
Line 1... |
| 1 |
####--- S4 Methods (and Classes) --- see also ../src/library/methods/tests/
|
1 |
####--- S4 Methods (and Classes) --- see also ../src/library/methods/tests/
|
| 2 |
options(useFancyQuotes=FALSE)
|
2 |
options(useFancyQuotes=FALSE)
|
| 3 |
require(methods)
|
3 |
require(methods)
|
| 4 |
assertCondition <- tools::assertCondition # "import"
|
4 |
assertError <- tools::assertError # "import"
|
| 5 |
##too fragile: showMethods(where = "package:methods")
|
5 |
##too fragile: showMethods(where = "package:methods")
|
| 6 |
|
6 |
|
| 7 |
##-- S4 classes with S3 slots [moved from ./reg-tests-1.R]
|
7 |
##-- S4 classes with S3 slots [moved from ./reg-tests-1.R]
|
| 8 |
setClass("test1", representation(date="POSIXct"))
|
8 |
setClass("test1", representation(date="POSIXct"))
|
| 9 |
x <- new("test1", date=as.POSIXct("2003-10-09"))
|
9 |
x <- new("test1", date=as.POSIXct("2003-10-09"))
|
| Line 180... |
Line 180... |
| 180 |
stop("logic operator '", nm, "' not applicable to brobs")
|
180 |
stop("logic operator '", nm, "' not applicable to brobs")
|
| 181 |
logic2 <- function(e1,e2) logic.brob.error(.Generic)
|
181 |
logic2 <- function(e1,e2) logic.brob.error(.Generic)
|
| 182 |
setMethod("Logic", signature("brob", "ANY"), logic2)
|
182 |
setMethod("Logic", signature("brob", "ANY"), logic2)
|
| 183 |
setMethod("Logic", signature("ANY", "brob"), logic2)
|
183 |
setMethod("Logic", signature("ANY", "brob"), logic2)
|
| 184 |
## Now ensure that using group members gives error:
|
184 |
## Now ensure that using group members gives error:
|
| 185 |
assertCondition(b & b, "error")
|
185 |
assertError(b & b)
|
| 186 |
assertCondition(b | 1, "error")
|
186 |
assertError(b | 1)
|
| 187 |
assertCondition(TRUE & b, "error")
|
187 |
assertError(TRUE & b)
|
| 188 |
|
188 |
|
| 189 |
|
189 |
|
| 190 |
## methods' hidden cbind() / rbind:
|
190 |
## methods' hidden cbind() / rbind:
|
| 191 |
cBind <- methods:::cbind
|
191 |
cBind <- methods:::cbind
|
| 192 |
setClass("myMat", representation(x = "numeric"))
|
192 |
setClass("myMat", representation(x = "numeric"))
|
| Line 411... |
Line 411... |
| 411 |
## new(..) failed in R 2.7.0
|
411 |
## new(..) failed in R 2.7.0
|
| 412 |
|
412 |
|
| 413 |
## Method with wrong argument order :
|
413 |
## Method with wrong argument order :
|
| 414 |
setGeneric("test1", function(x, printit = TRUE, name = "tmp")
|
414 |
setGeneric("test1", function(x, printit = TRUE, name = "tmp")
|
| 415 |
standardGeneric("test1"))
|
415 |
standardGeneric("test1"))
|
| 416 |
assertCondition(
|
416 |
tools::assertCondition(
|
| 417 |
setMethod("test1", "numeric", function(x, name, printit) match.call()),
|
417 |
setMethod("test1", "numeric", function(x, name, printit) match.call()),
|
| 418 |
"warning", "error")## did not warn or error in R 2.7.0 and earlier
|
418 |
"warning", "error")## did not warn or error in R 2.7.0 and earlier
|
| 419 |
|
419 |
|
| 420 |
library(stats4)
|
420 |
library(stats4)
|
| 421 |
c1 <- getClass("mle", where = "stats4")
|
421 |
c1 <- getClass("mle", where = "stats4")
|
| Line 484... |
Line 484... |
| 484 |
## the 3rd did not have "methods"
|
484 |
## the 3rd did not have "methods"
|
| 485 |
|
485 |
|
| 486 |
## Invalid "factor"s -- now "caught" by validity check :
|
486 |
## Invalid "factor"s -- now "caught" by validity check :
|
| 487 |
ok.f <- gl(3,5, labels = letters[1:3])
|
487 |
ok.f <- gl(3,5, labels = letters[1:3])
|
| 488 |
bad.f <- structure(rep(1:3, each=5), levels=c("a","a","b"), class="factor")
|
488 |
bad.f <- structure(rep(1:3, each=5), levels=c("a","a","b"), class="factor")
|
| 489 |
validObject(ok.f) ; assertCondition(validObject(bad.f), "error")
|
489 |
validObject(ok.f) ; assertError(validObject(bad.f))
|
| 490 |
setClass("myF", contains = "factor")
|
490 |
setClass("myF", contains = "factor")
|
| 491 |
validObject(new("myF", ok.f))
|
491 |
validObject(new("myF", ok.f))
|
| 492 |
assertCondition(validObject(new("myF", bad.f)), "error")
|
492 |
assertError(validObject(new("myF", bad.f)))
|
| 493 |
removeClass("myF")
|
493 |
removeClass("myF")
|
| 494 |
## no validity check in R <= 2.9.0
|
494 |
## no validity check in R <= 2.9.0
|
| 495 |
|
495 |
|
| 496 |
## as(x, .) when x is from an "unregistered" S3 class :
|
496 |
## as(x, .) when x is from an "unregistered" S3 class :
|
| 497 |
as(structure(1:3, class = "foobar"), "vector")
|
497 |
as(structure(1:3, class = "foobar"), "vector")
|
The R Project SVN
R