1context("nonportable")
2
3test_that("initialization", {
4  AC <- R6Class("AC",
5    portable = FALSE,
6    public = list(
7      x = 1,
8      initialize = function(x, y) {
9        self$x <- getx() + x    # Assign to self; also access a method
10        private$y <- y          # Assign to private
11      },
12      getx = function() x,
13      gety = function() private$y
14    ),
15    private = list(
16      y = 2
17    )
18  )
19  A <- AC$new(2, 3)
20  expect_identical(A$x, 3)
21  expect_identical(A$gety(), 3)
22
23  # No initialize method: throw error if arguments are passed in
24  AC <- R6Class("AC", portable = FALSE, public = list(x = 1))
25  expect_error(AC$new(3))
26})
27
28test_that("empty members and methods are allowed", {
29  # No initialize method: throw error if arguments are passed in
30  AC <- R6Class("AC", portable = FALSE)
31  expect_no_error(AC$new())
32})
33
34
35test_that("Private members are private, and self/private environments", {
36  AC <- R6Class("AC",
37    portable = FALSE,
38    public = list(
39      x = 1,
40      gety = function() private$y,
41      gety2 = function() y,
42      getx = function() self$x,
43      getx2 = function() x,
44      getx3 = function() getx_priv3(),
45      getx4 = function() getx_priv4()
46    ),
47    private = list(
48      y = 2,
49      getx_priv3 = function() self$x,
50      getx_priv4 = function() x
51    )
52  )
53  A <- AC$new()
54
55  # Environment structure
56  expect_identical(A$self, A)
57  expect_identical(A$private, parent.env(A))
58
59  # Enclosing env for fublic and private methods is the public env
60  expect_identical(A, environment(A$getx))
61  expect_identical(A, environment(A$private$getx_priv3))
62
63  # Behavioral tests
64  expect_identical(A$x, 1)
65  expect_null(A$y)
66  expect_error(A$getx_priv3())
67  expect_identical(A$gety(), 2)  # Explicit access: private$y
68  expect_identical(A$gety2(), 2) # Implicit access: y
69  expect_identical(A$getx(), 1)  # Explicit access: self$x
70  expect_identical(A$getx2(), 1) # Implicit access: x
71  expect_identical(A$getx3(), 1) # Call private method, which has explicit: self$x
72  expect_identical(A$getx4(), 1) # Call private method, which has implicit: x
73})
74
75
76test_that("Active bindings work", {
77  AC <- R6Class("AC",
78    portable = FALSE,
79    public = list(
80      x = 5
81    ),
82    active = list(
83      x2 = function(value) {
84        if (missing(value)) return(x * 2)
85        else x <<- value/2
86      }
87    )
88  )
89  A <- AC$new()
90
91  expect_identical(A$x2, 10)
92  A$x <- 20
93  expect_identical(A$x2, 40)
94  A$x2 <- 60
95  expect_identical(A$x2, 60)
96  expect_identical(A$x, 30)
97})
98
99
100test_that("Locking objects", {
101  AC <- R6Class("AC",
102    portable = FALSE,
103    public = list(x = 1, getx = function() x),
104    private = list(y = 2, gety = function() y),
105    lock_objects = TRUE
106  )
107  A <- AC$new()
108
109  # Can modify fields
110  expect_no_error(A$x <- 5)
111  expect_identical(A$x, 5)
112  expect_no_error(A$private$y <- 5)
113  expect_identical(A$private$y, 5)
114
115  # Can't modify methods
116  expect_error(A$getx <- function() 1)
117  expect_error(A$gety <- function() 2)
118
119  # Can't add members
120  expect_error(A$z <- 1)
121  expect_error(A$private$z <- 1)
122
123
124  # Not locked
125  AC <- R6Class("AC",
126    portable = FALSE,
127    public = list(x = 1, getx = function() x),
128    private = list(y = 2, gety = function() y),
129    lock_objects = FALSE
130  )
131  A <- AC$new()
132
133  # Can modify fields
134  expect_no_error(A$x <- 5)
135  expect_identical(A$x, 5)
136  expect_no_error(A$private$y <- 5)
137  expect_identical(A$private$y, 5)
138
139  # Can't modify methods
140  expect_error(A$getx <- function() 1)
141  expect_error(A$private$gety <- function() 2)
142
143  # Can add members
144  expect_no_error(A$z <- 1)
145  expect_identical(A$z, 1)
146  expect_no_error(A$private$z <- 1)
147  expect_identical(A$private$z, 1)
148})
149
150
151test_that("Validity checks on creation", {
152  fun <- function() 1  # Dummy function for tests
153
154  # All arguments must be named
155  expect_error(R6Class("AC", public = list(1)))
156  expect_error(R6Class("AC", private = list(1)))
157  expect_error(R6Class("AC", active = list(fun)))
158
159  # Names can't be duplicated
160  expect_error(R6Class("AC", public = list(a=1, a=2)))
161  expect_error(R6Class("AC", public = list(a=1), private = list(a=1)))
162  expect_error(R6Class("AC", private = list(a=1), active = list(a=fun)))
163
164  # Reserved names
165  expect_error(R6Class("AC", public = list(self = 1)))
166  expect_error(R6Class("AC", private = list(private = 1)))
167  expect_error(R6Class("AC", active = list(super = 1)))
168
169  # `initialize` only allowed in public
170  expect_error(R6Class("AC", private = list(initialize = fun)))
171  expect_error(R6Class("AC", active = list(initialize = fun)))
172})
173
174
175test_that("default print method has a trailing newline", {
176  ## This is kind of hackish, because both capture.output and
177  ## expect_output drop the trailing newline. This function
178  ## does not work in the general case, but it is good enough
179  ## for this test.
180
181  expect_output_n <- function(object) {
182    tmp <- tempfile()
183    on.exit(unlink(tmp))
184    sink(tmp)
185    print(object)
186    sink(NULL)
187    output <- readChar(tmp, nchars = 10000)
188    last_char <- substr(output, nchar(output), nchar(output))
189    expect_identical(last_char, "\n")
190  }
191
192  AC <- R6Class("AC")
193  expect_output_n(print(AC))
194
195  A <- AC$new()
196  expect_output_n(print(A))
197
198  AC <- R6Class("AC", private = list( x = 2 ))
199  expect_output_n(print(AC))
200
201  A <- AC$new()
202  expect_output_n(print(A))
203})
204