tests/testthat/test-clone.R
In r-lib/R6: Encapsulated Classes with Reference Semantics
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)
})
r-lib/R6 documentation built on Jan. 27, 2024, 12:44 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
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)
})
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.