The R Project SVN R

Rev

Rev 58137 | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
52031 jmc 1 
setClass("maybe")
2 
 
3 
setClass("A", representation(x = "numeric"))
4 
 
52110 maechler 5 
setIs("A", "maybe",
6 
      test = function(object)length(object@x) >= 1 && object@x[[1]] > 0,
52031 jmc 7 
      coerce = function(from)from,
52110 maechler 8 
      replace = function(from, value)
9 
      stop("meaningless to replace the \"maybe\" part of an object"))
52031 jmc 10 
 
52110 maechler 11 
aa <- new("A", x=1)
52031 jmc 12 
 
58136 jmc 13 
setGeneric("ff", function(x)"default ff")
14 
## test that the setGeneric() call created the generic & default
15 
stopifnot(is(ff, "standardGeneric"),
16 
          identical(body(getMethod("ff","ANY")), "default ff"))
52031 jmc 17 
 
18 
ffMaybe <- function(x) "ff maybe method"
19 
setMethod("ff", "maybe", ffMaybe)
20 
 
21 
aa2 <- new("A", x = -1) # condition not TRUE
52110 maechler 22 
stopifnot(identical(ff(aa),  "default ff"),
23 
	  identical(ff(aa2), "default ff"))# failed in R 2.11.0
52031 jmc 24 
 
25 
## a method to test the condition
26 
setMethod("ff", "A",
52110 maechler 27 
	  function(x) {
28 
	      if(is(x, "maybe"))
29 
		  ffMaybe(x)
30 
	      else
31 
		  callNextMethod()
32 
	  })
58138 jmc 33 
stopifnot(identical(ff(aa), "ff maybe method"),
34 
          identical(ff(aa2), "default ff"))
52031 jmc 35 
 
36 
removeClass("A")
37 
removeClass("maybe")
38 
removeGeneric("ff")