Implement clone()

NAMESPACE

@@ -1,5 +1,6 @@
-# Generated by roxygen2 (4.1.0): do not edit by hand
+# Generated by roxygen2 (4.1.1): do not edit by hand
 
 S3method(print,R6)
 S3method(print,R6ClassGenerator)
 export(R6Class)
+export(clone)

R/clone.R

@@ -1,17 +1,14 @@
-# TODO:
-# * X Test portable and non-portable
-# * Figure out how to pass in old_enclos_env. Ideally we would call clone(self).
-#     May need to store enclos in an attribute?
-# * Don't try to clone non-R6 objects
-# * Superclass
-# * Need better encapsulation strategy
-# * Copy locked status - copy all attributes?
-# * Be more careful about reassigning function envs - only if matches enclos_env?
-#     But this is problematic for inherited functions
-# * Be careful about copying reference objects
-
+#' Clone an R6 object
+#'
+#' @param obj An R6 object to clone.
+#'
 #' @export
-clone <- encapsulate(function(old_enclos_env = parent.env(parent.frame())) {
+clone <- encapsulate(function(obj) {
+  old_enclos_env <- attr(obj, "enclos_env", TRUE)
+
+  if (!is.environment(old_enclos_env)) {
+    stop("`obj` must be an R6 object.")
+  }
 
   old_public_bind_env <- old_enclos_env$self
   old_private_bind_env <- old_enclos_env$private
@@ -40,22 +37,49 @@ clone <- encapsulate(function(old_enclos_env = parent.env(parent.frame())) {
 
   # Copy the old objects, fix up method environments, and put them into the
   # new binding environment.
-  copies <- as.list.environment(old_public_bind_env)
-  copies <- assign_func_envs(copies, new_enclos_env)
-  list2env2(copies, public_bind_env)
+  public_copies <- as.list.environment(old_public_bind_env)
+  public_copies <- assign_func_envs(public_copies, new_enclos_env)
+  list2env2(public_copies, public_bind_env)
+
+  if (has_private) {
+    private_copies <- as.list.environment(old_private_bind_env)
+    private_copies <- assign_func_envs(private_copies, new_enclos_env)
+    list2env2(private_copies, private_bind_env)
+  }
 
+  # Lock --------------------------------------------------------------
+  # Copy locked state of environment
+  if (environmentIsLocked(old_public_bind_env)) {
+    lockEnvironment(public_bind_env)
+  }
+  if (has_private && environmentIsLocked(old_private_bind_env)) {
+    lockEnvironment(private_bind_env)
+  }
+
+  # Always lock methods
+  # We inspect the names in public_copies instead public_bind_env, because
+  # ls() is so slow for environments. R 3.2.0 introduced the sorted=FALSE
+  # option, which makes ls() much faster, so at some point we'll be able to
+  # switch to that.
+  for (name in names(public_copies)) {
+    if (is.function(public_bind_env[[name]]))
+      lockBinding(name, public_bind_env)
+  }
   if (has_private) {
-    copies <- as.list.environment(old_private_bind_env)
-    copies <- assign_func_envs(copies, new_enclos_env)
-    list2env2(copies, private_bind_env)
+    for (name in names(private_copies)) {
+      if (is.function(private_bind_env[[name]]))
+        lockBinding(name, private_bind_env)
+    }
   }
 
-  # Add self and (optional) private pointer
+  # Add self and (optional) private pointer ---------------------------
   new_enclos_env$self <- public_bind_env
   if (has_private)
     new_enclos_env$private <- private_bind_env
 
   class(public_bind_env) <- class(old_public_bind_env)
+
+  attr(public_bind_env, "enclos_env") <- new_enclos_env
   public_bind_env
 })
 

R/new.R

@@ -138,6 +138,9 @@ generator_funs$new <- function(...) {
 
   class(public_bind_env) <- classes
 
+  # Add refs to other environments in the object --------------------
+  attr(public_bind_env, "enclos_env") <- enclos_env
+
   # Initialize ------------------------------------------------------
   if (is.function(public_bind_env$initialize)) {
     public_bind_env$initialize(...)

man/R6Class.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.1.0): do not edit by hand
+% Generated by roxygen2 (4.1.1): do not edit by hand
 % Please edit documentation in R/r6_class.R
 \name{R6Class}
 \alias{R6}

tests/testthat/test-clone.R

@@ -7,7 +7,7 @@ test_that("Cloning portable objects with public only", {
     public = list(
       x = 1,
       getx = function() self$x,
-      clone = function() R6::clone()
+      clone = function() clone(self)
     ),
     parent_env = parenv
   )
@@ -38,6 +38,12 @@ test_that("Cloning portable objects with public only", {
   # 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)
 })
 
 
@@ -48,7 +54,7 @@ test_that("Cloning non-portable objects with public only", {
     public = list(
       x = 1,
       getx = function() self$x,
-      clone = function() R6::clone()
+      clone = function() R6::clone(self)
     ),
     parent_env = parenv
   )
@@ -91,7 +97,7 @@ test_that("Cloning portable objects with public and private", {
       getx = function() self$x,
       getprivate = function() private,
       sety = function(value) private$y <- value,
-      clone = function() R6::clone()
+      clone = function() clone(self)
     ),
     private = list(
       y = 1,
@@ -152,7 +158,7 @@ test_that("Cloning non-portable objects with public and private", {
       getx = function() self$x,
       getprivate = function() private,
       sety = function(value) private$y <- value,
-      clone = function() R6::clone()
+      clone = function() R6::clone(self)
     ),
     private = list(
       y = 1,
@@ -202,3 +208,54 @@ test_that("Cloning non-portable objects with public and private", {
   expect_identical(ls(b$getprivate()), c("gety", "y"))
 })
 
+
+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 = TRUE
+  )
+
+  a <- AC$new()
+  b <- clone(a)
+  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 = FALSE
+  )
+
+  a <- AC$new()
+  b <- clone(a)
+  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)
+})