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