1context("s4-unload") 2 3# Returns a named vector of this class's superclasses. 4# Results are sorted so they can be compared easily to a vector. 5# A contains B == A is a superclass of B 6get_superclasses <- function(class) { 7 superclasses <- vapply(getClass(class)@contains, slot, "superClass", 8 FUN.VALUE = character(1)) 9 10 sort(unname(superclasses)) 11} 12 13# Returns a named vector of this class's subclasses 14# Results are sorted so they can be compared easily to a vector. 15# A extends B == A is a subclass of B 16get_subclasses <- function(class) { 17 subclasses <- vapply(getClass(class)@subclasses, slot, "subClass", 18 FUN.VALUE = character(1)) 19 20 sort(unname(subclasses)) 21} 22 23 24test_that("loading and reloading s4 classes", { 25 run_tests <- function() { 26 # Check class hierarchy 27 expect_equal(get_superclasses("A"), c("AB", "AOrNull", "mle2A", "mleA")) 28 expect_equal(get_subclasses("AB"), c("A", "B")) 29 expect_equal(get_superclasses("mle2"), c("mle", "mle2A", "mleA")) 30 expect_equal(get_subclasses("mleA"), c("A", "mle", "mle2")) 31 expect_equal(get_subclasses("mle2A"), c("A", "mle2")) 32 expect_equal(get_subclasses("AOrNull"), c(".NULL", "A", "NULL")) 33 expect_equal(get_subclasses("BOrNull"), c(".NULL", "B", "NULL")) 34 35 # Check that package is registered correctly 36 expect_equal(getClassDef("A")@package, "testS4union") 37 expect_equal(getClassDef("AB")@package, "testS4union") 38 expect_equal(getClassDef("mle2")@package, "testS4union") 39 expect_equal(getClassDef("AOrNull")@package, "testS4union") 40 expect_equal(getClassDef("BOrNull")@package, "testS4union") 41 42 # Unloading shouldn't result in any errors or warnings 43 expect_warning(unload("testS4union"), NA) 44 45 # Check that classes are unregistered 46 expect_true(is.null(getClassDef("A"))) 47 expect_true(is.null(getClassDef("B"))) 48 expect_true(is.null(getClassDef("AB"))) 49 expect_true(is.null(getClassDef("AorNULL"))) 50 expect_true(is.null(getClassDef("BorNULL"))) 51 } 52 53 load_all("testS4union") 54 run_tests() 55 56 # Load again and repeat tests -------------------------------------------- 57 load_all("testS4union") 58 59 run_tests() 60 61 # Install package then load and run tests 62 withr::with_temp_libpaths({ 63 install.packages("testS4union", repos = NULL, type = "source", quiet = TRUE) 64 library("testS4union") 65 load_all("testS4union") 66 run_tests() 67 }) 68 69 # Loading again shouldn't result in any errors or warnings 70 expect_warning(load_all("testS4union", reset = FALSE), NA) 71 72 unload("testS4union") 73 unloadNamespace("stats4") # This was imported by testS4union 74 75 # Check that classes are unregistered 76 # This test on A fails for some bizarre reason - bug in R? But it doesn't 77 # to cause any practical problems. 78 expect_true(is.null(getClassDef("A"))) 79 expect_true(is.null(getClassDef("B"))) 80 expect_true(is.null(getClassDef("AB"))) 81}) 82