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