tests/testthat/test-S4-generics.R

In wahani/aoos: Another Object Orientation System

context("S4 generic wrappers")
test_that("Polymorphic classes", {
  
  Poly <- function() {
    generic(x) %g% x
    generic(x ~ numeric) %m% { x + 1 }
    retList("Poly")
  }
  
  PolyChild <- function() {
    .super <- Poly()
    .super$generic(x ~ numeric) %m% { x + 2 }
    .super$generic(x ~ character) %m% { paste(x, "1") }
    retList("PolyChild", super = .super)
  }
  
  poly <- Poly()
  
  expect_equal(poly$generic(2), 3) # numeric-method
  expect_equal(poly$generic("a"), "a") # default
  
  polyChild <- PolyChild()
  
  expect_equal(polyChild$generic(1), 3) # overridden
  expect_equal(polyChild$generic("a"), "a 1") # added
  expect_equal(polyChild$generic(raw(1)), raw(1)) # default
  
})

test_that("generics and methods", {
  
  # standard
  generic(x) %g% { x + 1 }
  expect_equal(generic(1), 2)
  
  # with default
  generic(x = 2) %g% { x + 1 }
  expect_equal(generic(), 3)
  
  # a method
  generic(x ~ character) %m% { x }
  expect_equal(generic(), 3)
  expect_equal(generic(""), "")
  
  # things with ... and stuff
  generic(x, ...) %g% standardGeneric("generic")
  generic(x ~ numeric, y = 1, z = 2, a) %m% { x + y + z + a }
  expect_equal(generic(1, a = 2), 6)
  
  generic(x ~ character, b = "b") %m% paste0(x, b)
  expect_equal(generic("a"), "ab")
  expect_equal(generic("", 2), "2")
  
  # return class
  character : generic(x) %g% x
  expect_error(generic(1))
  expect_equal(generic(""), "")
  
  # quoted names
  "character" : 'generic'(x) %g% x
  expect_error(generic(1))
  expect_equal(generic(""), "")
  
  'generic'(x ~ numeric) %m% as.character(x)
  expect_equal(generic(1), "1")
  
  # args in terms of args
  someGeneric(x, ...) %g% standardGeneric("someGeneric")
  someGeneric(x, y = length(x), ...) %m% { list(x, y) }
  expect_equal(someGeneric(1:10)[[2]], 10)
  
  # class unions
  'character | numeric' : generic(x) %g% standardGeneric("generic")
  generic(x ~ character|  numeric) %m% x
  expect_equal(generic(1), 1)
  expect_equal(generic(""), "")
  generic(x ~ list) %m% x
  expect_error(generic(list()))
  
})