| setClass("maybe") |
| |
| setClass("A", representation(x = "numeric")) |
| |
| setIs("A", "maybe", |
| test = function(object)length(object@x) >= 1 && object@x[[1]] > 0, |
| coerce = function(from)from, |
| replace = function(from, value) |
| stop("meaningless to replace the \"maybe\" part of an object")) |
| |
| aa <- new("A", x=1) |
| |
| setGeneric("ff", function(x)"default ff") |
| ## test that the setGeneric() call created the generic & default |
| stopifnot(is(ff, "standardGeneric"), |
| identical(body(getMethod("ff","ANY")), "default ff")) |
| |
| ffMaybe <- function(x) "ff maybe method" |
| setMethod("ff", "maybe", ffMaybe) |
| |
| aa2 <- new("A", x = -1) # condition not TRUE |
| stopifnot(identical(ff(aa), "default ff"), |
| identical(ff(aa2), "default ff"))# failed in R 2.11.0 |
| |
| ## a method to test the condition |
| setMethod("ff", "A", |
| function(x) { |
| if(is(x, "maybe")) |
| ffMaybe(x) |
| else |
| callNextMethod() |
| }) |
| stopifnot(identical(ff(aa), "ff maybe method"), |
| identical(ff(aa2), "default ff")) |
| |
| removeClass("A") |
| removeClass("maybe") |
| removeGeneric("ff") |
