Merge pull request #267 from IndrajeetPatil/247_cloning_inheritance_2

NEWS.md

@@ -5,6 +5,8 @@ R6 2.5.1.9000
 
 * `R6Class()` now prints a message when a `finalize` method is public instead of private.
 
+* When a superclass is not cloneable, then subclasses cannot be cloneable (@IndrajeetPatil, #247).
+
 R6 2.5.1
 ========
 

R/new.R

@@ -103,6 +103,20 @@ generator_funs$new <- function(...) {
     public_methods  <- merge_vectors(super_struct$public_methods, public_methods)
     private_methods <- merge_vectors(super_struct$private_methods, private_methods)
     active          <- merge_vectors(super_struct$active, active)
+
+    # If `cloneable` property differs between sub and superclass
+    # - super will override sub if super doesn't allow cloning
+    # - sub will override super if super allows cloning
+    if (!identical(cloneable, inherit$cloneable)) {
+      public_methods[["clone"]] <- NULL
+
+      if (!inherit$cloneable) {
+        message(
+          "Superclass ", inherit$classname, " has cloneable=FALSE, but subclass ", classname, " has cloneable=TRUE. ",
+          "A subclass cannot be cloneable when its superclass is not cloneable, so cloning will be disabled for ", classname, "."
+        )
+      }
+    }
   }
 
   # Copy objects to public bind environment -------------------------

tests/testthat/test-cloning-inheritance.R

@@ -0,0 +1,30 @@
+test_that("Subclass can override superclass' cloneable property", {
+  # superclass cloneable ---------------------
+
+  Creature <- R6Class("Creature", cloneable = TRUE)
+
+  Sheep <- R6Class("Sheep", inherit = Creature, cloneable = TRUE)
+  expect_message(sheep <- Sheep$new(), NA)
+  expect_s3_class(sheep$clone(), "Sheep")
+  expect_true("clone" %in% names(Creature$public_methods))
+
+  Human <- R6Class("Human", inherit = Creature, cloneable = FALSE)
+  expect_message(human <- Human$new(), NA)
+  expect_error(human$clone(), "attempt to apply non-function")
+  expect_true("clone" %in% names(Creature$public_methods))
+
+  # superclass non-cloneable  ---------------------
+
+  Creature <- R6Class("Creature", cloneable = FALSE)
+
+  Sheep <- R6Class("Sheep", inherit = Creature, cloneable = TRUE)
+  expect_message(sheep <- Sheep$new(), "Superclass Creature has cloneable=FALSE, but subclass Sheep has cloneable=TRUE.")
+  expect_error(sheep$clone(), "attempt to apply non-function")
+  # Make sure that the superclass wasn't inadvertantly modified.
+  expect_false("clone" %in% names(Creature$public_methods))
+
+  Human <- R6Class("Human", inherit = Creature, cloneable = FALSE)
+  expect_message(human <- Human$new(), NA)
+  expect_error(human$clone(), "attempt to apply non-function")
+  expect_false("clone" %in% names(Creature$public_methods))
+})