1context("nonportable-inheritance")
2
3test_that("Inheritance", {
4  AC <- R6Class("AC",
5    portable = FALSE,
6    public = list(
7      x = 0,
8      z = 0,
9      initialize = function(x) self$x <- x,
10      getx = function() x,
11      getx2 = function() x*2
12    ),
13    private = list(
14      getz = function() z,
15      getz2 = function() z*2
16    ),
17    active = list(
18      x2 = function(value) {
19        if (missing(value)) return(x * 2)
20        else x <<- value/2
21      },
22      x3 = function(value) {
23        if (missing(value)) return(x * 3)
24        else x <<- value/3
25      }
26    )
27  )
28  BC <- R6Class("BC",
29    portable = FALSE,
30    inherit = AC,
31    public = list(
32      y = 0,
33      z = 3,
34      initialize = function(x, y) {
35        super$initialize(x)
36        self$y <- y
37      },
38      getx = function() x + 10
39    ),
40    private = list(
41      getz = function() z + 10
42    ),
43    active = list(
44      x2 = function(value) {
45        if (missing(value)) return(x + 2)
46        else x <<- value-2
47      }
48    )
49  )
50  B <- BC$new(1, 2)
51
52  # Environment checks
53  expect_identical(B, environment(B$getx))                      # Overridden public method
54  expect_identical(B, parent.env(environment(B$getx2)))         # Inherited public method
55  expect_identical(B, environment(B$private$getz))              # Overridden private method
56  expect_identical(B, parent.env(environment(B$private$getz2))) # Inherited private method
57
58  # Behavioral tests
59  # Overriding literals
60  expect_identical(B$x, 1)
61  expect_identical(B$y, 2)
62  expect_identical(B$z, 3) # Subclass value overrides superclass value
63  # Methods
64  expect_identical(B$getx(), 11)          # Overridden public method
65  expect_identical(B$getx2(), 2)          # Inherited public method
66  expect_identical(B$private$getz(), 13)  # Overriden private method
67  expect_identical(B$private$getz2(), 6)  # Inherited private method
68
69  # Active bindings
70  expect_identical(B$x2, 3) # Overridden
71  expect_identical(B$x3, 3) # Inherited
72
73  # Classes
74  expect_identical(class(B), c("BC", "AC", "R6"))
75})
76
77
78test_that("Inheritance: superclass methods", {
79  AC <- R6Class("AC",
80    portable = FALSE,
81    public = list(
82      x = 0,
83      initialize = function() {
84        inc_x()
85        inc_self_x()
86        inc_y()
87        inc_self_y()
88        incz
89      },
90      inc_x = function() x <<- x + 1,
91      inc_self_x = function() self$x <- self$x + 10,
92      inc = function(val) val + 1,
93      pinc = function(val) priv_inc(val), # Call private inc method
94      z = 0
95    ),
96    private = list(
97      y = 0,
98      inc_y = function() y <<- y + 1,
99      inc_self_y = function() private$y <- private$y + 10,
100      priv_inc = function(val) val + 1
101    ),
102    active = list(
103      incz = function(value) {
104        z <<- z + 1
105      }
106    )
107  )
108  BC <- R6Class("BC",
109    portable = FALSE,
110    inherit = AC,
111    public = list(
112      inc_x = function() x <<- x + 2,
113      inc_self_x = function() self$x <- self$x + 20,
114      inc = function(val) super$inc(val) + 20
115    ),
116    private = list(
117      inc_y = function() y <<- y + 2,
118      inc_self_y = function() private$y <- private$y + 20,
119      priv_inc = function(val) super$priv_inc(val) + 20
120    ),
121    active = list(
122      incz = function(value) {
123        z <<- z + 2
124      }
125    )
126  )
127  B <- BC$new()
128
129  # Environment checks
130  expect_identical(parent.env(B$super), emptyenv())
131  # Enclosing env for functions in $super is a child of $self
132  expect_identical(parent.env(environment(B$super$inc_x)), B)
133
134  # Testing overrides
135  expect_identical(B$x, 22)          # Public
136  expect_identical(B$private$y, 22)  # Private
137  expect_identical(B$z, 2)           # Active
138  # Calling superclass methods
139  expect_identical(B$inc(0), 21)
140  expect_identical(B$pinc(0), 21)
141
142
143  # Multi-level inheritance
144  CC <- R6Class("CC",
145    portable = FALSE,
146    inherit = BC,
147    public = list(
148      inc_x = function() x <<- x + 3,
149      inc_self_x = function() self$x <- self$x + 30,
150      inc = function(val) super$inc(val) + 300
151    ),
152    private = list(
153      inc_y = function() y <<- y + 3,
154      inc_self_y = function() private$y <- private$y + 30,
155      priv_inc = function(val) super$priv_inc(val) + 300
156    ),
157    active = list(
158      incz = function(value) {
159        z <<- z + 3
160      }
161    )
162  )
163  C <- CC$new()
164
165  # Testing overrides
166  expect_identical(C$x, 33)          # Public
167  expect_identical(C$private$y, 33)  # Private
168  expect_identical(C$z, 3)           # Active
169  # Calling superclass methods (two levels)
170  expect_identical(C$inc(0), 321)
171  expect_identical(C$pinc(0), 321)
172
173  # Classes
174  expect_identical(class(C), c("CC", "BC", "AC", "R6"))
175})
176
177
178test_that("Inheritance hierarchy for super$ methods", {
179  AC <- R6Class("AC",
180    portable = FALSE,
181    public = list(n = function() 0 + 1)
182  )
183  expect_identical(AC$new()$n(), 1)
184
185  BC <- R6Class("BC",
186    portable = FALSE,
187    public = list(n = function() super$n() + 10),
188    inherit = AC
189  )
190  expect_identical(BC$new()$n(), 11)
191
192  CC <- R6Class("CC",
193    portable = FALSE,
194    inherit = BC
195  )
196  # This should equal 11 because it inherits BC's n(), which adds 1 to AC's n()
197  expect_identical(CC$new()$n(), 11)
198
199  # Skipping one level of inheritance ---------------------------------
200  AC <- R6Class("AC",
201    portable = FALSE,
202    public = list(n = function() 0 + 1)
203  )
204  expect_identical(AC$new()$n(), 1)
205
206  BC <- R6Class("BC",
207    portable = FALSE,
208    inherit = AC
209  )
210  expect_identical(BC$new()$n(), 1)
211
212  CC <- R6Class("CC",
213    portable = FALSE,
214    public = list(n = function() super$n() + 100),
215    inherit = BC
216  )
217  # This should equal 101 because BC inherits AC's n()
218  expect_identical(CC$new()$n(), 101)
219
220  DC <- R6Class("DC",
221    portable = FALSE,
222    inherit = CC
223  )
224  # This should equal 101 because DC inherits CC's n(), and BC inherits AC's n()
225  expect_identical(DC$new()$n(), 101)
226
227  # Skipping two level of inheritance ---------------------------------
228  AC <- R6Class("AC",
229    portable = FALSE,
230    public = list(n = function() 0 + 1)
231  )
232  expect_identical(AC$new()$n(), 1)
233
234  BC <- R6Class("BC", portable = FALSE, inherit = AC)
235  expect_identical(BC$new()$n(), 1)
236
237  CC <- R6Class("CC", portable = FALSE, inherit = BC)
238  expect_identical(CC$new()$n(), 1)
239})
240
241
242test_that("Private env is created when all private members are inherited", {
243  # Private contains fields only
244  AC <- R6Class("AC",
245    portable = FALSE,
246    public = list(
247      getx = function() x,
248      getx2 = function() private$x
249    ),
250    private = list(x = 1)
251  )
252  BC <- R6Class("BC", portable = FALSE, inherit = AC)
253  expect_identical(BC$new()$getx(), 1)
254  expect_identical(BC$new()$getx2(), 1)
255
256  # Private contains functions only
257  AC <- R6Class("AC",
258    portable = FALSE,
259    public = list(
260      getx = function() x(),
261      getx2 = function() private$x()
262    ),
263    private = list(x = function() 1)
264  )
265  BC <- R6Class("BC", portable = FALSE, inherit = AC)
266  expect_identical(BC$new()$getx(), 1)
267  expect_identical(BC$new()$getx2(), 1)
268})
269