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_no_warning(unload("testS4union")) # Check that classes are unregistered expect_null(getClassDef("A")) expect_null(getClassDef("B")) expect_null(getClassDef("AB")) expect_null(getClassDef("AorNULL")) expect_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_no_warning(load_all("testS4union")) 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_null(getClassDef("A")) expect_null(getClassDef("B")) expect_null(getClassDef("AB")) })