tests/testthat/test-DC-inheritance.R

In wahani/aoos: Another Object Orientation System

context("Inheritance:")

test_that("Inheritance", {
  
  suppressWarnings({
    parent <- defineClass("parent", {
      publicMember <- publicValue("?!:")
      privateMember <- private(NULL)
      get <- publicFunction(function() paste(publicMember(), privateMember))
    })
    
    child <- defineClass("child", contains = "parent", {
      set <- publicFunction(function(value) {
        privateMember <<- value
        invisible(privateMember)
      })
    })
  })
  
  tmp <- child()
  expect_equal(tmp$publicMember(), "?!:")
  expect_error(tmp$privateMember) # don't know how to implement that
  expect_equal(tmp$get(), "?!: ")
  expect_equal(tmp$set("s"), "s")
  expect_equal(tmp$get(), "?!: s")
  
})

test_that("Replacing fields I", {
  
  suppressWarnings({
    parent <- defineClass("parent", {
      privateMember <- private(NULL)
      get <- publicFunction(function() privateMember)
    })
    
    child <- defineClass("child", contains = "parent", {
      privateMember <- private("value")
    })  
  })
    
  tmp <- child()
  expect_equal(tmp$get()@.Data, "value")
  
})

test_that("Replacing fields II", {
  
  suppressWarnings({
    parent <- defineClass("parent", {
      get <- function() foo()
      foo <- function() 1
    })
    
    child <- defineClass("child", contains = "parent", {
      foo <- function() 2
    })
  })
    
  tmp <- child()
  expect_equal(tmp$foo(), 2)
  expect_equal(tmp$get(), 2)
  
})

test_that("Inheritance of standard S4 classes", {
  
  setClass("Parent", contains = "VIRTUAL")
  
  setGeneric("testMethod", function(x) "default")
  setMethod("testMethod", signature = "Parent", function(x) 1)
  
  suppressWarnings({
    
    child1 <- defineClass("Child1", contains = "Parent", {
      get <- function() foo()
      foo <- function() 1
    })
    
    child2 <- defineClass("Child2", contains = "Child1", { })
    
  })
  
  tmp1 <- child1()
  tmp2 <- child2()
  
  expect_equal(testMethod(tmp1), 1)
  expect_equal(testMethod(tmp2), 1)
  
})