test_that("Can't use reserved name 'clone'", { expect_error(R6Class("AC", public = list(clone = function() NULL))) expect_error(R6Class("AC", private = list(clone = function() NULL))) expect_error(R6Class("AC", active = list(clone = function() NULL))) }) test_that("Can disable cloning", { AC <- R6Class("AC", public = list(x = 1), cloneable = FALSE) a <- AC$new() expect_null(a$clone) }) test_that("Cloning portable objects with public only", { parenv <- new.env() AC <- R6Class("AC", portable = TRUE, public = list( x = 1, getx = function() self$x ), parent_env = parenv ) # Behavioral tests a <- AC$new() b <- a$clone() b$x <- 2 expect_identical(a$getx(), 1) expect_identical(b$getx(), 2) # Enclosing environment for methods a_enclos_env <- environment(a$getx) b_enclos_env <- environment(b$getx) # self points to the object (public binding env) expect_identical(a_enclos_env$self, a) expect_identical(b_enclos_env$self, b) # Parent of enclosing env should be class's parent_env expect_identical(parent.env(a_enclos_env), parenv) expect_identical(parent.env(b_enclos_env), parenv) # Enclosing env only contains self expect_identical(ls(a_enclos_env), "self") expect_identical(ls(b_enclos_env), "self") # Parent of binding env is emptyenv(), for portable classes expect_identical(parent.env(a), emptyenv()) expect_identical(parent.env(b), emptyenv()) # Cloning a clone c <- b$clone() expect_identical(c$getx(), 2) c$x <- 3 expect_identical(c$getx(), 3) }) test_that("Cloning non-portable objects with public only", { parenv <- new.env() AC <- R6Class("AC", portable = FALSE, public = list( x = 1, getx = function() self$x ), parent_env = parenv ) # Behavioral tests a <- AC$new() b <- a$clone() b$x <- 2 expect_identical(a$getx(), 1) expect_identical(b$getx(), 2) # Enclosing environment for methods a_enclos_env <- environment(a$getx) b_enclos_env <- environment(b$getx) # Enclosing env is identical to public binding env expect_identical(a_enclos_env, a) expect_identical(b_enclos_env, b) # self points back to the object (public binding env) expect_identical(a$self, a) expect_identical(b$self, b) # Parent of enclosing env should be class's parent_env expect_identical(parent.env(a_enclos_env), parenv) expect_identical(parent.env(b_enclos_env), parenv) # Contains correct objects expect_identical(ls(a), c("clone", "getx", "self", "x")) expect_identical(ls(b), c("clone", "getx", "self", "x")) }) test_that("Cloning portable objects with public and private", { parenv <- new.env() AC <- R6Class("AC", portable = TRUE, public = list( x = 1, getx = function() self$x, getprivate = function() private, sety = function(value) private$y <- value ), private = list( y = 1, gety = function() private$y ), parent_env = parenv ) # Behavioral tests a <- AC$new() b <- a$clone() b$x <- 2 b$sety(2) expect_identical(a$getx(), 1) expect_identical(a$getprivate()$gety(), 1) expect_identical(b$getx(), 2) expect_identical(b$getprivate()$gety(), 2) # Enclosing environment for methods a_enclos_env <- environment(a$getx) b_enclos_env <- environment(b$getx) # Enclosing environment for private methods is same expect_identical(a_enclos_env, environment(a$getprivate()$gety)) expect_identical(b_enclos_env, environment(b$getprivate()$gety)) # self points to the object (public binding env) expect_identical(a_enclos_env$self, a) expect_identical(b_enclos_env$self, b) # Parent of enclosing env should be class's parent_env expect_identical(parent.env(a_enclos_env), parenv) expect_identical(parent.env(b_enclos_env), parenv) # Parent of public binding env is emptyenv(), for portable classes expect_identical(parent.env(a), emptyenv()) expect_identical(parent.env(b), emptyenv()) # Parent of private binding env is emptyenv(), for portable classes expect_identical(parent.env(a$getprivate()), emptyenv()) expect_identical(parent.env(b$getprivate()), emptyenv()) # Enclosing env only contains self and private expect_identical(ls(a_enclos_env), c("private", "self")) expect_identical(ls(b_enclos_env), c("private", "self")) # public binding env contains just the public members expect_identical(ls(a), c("clone", "getprivate", "getx", "sety", "x")) expect_identical(ls(b), c("clone", "getprivate", "getx", "sety", "x")) # private binding env contains just the private members expect_identical(ls(a$getprivate()), c("gety", "y")) expect_identical(ls(b$getprivate()), c("gety", "y")) }) test_that("Cloning non-portable objects with public and private", { parenv <- new.env() AC <- R6Class("AC", portable = FALSE, public = list( x = 1, getx = function() self$x, getprivate = function() private, sety = function(value) private$y <- value ), private = list( y = 1, gety = function() private$y ), parent_env = parenv ) # Behavioral tests a <- AC$new() b <- a$clone() b$x <- 2 b$sety(2) expect_identical(a$getx(), 1) expect_identical(a$getprivate()$gety(), 1) expect_identical(b$getx(), 2) expect_identical(b$getprivate()$gety(), 2) # Enclosing environment for methods a_enclos_env <- environment(a$getx) b_enclos_env <- environment(b$getx) # Enclosing env is identical to public binding env expect_identical(a_enclos_env, a) expect_identical(b_enclos_env, b) # Enclosing environment for private methods is same expect_identical(a_enclos_env, environment(a$getprivate()$gety)) expect_identical(b_enclos_env, environment(b$getprivate()$gety)) # self points to the object (public binding env) expect_identical(a_enclos_env$self, a) expect_identical(b_enclos_env$self, b) # Parent of enclosing env should be private env expect_identical(parent.env(a), a$getprivate()) expect_identical(parent.env(b), b$getprivate()) # Parent of private env should be class's parent_env expect_identical(parent.env(a$getprivate()), parenv) expect_identical(parent.env(b$getprivate()), parenv) # Public binding env (AKA enclosing env) contains self, private, and members expect_identical(ls(a), c("clone", "getprivate", "getx", "private", "self", "sety", "x")) expect_identical(ls(b), c("clone", "getprivate", "getx", "private", "self", "sety", "x")) # private binding env contains just the private members expect_identical(ls(a$getprivate()), c("gety", "y")) expect_identical(ls(b$getprivate()), c("gety", "y")) }) test_that("Cloning subclasses with inherited private fields", { # For issue #72 AC <- R6Class("AC", public = list( getx = function() private$x ), private = list( x = 1 ) ) BC <- R6Class("BC", inherit = AC, public = list( getx = function() super$getx() ) ) b1 <- BC$new() b2 <- b1$clone() expect_identical(b1$getx(), 1) expect_identical(b2$getx(), 1) }) test_that("Cloning active bindings", { AC <- R6Class("AC", public = list( x = 1 ), active = list( x2 = function(value) { if (missing(value)) self$x * 2 else self$x <- value / 2 } ) ) a <- AC$new() b <- a$clone() a$x <- 10 expect_identical(a$x2, 20) a$x2 <- 22 expect_identical(a$x, 11) expect_identical(b$x2, 2) b$x <- 2 expect_identical(b$x2, 4) b$x2 <- 10 expect_identical(b$x, 5) }) test_that("Cloning active binding in superclass", { AC <- R6Class("AC", public = list( x = 1 ), active = list( x2 = function(value){ if (missing(value)) self$x * 2 else self$x <- value / 2 } ) ) BC <- R6Class("BC", inherit = AC, active = list( x2 = function(value){ if (missing(value)) super$x2 * 2 else super$x2 <- value / 2 } ) ) a <- AC$new() a$x <- 10 expect_identical(a$x2, 20) a$x2 <- 22 expect_identical(a$x, 11) b <- BC$new() b$x <- 10 expect_identical(b$x2, 40) b$x <- 11 expect_identical(b$x2, 44) b1 <- b$clone() expect_identical(b1$x2, 44) b1$x <- 12 expect_identical(b1$x2, 48) }) test_that("Cloning active binding in two levels of inheritance", { # For issue #119 A <- R6Class("A", public = list( methodA = function() "A" ), active = list( x = function() "x" ) ) B <- R6Class("B", inherit = A, public = list( methodB = function() { super$methodA() } ) ) C <- R6Class("C", inherit = B, public = list( methodC = function() { super$methodB() } ) ) C1 <- C$new() C2 <- C1$clone() expect_identical(C2$methodC(), "A") expect_identical( C1$.__enclos_env__$super$.__enclos_env__, environment(C1$.__enclos_env__$super$methodB) ) }) test_that("Active bindings are not touched during cloning", { AC <- R6Class("AC", public = list( x = 1 ), active = list( inc = function() { self$x <- self$x + 1 self$x } ) ) a <- AC$new() b <- a$clone() expect_identical(a$x, 1) expect_identical(b$x, 1) }) test_that("Lock state", { AC <- R6Class("AC", public = list( x = 1, yval = function(y) { if (missing(y)) private$y else private$y <- y } ), private = list(w = 1), lock_objects = TRUE ) a <- AC$new() b <- a$clone() expect_error(a$z <- 1) expect_error(b$z <- 1) expect_identical(a$yval(), NULL) expect_identical(b$yval(), NULL) expect_error(a$yval(1)) expect_error(b$yval(1)) # With lock = FALSE AC <- R6Class("AC", public = list( x = 1, yval = function(y) { if (missing(y)) private$y else private$y <- y } ), private = list(w = 1), lock_objects = FALSE ) a <- AC$new() b <- a$clone() a$y <- 1 b$y <- 1 expect_identical(a$y, 1) expect_identical(b$y, 1) expect_identical(a$yval(), NULL) expect_identical(b$yval(), NULL) a$yval(1) b$yval(1) expect_identical(a$yval(), 1) expect_identical(b$yval(), 1) }) test_that("Cloning and inheritance of parent env", { # ========================== # Portable # ========================== A <- local({ y <- 1 R6Class("A", public = list( x = 1, getx = function() self$x, gety = function() y ) ) }) # Check the environments of the original class a <- A$new() expect_identical(a$.__enclos_env__, environment(a$getx)) expect_identical(a, a$.__enclos_env__$self) a2 <- a$clone() expect_identical(a2$.__enclos_env__, environment(a2$getx)) expect_identical(a2, a2$.__enclos_env__$self) expect_false(identical(a, a2)) B <- local({ y <- 2 R6Class("B", inherit = A, public = list( getx_super = function() super$getx(), gety_super = function() super$gety() ) ) }) b <- B$new() expect_false(exists("super", envir = environment(b$getx))) expect_false(identical(b$.__enclos_env__, environment(b$getx))) expect_true(exists("y", envir = parent.env(environment(b$getx)))) # If the method is inherited, the super (of the object, not the method) method # should be the same as the inherited method expect_identical(b$.__enclos_env__$super$getx, b$getx) expect_identical(b, environment(b$getx)$self) # Inherited method expect_identical(b$getx(), 1) # Method which calls super expect_identical(b$getx_super(), 1) expect_identical(b$gety(), 1) expect_identical(b$gety_super(), 1) b2 <- b$clone() expect_false(exists("super", envir = environment(b2$getx))) expect_false(identical(b2$.__enclos_env__, environment(b2$getx))) expect_true(exists("y", envir = parent.env(environment(b2$getx)))) # If the method is inherited, the super (of the object, not the method) method # should be the same as the inherited method expect_identical(b2$.__enclos_env__$super$getx, b2$getx) expect_identical(b2, environment(b2$getx)$self) expect_identical(b2$getx(), 1) expect_identical(b2$getx_super(), 1) expect_identical(b$gety(), 1) expect_identical(b$gety_super(), 1) b2$x <- 3 expect_identical(b2$getx(), 3) expect_identical(b2$getx_super(), 3) C <- local({ y <- 3 R6Class("C", inherit = B, public = list( getx_super = function() super$getx(), gety_super = function() super$gety() ) ) }) c <- C$new() expect_false(exists("super", envir = environment(c$getx))) expect_false(identical(c$.__enclos_env__, environment(b$getx))) expect_true(exists("y", envir = parent.env(environment(c$getx)))) # If the method is inherited, the super (of the object, not the method) method # should be the same as the inherited method expect_identical(c$.__enclos_env__$super$getx, c$getx) expect_identical(c, environment(c$getx)$self) # Inherited method expect_identical(c$getx(), 1) # Method which calls super expect_identical(c$getx_super(), 1) expect_identical(c$gety(), 1) expect_identical(c$gety_super(), 1) c2 <- c$clone() expect_false(exists("super", envir = environment(c2$getx))) expect_false(identical(c2$.__enclos_env__, environment(c2$getx))) expect_true(exists("y", envir = parent.env(environment(c2$getx)))) # If the method is inherited, the super (of the object, not the method) method # should be the same as the inherited method expect_identical(c2$.__enclos_env__$super$getx, c2$getx) expect_identical(c2, environment(c2$getx)$self) expect_identical(c2$getx(), 1) expect_identical(c2$getx_super(), 1) expect_identical(c$gety(), 1) expect_identical(c$gety_super(), 1) # ========================== # Non-portable # ========================== A <- local({ y <- 1 R6Class("A", portable = FALSE, public = list( x = 1, getx = function() x, gety = function() y ) ) }) # Check the environments of the original class a <- A$new() expect_identical(a, environment(a$getx)) expect_identical(a, a$.__enclos_env__) a2 <- a$clone() expect_identical(a, environment(a$getx)) expect_identical(a, a$.__enclos_env__) expect_false(identical(a, a2)) B <- local({ y <- 2 R6Class("B", portable = FALSE, inherit = A, public = list( getx_super = function() super$getx(), gety_super = function() super$gety() ) ) }) b <- B$new() expect_identical(b, parent.env(environment(b$getx))) expect_identical(b, b$.__enclos_env__) # The parent of the enclosing env of a super method should be the object # itself. expect_identical(parent.env(environment(b$super$getx)), b) # Inherited method expect_identical(b$getx(), 1) # Method which calls super expect_identical(b$getx_super(), 1) # Because portable=F, the inherited method gets the subclass's environment. expect_identical(b$gety(), 2) expect_identical(b$gety_super(), 2) b2 <- b$clone() expect_identical(b2, parent.env(environment(b2$getx))) expect_identical(b2, b2$.__enclos_env__) expect_identical(parent.env(environment(b2$super$getx)), b2) expect_identical(b2$getx(), 1) expect_identical(b2$getx_super(), 1) expect_identical(b2$gety(), 2) expect_identical(b2$gety_super(), 2) # The original and the clone have the same parent env expect_identical(parent.env(b), parent.env(b2)) b2$x <- 3 expect_identical(b2$getx(), 3) expect_identical(b2$getx_super(), 3) b3 <- b2$clone() expect_identical(b3$getx(), 3) expect_identical(b3$getx_super(), 3) expect_identical(b3$gety(), 2) expect_identical(b3$gety_super(), 2) C <- local({ y <- 3 R6Class("C", portable = FALSE, inherit = B, public = list( getx_super = function() super$getx(), gety_super = function() super$gety() ) ) }) c <- C$new() expect_identical(c, parent.env(environment(c$getx))) expect_identical(c, c$.__enclos_env__) # The parent of the enclosing env of a super method should be the object # itself. expect_identical(parent.env(environment(c$super$getx)), c) # Inherited method expect_identical(c$getx(), 1) # Method which calls super expect_identical(c$getx_super(), 1) # Because portable=F, the inherited method gets the subclass's environment. expect_identical(c$gety(), 3) expect_identical(c$gety_super(), 3) c2 <- c$clone() expect_identical(c2, parent.env(environment(c2$getx))) expect_identical(c2, c2$.__enclos_env__) expect_identical(parent.env(environment(c2$super$getx)), c2) expect_identical(c2$getx(), 1) expect_identical(c2$getx_super(), 1) expect_identical(c2$gety(), 3) expect_identical(c2$gety_super(), 3) # The original and the clone have the same parent env expect_identical(parent.env(c), parent.env(c2)) }) test_that("Cloning inherited methods for portable classes", { # This set of tests makes sure that inherited methods refer to the correct # self, private, and super. They also test multiple levels of inheritance. # Base class C1 <- R6Class("C1", public = list( x = 1, addx = function() self$x + 100, p_addx = function() private$addx_() ), private = list( addx_ = function() self$x + 100 ), active = list( a_addx = function(val) self$x + 100 ) ) # ==== Inherited methods ==== C2_inherit <- R6Class("C2_inherit", inherit = C1, public = list( x = 2 ) ) a <- C2_inherit$new() b <- a$clone() expect_identical(a$addx(), 102) expect_identical(a$p_addx(), 102) expect_identical(a$a_addx, 102) expect_identical(a$addx(), b$addx()) expect_identical(a$p_addx(), b$p_addx()) expect_identical(a$a_addx, b$a_addx) b$x <- 3 expect_identical(b$addx(), 103) expect_identical(b$p_addx(), 103) expect_identical(b$a_addx, 103) # Make sure a was unaffected expect_identical(a$x, 2) # ==== Overridden methods ==== C2_override <- R6Class("C2_override", inherit = C1, public = list( x = 2, addx = function() super$addx() + self$x + 1000 ), private = list( addx_ = function() super$addx_() + self$x + 1000 ), active = list( a_addx = function(val) super$a_addx + self$x + 1000 ) ) a <- C2_override$new() b <- a$clone() expect_identical(a$addx(), 1104) expect_identical(a$p_addx(), 1104) expect_identical(a$a_addx, 1104) expect_identical(a$addx(), b$addx()) expect_identical(a$p_addx(), b$p_addx()) expect_identical(a$a_addx, b$a_addx) b$x <- 3 expect_identical(b$addx(), 1106) expect_identical(b$p_addx(), 1106) expect_identical(b$a_addx, 1106) # Make sure a was unaffected expect_identical(a$x, 2) # =========================================================================== # Sub-sub-classes: # Need to check sequences of: # inherit-inherit, inherit-override, override-inherit, and override-override # ==== Inherit-inherit methods ==== C3_inherit_inherit <- R6Class("C3_inherit_inherit", inherit = C2_inherit, public = list( x = 3 ) ) a <- C3_inherit_inherit$new() b <- a$clone() expect_identical(a$addx(), 103) expect_identical(a$p_addx(), 103) expect_identical(a$a_addx, 103) expect_identical(a$addx(), b$addx()) expect_identical(a$p_addx(), b$p_addx()) expect_identical(a$a_addx, b$a_addx) b$x <- 4 expect_identical(b$addx(), 104) expect_identical(b$p_addx(), 104) expect_identical(b$a_addx, 104) # Make sure a was unaffected expect_identical(a$x, 3) # ==== Inherit-override methods ==== C3_inherit_override <- R6Class("C3_inherit_override", inherit = C2_inherit, public = list( x = 3, addx = function() super$addx() + self$x + 10000 ), private = list( addx_ = function() super$addx_() + self$x + 10000 ), active = list( a_addx = function(val) super$a_addx + self$x + 10000 ) ) a <- C3_inherit_override$new() b <- a$clone() expect_identical(a$addx(), 10106) expect_identical(a$p_addx(), 10106) expect_identical(a$a_addx, 10106) expect_identical(a$addx(), b$addx()) expect_identical(a$p_addx(), b$p_addx()) expect_identical(a$a_addx, b$a_addx) b$x <- 4 expect_identical(b$addx(), 10108) expect_identical(b$p_addx(), 10108) expect_identical(b$a_addx, 10108) # Make sure a was unaffected expect_identical(a$x, 3) # ==== Override-override methods ==== C3_override_override <- R6Class("C3_override_override", inherit = C2_override, public = list( x = 3, addx = function() super$addx() + self$x + 10000 ), private = list( addx_ = function() super$addx_() + self$x + 10000 ), active = list( a_addx = function(val) super$a_addx + self$x + 10000 ) ) a <- C3_override_override$new() b <- a$clone() expect_identical(a$addx(), 11109) expect_identical(a$p_addx(), 11109) expect_identical(a$a_addx, 11109) expect_identical(a$addx(), b$addx()) expect_identical(a$p_addx(), b$p_addx()) expect_identical(a$a_addx, b$a_addx) b$x <- 4 expect_identical(b$addx(), 11112) expect_identical(b$p_addx(), 11112) expect_identical(b$a_addx, 11112) # Make sure a was unaffected expect_identical(a$x, 3) # ==== Override-inherit methods ==== C3_override_inherit <- R6Class("C3_override_inherit", inherit = C2_override, public = list( x = 3 ) ) a <- C3_override_inherit$new() b <- a$clone() expect_identical(a$addx(), 1106) expect_identical(a$p_addx(), 1106) expect_identical(a$a_addx, 1106) expect_identical(a$addx(), b$addx()) expect_identical(a$p_addx(), b$p_addx()) expect_identical(a$a_addx, b$a_addx) b$x <- 4 expect_identical(b$addx(), 1108) expect_identical(b$p_addx(), 1108) expect_identical(b$a_addx, 1108) # Make sure a was unaffected expect_identical(a$x, 3) }) test_that("Cloning inherited methods for non-portable classes", { # This set of tests makes sure that inherited methods refer to the correct # self, private, and super. They also test multiple levels of inheritance. # Base class C1 <- R6Class("C1", portable = FALSE, public = list( x = 1, addx = function() x + 100, p_addx = function() addx_() ), private = list( addx_ = function() x + 100 ), active = list( a_addx = function(val) x + 100 ) ) # ==== Inherited methods ==== C2_inherit <- R6Class("C2_inherit", inherit = C1, portable = FALSE, public = list( x = 2 ) ) a <- C2_inherit$new() b <- a$clone() expect_identical(a$addx(), 102) expect_identical(a$p_addx(), 102) expect_identical(a$a_addx, 102) expect_identical(a$addx(), b$addx()) expect_identical(a$p_addx(), b$p_addx()) expect_identical(a$a_addx, b$a_addx) b$x <- 3 expect_identical(b$addx(), 103) expect_identical(b$p_addx(), 103) expect_identical(b$a_addx, 103) # Make sure a was unaffected expect_identical(a$x, 2) # ==== Overridden methods ==== C2_override <- R6Class("C2_override", portable = FALSE, inherit = C1, public = list( x = 2, addx = function() super$addx() + x + 1000 ), private = list( addx_ = function() super$addx_() + x + 1000 ), active = list( a_addx = function(val) super$a_addx + x + 1000 ) ) a <- C2_override$new() b <- a$clone() expect_identical(a$addx(), 1104) expect_identical(a$p_addx(), 1104) expect_identical(a$a_addx, 1104) expect_identical(a$addx(), b$addx()) expect_identical(a$p_addx(), b$p_addx()) expect_identical(a$a_addx, b$a_addx) b$x <- 3 expect_identical(b$addx(), 1106) expect_identical(b$p_addx(), 1106) expect_identical(b$a_addx, 1106) # Make sure a was unaffected expect_identical(a$x, 2) # =========================================================================== # Sub-sub-classes: # Need to check sequences of: # inherit-inherit, inherit-override, override-inherit, and override-override # ==== Inherit-inherit methods ==== C3_inherit_inherit <- R6Class("C3_inherit_inherit", portable = FALSE, inherit = C2_inherit, public = list( x = 3 ) ) a <- C3_inherit_inherit$new() b <- a$clone() expect_identical(a$addx(), 103) expect_identical(a$p_addx(), 103) expect_identical(a$a_addx, 103) expect_identical(a$addx(), b$addx()) expect_identical(a$p_addx(), b$p_addx()) expect_identical(a$a_addx, b$a_addx) b$x <- 4 expect_identical(b$addx(), 104) expect_identical(b$p_addx(), 104) expect_identical(b$a_addx, 104) # Make sure a was unaffected expect_identical(a$x, 3) # ==== Inherit-override methods ==== C3_inherit_override <- R6Class("C3_inherit_override", portable = FALSE, inherit = C2_inherit, public = list( x = 3, addx = function() super$addx() + x + 10000 ), private = list( addx_ = function() super$addx_() + x + 10000 ), active = list( a_addx = function(val) super$a_addx + x + 10000 ) ) a <- C3_inherit_override$new() b <- a$clone() expect_identical(a$addx(), 10106) expect_identical(a$p_addx(), 10106) expect_identical(a$a_addx, 10106) expect_identical(a$addx(), b$addx()) expect_identical(a$p_addx(), b$p_addx()) expect_identical(a$a_addx, b$a_addx) b$x <- 4 expect_identical(b$addx(), 10108) expect_identical(b$p_addx(), 10108) expect_identical(b$a_addx, 10108) # Make sure a was unaffected expect_identical(a$x, 3) # ==== Override-override methods ==== C3_override_override <- R6Class("C3_override_override", portable = FALSE, inherit = C2_override, public = list( x = 3, addx = function() super$addx() + x + 10000 ), private = list( addx_ = function() super$addx_() + x + 10000 ), active = list( a_addx = function(val) super$a_addx + x + 10000 ) ) a <- C3_override_override$new() b <- a$clone() expect_identical(a$addx(), 11109) expect_identical(a$p_addx(), 11109) expect_identical(a$a_addx, 11109) expect_identical(a$addx(), b$addx()) expect_identical(a$p_addx(), b$p_addx()) expect_identical(a$a_addx, b$a_addx) b$x <- 4 expect_identical(b$addx(), 11112) expect_identical(b$p_addx(), 11112) expect_identical(b$a_addx, 11112) # Make sure a was unaffected expect_identical(a$x, 3) # ==== Override-inherit methods ==== C3_override_inherit <- R6Class("C3_override_inherit", portable = FALSE, inherit = C2_override, public = list( x = 3 ) ) a <- C3_override_inherit$new() b <- a$clone() expect_identical(a$addx(), 1106) expect_identical(a$p_addx(), 1106) expect_identical(a$a_addx, 1106) expect_identical(a$addx(), b$addx()) expect_identical(a$p_addx(), b$p_addx()) expect_identical(a$a_addx, b$a_addx) b$x <- 4 expect_identical(b$addx(), 1108) expect_identical(b$p_addx(), 1108) expect_identical(b$a_addx, 1108) # Make sure a was unaffected expect_identical(a$x, 3) }) test_that("In deep_clone(), don't try to clone non-R6 objects", { `$.test` <- function(x, value) { stop("error") } AC <- R6Class("AC", public = list( x = NULL, initialize = function() { x <- new.env(parent = emptyenv()) class(x) <- "test" self$x <- x } ) ) obj <- AC$new() obj2 <- obj$clone(deep = TRUE) expect_identical(obj$x, obj2$x) }) test_that("Deep cloning", { AC <- R6Class("AC", public = list(x = 1)) BC <- R6Class("BC", public = list( x = NULL, y = function() private$y_, initialize = function() { self$x <- AC$new() private$y_ <- AC$new() } ), private = list( y_ = NULL ) ) b <- BC$new() b2 <- b$clone(deep = FALSE) expect_identical(b$x, b2$x) expect_identical(b$y(), b2$y()) b <- BC$new() b2 <- b$clone(deep = TRUE) expect_false(identical(b$x, b2$x)) expect_false(identical(b$y(), b2$y())) # Make sure b2$x and b2$y are properly cloned R6 objects expect_identical(class(b2$x), c("AC", "R6")) expect_identical(class(b2$y()), c("AC", "R6")) # Deep cloning with multiple levels CC <- R6Class("CC", public = list( x = NULL, initialize = function() { self$x <- BC$new() } ) ) c <- CC$new() c2 <- c$clone(deep = TRUE) expect_false(identical(c$x, c2$x)) expect_false(identical(c$x$x, c2$x$x)) # Make sure c2$x and c2$x$x are properly cloned R6 objects expect_identical(class(c2$x), c("BC", "R6")) expect_identical(class(c2$x$x), c("AC", "R6")) # Deep cloning with custom function AC <- R6Class("AC", public = list(x = 1)) BC <- R6Class("BC", public = list( x = "AC", y = "AC", z = "AC", initialize = function() { self$x <- AC$new() self$y <- AC$new() self$z <- AC$new() } ), private = list( deep_clone = function(name, val) { if (name %in% c("x", "y")) val$clone() else val } ) ) a <- BC$new() b <- a$clone() c <- a$clone(deep = TRUE) a$x$x <- 2 a$y$x <- 3 a$z$x <- 4 # b is shallow clone expect_identical(a$x$x, b$x$x) expect_identical(a$y$x, b$y$x) expect_identical(a$z$x, b$z$x) # c has deep clones of x and y, but not z expect_identical(c$x$x, 1) expect_identical(c$y$x, 1) expect_identical(a$z$x, c$z$x) }) test_that("Deep cloning non-portable classes", { # Make sure deep cloning doesn't lead to infinite loop because of `self` AC <- R6Class("AC", portable = FALSE, public = list(x = 1)) a <- AC$new() a$x <- 2 a2 <- a$clone(deep = TRUE) expect_identical(a2$x, 2) expect_identical(a2$self, a2) }) test_that("Cloning with functions that are not methods", { x <- 0 local_x1 <- local({ x <- 1 function() x }) AC <- R6Class("AC", public = list( f = NULL, method = function() 100 ) ) a <- AC$new() a$f <- local_x1 expect_identical(a$f(), 1) a2 <- a$clone() expect_identical(a2$f(), 1) # Clone of a clone a3 <- a$clone() expect_identical(a3$f(), 1) # Make sure that in clones, methods are locked, and non-methods are not # locked. expect_no_error(a$f <- identity) expect_no_error(a2$f <- identity) expect_no_error(a3$f <- identity) expect_error(a$method <- identity) expect_error(a2$method <- identity) expect_error(a3$method <- identity) # ==== With inheritance ==== local_x2 <- local({ x <- 2 function() x }) BC <- R6Class("BC", inherit = AC, public = list( g = NULL ) ) b <- BC$new() b$f <- local_x1 b$g <- local_x2 expect_identical(b$f(), 1) expect_identical(b$g(), 2) b2 <- b$clone() expect_identical(b2$f(), 1) expect_identical(b2$g(), 2) b3 <- b$clone() expect_identical(b3$f(), 1) expect_identical(b3$g(), 2) }) test_that("Finalizers are run on cloned objects", { sum <- 0 C1 <- R6Class("C1", public = list( x = 1, finalize = function() sum <<- sum + self$x ) ) a <- C1$new() b <- a$clone() b$x <- 10 rm(b) gc() expect_identical(sum, 10) rm(a) gc() expect_identical(sum, 11) # With inherited finalize method sum <- 0 C2 <- R6Class("C2", inherit = C1) a <- C2$new() b <- a$clone() b$x <- 10 rm(b) gc() expect_identical(sum, 10) rm(a) gc() expect_identical(sum, 11) # With overridden finalize method sum <- 0 C3 <- R6Class("C3", inherit = C1, public = list( finalize = function() sum <<- sum + 2*self$x ) ) a <- C3$new() b <- a$clone() b$x <- 10 rm(b) gc() expect_identical(sum, 20) rm(a) gc() expect_identical(sum, 22) # With overridden finalize method which calls super$finalize sum <- 0 C4 <- R6Class("C4", inherit = C1, public = list( finalize = function() { super$finalize() sum <<- sum + 2*self$x } ) ) a <- C4$new() b <- a$clone() b$x <- 10 rm(b) gc() expect_identical(sum, 30) rm(a) gc() expect_identical(sum, 33) }) # Same tests as previous block, but with private finalizers test_that("Finalizers (private) are run on cloned objects", { sum <- 0 C1 <- R6Class("C1", public = list( x = 1 ), private = list( finalize = function() sum <<- sum + self$x ) ) a <- C1$new() b <- a$clone() b$x <- 10 rm(b) gc() expect_identical(sum, 10) rm(a) gc() expect_identical(sum, 11) # With inherited finalize method sum <- 0 C2 <- R6Class("C2", inherit = C1) a <- C2$new() b <- a$clone() b$x <- 10 rm(b) gc() expect_identical(sum, 10) rm(a) gc() expect_identical(sum, 11) # With overridden finalize method sum <- 0 C3 <- R6Class("C3", inherit = C1, private = list( finalize = function() sum <<- sum + 2*self$x ) ) a <- C3$new() b <- a$clone() b$x <- 10 rm(b) gc() expect_identical(sum, 20) rm(a) gc() expect_identical(sum, 22) # With overridden finalize method which calls super$finalize sum <- 0 C4 <- R6Class("C4", inherit = C1, private = list( finalize = function() { super$finalize() sum <<- sum + 2*self$x } ) ) a <- C4$new() b <- a$clone() b$x <- 10 rm(b) gc() expect_identical(sum, 30) rm(a) gc() expect_identical(sum, 33) })