The R Project SVN R

Rev

Rev 52846 | Rev 52903 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
52846 jmc 1 
options(error = recover)
52816 jmc 2 
setRefClass("foo", list(bar = "numeric", flag = "character"),
3 
            fieldPrototypes = list(flag = "standard flag"),
4 
            classMethods = list(
5 
            addToBar = function(incr) {
6 
                b = getBar() + incr
7 
                setBar(b)
8 
                b
9 
            }
10 
            ))
11 
ff = new("foo", bar = 1.5)
12 
stopifnot(identical(ff$bar, 1.5))
13 
ff$bar <- pi
14 
stopifnot(identical(ff$bar, pi))
15 
 
16 
stopifnot(identical(ff$flag, "standard flag"))
17 
 
18 
ff$setBar(1:3)
19 
stopifnot(identical(ff$bar, 1:3))
20 
 
21 
ff$getBar()
22 
stopifnot(all.equal(ff$addToBar(1), 2:4))
23 
 
52846 jmc 24 
## inheritance.  redefines flag so should fail:
25 
try(setRefClass("foo2", list(b2 = "numeric", flag = "complex"),
52816 jmc 26 
            contains = "foo",
27 
            classMethods = list(addBoth = function(incr) {
28 
                addToBar(incr) #uses inherited class method
29 
                setB2(getB2() + incr)
52846 jmc 30 
                })))
31 
## but with flag as a subclass of "character", should work
52871 jmc 32 
setClass("ratedChar", contains = "character", representation(score = "numeric"))
33 
setRefClass("foo2", list(b2 = "numeric", flag = "ratedChar"),
52846 jmc 34 
            contains = "foo",
35 
            classMethods = list(addBoth = function(incr) {
36 
                addToBar(incr) #uses inherited class method
37 
                setB2(getB2() + incr)
52816 jmc 38 
                }))
52871 jmc 39 
f2 <- new("foo2", bar = -3, flag = as("ANY", "ratedChar"), b2 = ff$bar)
52846 jmc 40 
f2$export("foo")
52871 jmc 41 
stopifnot(identical(f2$flag,  as("ANY", "ratedChar")), identical(f2$bar, -3),
52816 jmc 42 
          all.equal(f2$b2, 2:4+0))
43 
f2$addBoth(-1)
44 
stopifnot(all.equal(f2$bar, -4), all.equal(f2$b2, 1:3+0))
45 
 
46 
setRefClass("foo3", contains = "foo2",
47 
            classMethods = list(addBoth = function(incr) {
52846 jmc 48 
                callSuper(incr)
52871 jmc 49 
                setFlag(as(paste(getFlag(), paste(incr, collapse = ", "), sep = "; "), "ratedChar"))
52816 jmc 50 
                incr
51 
            }))
52 
 
52846 jmc 53 
f3 <- new("foo3")
54 
f3$import(f2)
55 
stopifnot(all.equal(f3$b2, f2$b2), all.equal(f3$bar, f2$bar), all.equal(f3$flag, f2$flag))
52871 jmc 56 
f3$addBoth(1)
57 
stopifnot(all.equal(f3$bar, -3), all.equal(f3$b2, 2:4+0),
58 
          all.equal(f3$flag, as("ANY; 1", "ratedChar")))
59