diff --git a/NEWS.md b/NEWS.md index 9d74804..9ccfaa5 100644 --- a/NEWS.md +++ b/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 ======== diff --git a/R/new.R b/R/new.R index cd23adc..4c58921 100644 --- a/R/new.R +++ b/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 ------------------------- diff --git a/tests/testthat/test-cloning-inheritance.R b/tests/testthat/test-cloning-inheritance.R new file mode 100644 index 0000000..11e7b60 --- /dev/null +++ b/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)) +})