tests/testthat/test-s4-unload.R

In pkgload: Simulate Package Installation and Attach

local_load_all_quiet()

# Returns a named vector of this class's superclasses.
# Results are sorted so they can be compared easily to a vector.
# A contains B  ==  A is a superclass of B
get_superclasses <- function(class) {
  superclasses <- vapply(getClass(class)@contains, methods::slot, "superClass",
    FUN.VALUE = character(1))

  sort(unname(superclasses))
}

# Returns a named vector of this class's subclasses
# Results are sorted so they can be compared easily to a vector.
# A extends B  ==  A is a subclass of B
get_subclasses <- function(class) {
  subclasses <- vapply(getClass(class)@subclasses, methods::slot, "subClass",
    FUN.VALUE = character(1))

  sort(unname(subclasses))
}


test_that("loading and reloading s4 classes", {
  run_tests <- function() {
    # Check class hierarchy
    expect_equal(get_superclasses("A"), c("AB", "AOrNull", "mle2A", "mleA"))
    expect_equal(get_subclasses("AB"), c("A", "B"))
    expect_equal(get_superclasses("mle2"), c("mle", "mle2A", "mleA"))
    expect_equal(get_subclasses("mleA"), c("A", "mle", "mle2"))
    expect_equal(get_subclasses("mle2A"), c("A", "mle2"))
    expect_equal(get_subclasses("AOrNull"), c(".NULL", "A", "NULL"))
    expect_equal(get_subclasses("BOrNull"), c(".NULL", "B", "NULL"))

    # Check that package is registered correctly
    expect_equal(getClassDef("A")@package, "testS4union")
    expect_equal(getClassDef("AB")@package, "testS4union")
    expect_equal(getClassDef("mle2")@package, "testS4union")
    expect_equal(getClassDef("AOrNull")@package, "testS4union")
    expect_equal(getClassDef("BOrNull")@package, "testS4union")

    # Unloading shouldn't result in any errors or warnings
    expect_warning(unload("testS4union"), NA)

    # Check that classes are unregistered
    expect_true(is.null(getClassDef("A")))
    expect_true(is.null(getClassDef("B")))
    expect_true(is.null(getClassDef("AB")))
    expect_true(is.null(getClassDef("AorNULL")))
    expect_true(is.null(getClassDef("BorNULL")))
  }

  load_all("testS4union")
  run_tests()

  # Load again and repeat tests --------------------------------------------
  load_all("testS4union")

  run_tests()

  # Install package then load and run tests
  withr::with_temp_libpaths({
    install.packages("testS4union", repos = NULL, type = "source", quiet = TRUE)
    library("testS4union")
    load_all("testS4union")
    run_tests()
  })

  # Loading again shouldn't result in any errors or warnings
  expect_warning(load_all("testS4union", reset = FALSE), NA)

  unload("testS4union")
  unloadNamespace("stats4")   # This was imported by testS4union

  # Check that classes are unregistered
  # This test on A fails for some bizarre reason - bug in R? But it doesn't
  # to cause any practical problems.
  expect_true(is.null(getClassDef("A")))
  expect_true(is.null(getClassDef("B")))
  expect_true(is.null(getClassDef("AB")))
})