tests/testthat/test-portable.R

In r-lib/R6: Encapsulated Classes with Reference Semantics

test_that("initialization", {
  AC <- R6Class("AC",
    portable = TRUE,
    public = list(
      x = 1,
      initialize = function(x, y) {
        self$x <- self$getx() + x    # Assign to self; also access a method
        private$y <- y          # Assign to private
      },
      getx = function() self$x,
      gety = function() private$y
    ),
    private = list(
      y = 2
    )
  )
  A <- AC$new(2, 3)
  expect_identical(A$x, 3)
  expect_identical(A$gety(), 3)

  # No initialize method: throw error if arguments are passed in
  AC <- R6Class("AC", portable = TRUE, public = list(x = 1))
  expect_error(AC$new(3))
})


test_that("empty members and methods are allowed", {
  # No initialize method: throw error if arguments are passed in
  AC <- R6Class("AC", portable = TRUE)
  expect_no_error(AC$new())
})


test_that("Private members are private, and self/private environments", {
  AC <- R6Class("AC",
    portable = TRUE,
    public = list(
      x = 1,
      gety = function() private$y,
      getx = function() self$x,
      getx2 = function() private$getx_priv(),
      getself = function() self,
      getprivate = function() private
    ),
    private = list(
      y = 2,
      getx_priv = function() self$x
    )
  )
  A <- AC$new()

  # Environment structure
  expect_identical(A$getself(), A)
  expect_identical(parent.env(A), emptyenv())

  # The private binding environment contains private fields
  private_bind_env <- A$getprivate()
  expect_identical(ls(private_bind_env), c("getx_priv", "y"))
  expect_identical(parent.env(private_bind_env), emptyenv())

  # Eval environment for public methods
  eval_env <- environment(A$getx)
  expect_identical(parent.env(eval_env), environment())
  expect_identical(eval_env$self, A)
  expect_identical(eval_env$private, A$getprivate())

  # Eval environment for private methods should be the same
  expect_identical(eval_env, environment(A$getprivate()$getx_priv))

  # Behavioral tests
  expect_identical(A$x, 1)
  expect_null(A$y)
  expect_null(A$getx_foo)
  expect_identical(A$gety(), 2)  # Explicit access: private$y
  expect_identical(A$getx(), 1)  # Explicit access: self$x
  expect_identical(A$getx2(), 1) # Indirect access: private$getx_priv()
})


test_that("Private methods exist even when no private fields", {
  AC <- R6Class("AC",
    portable = TRUE,
    public = list(
      x = 1,
      getx = function() self$x,
      getx2 = function() private$getx_priv(),
      getself = function() self,
      getprivate = function() private
    ),
    private = list(
      getx_priv = function() self$x
    )
  )
  A <- AC$new()

  # The private binding environment contains private fields
  private_bind_env <- A$getprivate()
  expect_identical(ls(private_bind_env), "getx_priv")
  expect_identical(parent.env(private_bind_env), emptyenv())
})


test_that("Active bindings work", {
  AC <- R6Class("AC",
    portable = TRUE,
    public = list(
      x = 5
    ),
    active = list(
      x2 = function(value) {
        if (missing(value)) return(self$x * 2)
        else self$x <- value/2
      },

      sqrt_of_x = function(value) {
        if (!missing(value))
          # In "setter" role
          stop("Sorry this is a read-only variable.")
        else {
          # In "getter" role
          if (self$x < 0) stop("The requested value is not available.")
          else sqrt(self$x)
        }

      }
    )
  )
  A <- AC$new()

  expect_identical(A$x2, 10)
  A$x <- 20
  expect_identical(A$x2, 40)
  A$x2 <- 60
  expect_identical(A$x2, 60)
  expect_identical(A$x, 30)

  A$x <- -2
  expect_error(A$sqrt_of_x)
  # print does not throw an error trying to read
  # the active binding variables
  muted_print <- function(x) capture.output(print(x))
  expect_no_error(muted_print(A))
})


test_that("Locking works", {
  AC <- R6Class("AC",
    portable = FALSE,
    public = list(x = 1, getx = function() self$x),
    private = list(y = 2, gety = function() self$y),
    lock_objects = TRUE
  )
  A <- AC$new()

  # Can modify fields
  expect_no_error(A$x <- 5)
  expect_identical(A$x, 5)
  expect_no_error(A$private$y <- 5)
  expect_identical(A$private$y, 5)

  # Can't modify methods
  expect_error(A$getx <- function() 1)
  expect_error(A$gety <- function() 2)

  # Can't add members
  expect_error(A$z <- 1)
  expect_error(A$private$z <- 1)


  # Not locked
  AC <- R6Class("AC",
    portable = FALSE,
    public = list(x = 1, getx = function() x),
    private = list(y = 2, gety = function() y),
    lock_objects = FALSE
  )
  A <- AC$new()

  # Can modify fields
  expect_no_error(A$x <- 5)
  expect_identical(A$x, 5)
  expect_no_error(A$private$y <- 5)
  expect_identical(A$private$y, 5)

  # Can't modify methods
  expect_error(A$getx <- function() 1)
  expect_error(A$private$gety <- function() 2)

  # Can add members
  expect_no_error(A$z <- 1)
  expect_identical(A$z, 1)
  expect_no_error(A$private$z <- 1)
  expect_identical(A$private$z, 1)
})