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