tests/testthat/test-base-Singleton.R

In R6P: Design Patterns in R

# General -----------------------------------------------------------------
test_that("calling Singleton$new fails because it cannot be instantiated directly", {
    expect_error(Singleton$new())
})

# Implementation ----------------------------------------------------------
test_that("instantiating of multiple objects of the same Singleton are identical", {
    Counter <- R6::R6Class(classname = "Counter", inherit = Singleton, public = list(
        count = 0,
        add_1 = function(){self$count = self$count + 1; invisible(self)}
    ))

    expect_s3_class(counter_1 <- Counter$new(), "Singleton")
    expect_s3_class(counter_2 <- Counter$new(), "Counter")
    expect_identical(counter_1, counter_2)

    counter_1$add_1()
    expect_equal(counter_1$count, counter_2$count)
})

test_that("instantiating of multiple objects of the same Singleton with superclass", {
    SuperCounter <- R6::R6Class(classname = "SuperCounter", inherit = Singleton, public = list(
        count = 0,
        add_1 = function(){self$count = self$count + 1; invisible(self)},
        initialize = function(){super$initialize()}
    ))

    expect_s3_class(counter_1 <- SuperCounter$new(), "Singleton")
    expect_s3_class(counter_2 <- SuperCounter$new(), "SuperCounter")
    expect_identical(counter_1, counter_2)

    counter_1$add_1()
    expect_equal(counter_1$count, counter_2$count)
})

test_that("instantiating of multiple objects of the different Singleton are not identical", {
    SingletonA <- R6::R6Class(classname = "SingletonA", inherit = Singleton, public = list(uid = "A"))
    SingletonB <- R6::R6Class(classname = "SingletonB", inherit = Singleton, public = list(uid = "B"))

    expect_s3_class(singleton_A <- SingletonA$new(), "Singleton")
    expect_s3_class(singleton_B <- SingletonB$new(), "Singleton")
    expect_false(identical(singleton_A, singleton_B))
})

# test_that("inheriting Singleton takes the last class name", {
#     Level1Class <- R6::R6Class(classname = "Level1", inherit = Singleton, public = list(uid = "A"))
#     expect_s3_class(level1 <- Level1Class$new(), "Level1")
#
#     Level2Class <- R6::R6Class(classname = "Level2", inherit = Level1Class, public = list(uid = "A"))
#     expect_s3_class(level2 <- Level2Class$new(), "Level2")
#
#     expect_false(identical(level1, level2))
# })