The R Project SVN R

Rev

Rev 57183 | Rev 57604 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 57183 Rev 57589
Line 15... Line 15...
15 
                      b <- bar + incr
 15 
                      b <- bar + incr
16 
                      bar <<- b
 16 
                      bar <<- b
17 
                      b
 17 
                      b
18 
                  } )
 18 
                  } )
19 
                  )
 19 
                  )
- 
 
 20 
fg$lock("flag")
- 
 
 21 
stopifnot(identical(fg$lock(), "flag"))
- 
 
 22 
 
20 
ff <- new("foo", bar = 1.5)
 23 
ff <- new("foo", bar = 1.5)
21 
stopifnot(identical(ff$bar, 1.5))
 24 
stopifnot(identical(ff$bar, 1.5))
22 
ff$bar <- pi
 25 
ff$bar <- pi
23 
stopifnot(identical(ff$bar, pi))
 26 
stopifnot(identical(ff$bar, pi))
- 
 
 27 
## flag has not yet been set
- 
 
 28 
ff$flag <- "flag test"
- 
 
 29 
stopifnot(identical(ff$flag, "flag test"))
- 
 
 30 
## but no second assign
- 
 
 31 
stopifnot(is(tryCatch(ff$flag <- "new", error = function(e)e), "error"))
- 
 
 32 
 
24 
## test against generator
 33 
## test against generator
25 
 
 34 
 
26 
f2 <- fg$new(bar = pi)
 35 
f2 <- fg$new(bar = pi, flag = "flag test")
27 
## identical does not return TRUE if *contents* of env are identical
 36 
## identical does not return TRUE if *contents* of env are identical
28 
stopifnot(identical(ff$bar, f2$bar), identical(ff$flag, f2$flag))
 37 
stopifnot(identical(ff$bar, f2$bar), identical(ff$flag, f2$flag))
29 
 
 - 
 
30 
f2$flag <- "standard flag"
 38 
## but flag was now assigned once
31 
stopifnot(identical(f2$flag, "standard flag"))
 39 
stopifnot(is(tryCatch(f2$flag <- "new", error = function(e)e), "error"))
32 
 
 40 
 
33 
str(f2)
 41 
str(f2)
34 
 
 42 
 
35 
## fg$lock("flag")
 - 
 
36 
## tryCatch(f2$flag <- "other", error = function(e)e)
 - 
 
37 
 
 - 
 
38 
 
 43 
 
39 
## add some accessor methods
 44 
## add some accessor methods
40 
fg$accessors("bar")
 45 
fg$accessors("bar")
41 
 
 46 
 
42 
ff$setBar(1:3)
 47 
ff$setBar(1:3)
Line 126... Line 131...
126 
         error = function(e)e), "error"))
 131 
         error = function(e)e), "error"))
127 
str(f3)
 132 
str(f3)
128 
 
 133 
 
129 
## similar to $import() but using superclass object in the $new() call
 134 
## similar to $import() but using superclass object in the $new() call
130 
## The explicitly supplied flag= should override and be allowed
 135 
## The explicitly supplied flag= should override and be allowed
131 
## by the default $initialize()
136 
## by the default $initialize()
132 
f3b <- foo3$new(f2, flag = as("Other", "ratedChar"),
 137 
f3b <- foo3$new(f2, flag = as("Other", "ratedChar"),
133 
                flag2 = as("More", "ratedChar"))
 138 
                flag2 = as("More", "ratedChar"))
134 
## check that inherited and direct field assignments worked
 139 
## check that inherited and direct field assignments worked
135 
stopifnot(identical(f3b$tag, f2$tag),
 140 
stopifnot(identical(f3b$tag, f2$tag),
136 
          identical(f3b$flag, as("Other", "ratedChar")),
 141 
          identical(f3b$flag, as("Other", "ratedChar")),
137 
          identical(f3b$flag2, as("More", "ratedChar")))
 142 
          identical(f3b$flag2, as("More", "ratedChar")))
138 
 
 143 
 
139 
## a class with an initialize method, and an extra slot
 144 
## a class with an initialize method, and an extra slot (legal, not a good idea)
140 
setOldClass(c("simple.list", "list"))
 145 
setOldClass(c("simple.list", "list"))
141 
fg4 <- setRefClass("foo4",
 146 
fg4 <- setRefClass("foo4",
142 
            contains = "foo2",
 147 
            contains = "foo2",
143 
            methods = list(
 148 
            methods = list(
144 
              initialize = function(...) {
 149 
              initialize = function(...) {
Line 147... Line 152...
147 
                  .self
 152 
                  .self
148 
              }),
 153 
              }),
149 
            representation = list(made = "simple.list")
 154 
            representation = list(made = "simple.list")
150 
            )
 155 
            )
151 
 
 156 
 
152 
f4 <- new("foo4", flag = "another test", bar = 1:3)
 157 
f4 <- new("foo4", flag = as("another test", "ratedChar"), bar = 1:3)
153 
stopifnot(identical(f4@made, R.version))
 158 
stopifnot(identical(f4@made, R.version))
154 
 
 159 
 
155 
## a trivial class with no fields, using fields = list(), failed up to rev 56035
 160 
## a trivial class with no fields, using fields = list(), failed up to rev 56035
156 
foo5 <- setRefClass("foo5", fields = list(),
 161 
foo5 <- setRefClass("foo5", fields = list(),
157 
                    methods = list(bar = function(test)
 162 
                    methods = list(bar = function(test)