1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
|
context("Load hooks")
test_that("hooks called in correct order", {
record_use <- function(hook) {
function(...) {
h <- globalenv()$hooks
h$events <- c(h$events, hook)
}
}
reset_events <- function() {
assign("hooks", new.env(parent = emptyenv()), envir = globalenv())
h <- globalenv()$hooks
h$events <- character()
}
setHook(packageEvent("testHooks", "attach"), record_use("user_attach"))
setHook(packageEvent("testHooks", "detach"), record_use("user_detach"))
setHook(packageEvent("testHooks", "onLoad"), record_use("user_load"))
setHook(packageEvent("testHooks", "onUnload"), record_use("user_unload"))
reset_events()
load_all("testHooks")
expect_equal(globalenv()$hooks$events,
c("pkg_load", "user_load", "pkg_attach", "user_attach")
)
reset_events()
load_all("testHooks", reset = FALSE)
expect_equal(globalenv()$hooks$events, character())
reset_events()
unload("testHooks")
expect_equal(globalenv()$hooks$events,
c("user_detach", "pkg_detach", "user_unload", "pkg_unload")
)
rm(list = "hooks", envir = globalenv())
setHook(packageEvent("testHooks", "attach"), NULL, "replace")
setHook(packageEvent("testHooks", "detach"), NULL, "replace")
setHook(packageEvent("testHooks", "onLoad"), NULL, "replace")
setHook(packageEvent("testHooks", "onUnload"), NULL, "replace")
})
test_that("onLoad and onAttach", {
load_all("testLoadHooks")
nsenv <- ns_env("testLoadHooks")
pkgenv <- pkg_env("testLoadHooks")
# normalizePath is needed so that capitalization differences on
# case-insensitive platforms won't cause errors.
expect_equal(normalizePath(nsenv$onload_lib), normalizePath(getwd()))
expect_equal(normalizePath(nsenv$onattach_lib), normalizePath(getwd()))
# a: modified by onLoad in namespace env
# b: modified by onAttach in namespace env
# c: modified by onAttach in package env
# In a normal install+load, b can't be modified by onAttach because
# the namespace is locked before onAttach. But it can be modified when
# using load_all.
expect_equal(nsenv$a, 2)
expect_equal(nsenv$b, 2) # This would be 1 in normal install+load
expect_equal(nsenv$c, 1)
expect_equal(pkgenv$a, 2)
expect_equal(pkgenv$b, 1)
expect_equal(pkgenv$c, 2)
# ===================================================================
# Loading again without reset won't change a, b, and c in the
# namespace env, and also shouldn't trigger onload or onattach. But
# the existing namespace values will be copied over to the package
# environment
load_all("testLoadHooks", reset = FALSE)
# Shouldn't form new environments
expect_identical(nsenv, ns_env("testLoadHooks"))
expect_identical(pkgenv, pkg_env("testLoadHooks"))
# namespace and package env values should be the same
expect_equal(nsenv$a, 2)
expect_equal(nsenv$b, 2)
expect_equal(nsenv$c, 1)
expect_equal(pkgenv$a, 2)
expect_equal(pkgenv$b, 2)
expect_equal(pkgenv$c, 1)
# ===================================================================
# With reset=TRUE, there should be new package and namespace
# environments, and the values should be the same as the first
# load_all.
load_all("testLoadHooks", reset = TRUE)
nsenv2 <- ns_env("testLoadHooks")
pkgenv2 <- pkg_env("testLoadHooks")
# Should form new environments
expect_false(identical(nsenv, nsenv2))
expect_false(identical(pkgenv, pkgenv2))
# Values should be same as first time
expect_equal(nsenv2$a, 2)
expect_equal(nsenv2$b, 2)
expect_equal(nsenv2$c, 1)
expect_equal(pkgenv2$a, 2)
expect_equal(pkgenv2$b, 1)
expect_equal(pkgenv2$c, 2)
unload("testLoadHooks")
# ===================================================================
# Unloading and reloading should create new environments and same
# values as first time
load_all("testLoadHooks")
nsenv3 <- ns_env("testLoadHooks")
pkgenv3 <- pkg_env("testLoadHooks")
# Should form new environments
expect_false(identical(nsenv, nsenv3))
expect_false(identical(pkgenv, pkgenv3))
# Values should be same as first time
expect_equal(nsenv3$a, 2)
expect_equal(nsenv3$b, 2)
expect_equal(nsenv3$c, 1)
expect_equal(pkgenv3$a, 2)
expect_equal(pkgenv3$b, 1)
expect_equal(pkgenv3$c, 2)
unload("testLoadHooks")
})
test_that("onUnload", {
load_all("testLoadHooks")
# The onUnload function in testLoadHooks increments this variable
.GlobalEnv$.__testLoadHooks__ <- 1
unload("testLoadHooks")
expect_equal(.GlobalEnv$.__testLoadHooks__, 2)
# Clean up
rm(".__testLoadHooks__", envir = .GlobalEnv)
})
|
