Skip to content

Commit 37e9f57

Browse files
HenrikBengtssonHenrikBengtsson
committed
TESTS: Cleaning up and restructuring
1 parent 69e2a61 commit 37e9f57

21 files changed

+177
-64
lines changed

‎R/progression_handler.R‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -332,7 +332,7 @@ make_progression_handler <- function(name, reporter = list(), handler = NULL, en
332332
class(handler) <- c(sprintf("%s_progression_handler", name),
333333
"progression_handler", "calling_handler",
334334
class(handler))
335-
335+
336336
handler
337337
}
338338

‎tests/debug.R‎

Lines changed: 3 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -1,12 +1,4 @@
1-
library(progressr)
2-
3-
options(progressr.tests.fake_handlers = c("beepr_handler", "notifier_handler", "pbmcapply_handler", "progress_handler", "tkprogressbar_handler", "winprogressbar_handler"))
4-
options(progressr.debug = TRUE)
5-
options(progressr.enable = TRUE)
6-
options(progressr.times = +Inf)
7-
options(progressr.interval = 0.1)
8-
options(progressr.enable_after = 0.5)
9-
options(progressr.delay = 0.1)
1+
source("incl/start.R")
102

113
message("with_progress() - progressr.debug = TRUE ...")
124

@@ -16,7 +8,6 @@ with_progress({
168
y <- slow_sum(1:10)
179
})
1810

19-
options(progressr.enable_after = 0.0, progressr.delay = 0.0)
2011

2112
with_progress({
2213
progress <- progressor(steps = 1 + 2 + 1)
@@ -30,3 +21,5 @@ with_progress({
3021

3122

3223
message("with_progress() - progressr.debug = TRUE ... done")
24+
25+
source("incl/end.R")

‎tests/demo.R‎

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,5 @@
11
source("incl/start.R")
22

3-
library(progressr)
43
library(future)
54
supportedStrategies <- function(...) future:::supportedStrategies()
65

‎tests/exceptions.R‎

Lines changed: 3 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,4 @@
1-
library(progressr)
2-
3-
options(progressr.enable = TRUE)
4-
options(progressr.delay = 0.0)
1+
source("incl/start.R")
52

63

74
message("Exceptions ...")
@@ -30,3 +27,5 @@ stopifnot(inherits(res, "error"))
3027

3128

3229
message("Exceptions ... done")
30+
31+
source("incl/end.R")

‎tests/incl/end.R‎

Lines changed: 39 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,39 @@
1+
## Undo options
2+
## (a) Added
3+
added <- setdiff(names(options()), names(oopts0))
4+
opts <- vector("list", length = length(added))
5+
names(opts) <- added
6+
options(opts)
7+
## (b) Modified
8+
options(oopts)
9+
## (c) Removed, e.g. future.plan=NULL
10+
removed <- setdiff(names(oopts0), names(options()))
11+
opts <- oopts0[removed]
12+
options(opts)
13+
## (d) Assert that everything was undone
14+
stopifnot(identical(options(), oopts0))
15+
16+
17+
## Undo system environment variables
18+
## (a) Added
19+
cenvs <- Sys.getenv()
20+
added <- setdiff(names(cenvs), names(oenvs0))
21+
for (name in added) Sys.unsetenv(name)
22+
## (b) Missing
23+
missing <- setdiff(names(oenvs0), names(cenvs))
24+
if (length(missing) > 0) do.call(Sys.setenv, as.list(oenvs0[missing]))
25+
## (c) Modified?
26+
for (name in intersect(names(cenvs), names(oenvs0))) {
27+
## WORKAROUND: On Linux Wine, base::Sys.getenv() may
28+
## return elements with empty names. /HB 2016-10-06
29+
if (nchar(name) == 0) next
30+
if (!identical(cenvs[[name]], oenvs0[[name]])) {
31+
do.call(Sys.setenv, as.list(oenvs0[name]))
32+
}
33+
}
34+
## (d) Assert that everything was undone
35+
stopifnot(identical(Sys.getenv(), oenvs0))
36+
37+
38+
## Undo variables
39+
rm(list = c(setdiff(ls(), ovars)))

‎tests/incl/start,load-only.R‎

Lines changed: 52 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,52 @@
1+
## Record original state
2+
ovars <- ls()
3+
oenvs <- oenvs0 <- Sys.getenv()
4+
oopts0 <- options()
5+
6+
## Default options for tests
7+
oopts <- options()
8+
9+
## Private
10+
mdebug <- progressr:::mdebug
11+
mprint <- progressr:::mprint
12+
mprintf <- progressr:::mprintf
13+
mstr <- progressr:::mstr
14+
stop_if_not <- progressr:::stop_if_not
15+
known_progression_handlers <- progressr:::known_progression_handlers
16+
17+
non_supported_progression_handlers <- function() {
18+
names <- character(0L)
19+
for (pkg in c("beepr", "notifier", "pbmcapply", "progress", "shiny")) {
20+
if (!requireNamespace(pkg, quietly = TRUE))
21+
names <- c(names, pkg)
22+
}
23+
if (!"tcltk" %in% capabilities()) {
24+
names <- c(names, "tkprogressbar")
25+
}
26+
if (.Platform$OS.type != "windows") {
27+
names <- c(names, "winprogressbar")
28+
}
29+
paste0(names, "_handler")
30+
}
31+
32+
33+
## Settings
34+
options(progressr.clear = TRUE)
35+
options(progressr.debug = FALSE)
36+
options(progressr.delay = 0.0)
37+
options(progressr.enable = TRUE)
38+
options(progressr.enable_after = 0.0)
39+
options(progressr.interval = 0.1)
40+
options(progressr.times = +Inf)
41+
42+
43+
options(progressr.tests.fake_handlers = c(non_supported_progression_handlers(), "beepr_handler", "notifier_handler", "progress_handler"))
44+
45+
46+
## WORKAROUND: Make sure tests also work with 'covr' package
47+
covr <- ("covr" %in% loadedNamespaces())
48+
if (covr) {
49+
globalenv <- function() parent.frame()
50+
baseenv <- function() environment(base::sample)
51+
}
52+

‎tests/incl/start.R‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,2 @@
1+
library("progressr")
2+
source("incl/start,load-only.R")

‎tests/pbmcapply_handler.R‎

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,9 @@
1+
source("incl/start.R")
2+
3+
if (requireNamespace("pbmcapply", quietly = TRUE)) {
4+
handlers("pbmcapply")
5+
with_progress({ y <- slow_sum(1:10) })
6+
print(y)
7+
}
8+
9+
source("incl/end.R")

‎tests/progress_aggregator.R‎

Lines changed: 3 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,4 @@
1-
library(progressr)
2-
3-
options(progressr.enable = TRUE)
4-
options(progressr.delay = 0.0)
1+
source("incl/start.R")
52

63
message("progress_aggregator() ...")
74

@@ -58,3 +55,5 @@ with_progress({
5855

5956

6057
message("progress_aggregator() ... done")
58+
59+
source("incl/end.R")

‎tests/progress_handler.R‎

Lines changed: 4 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,6 @@
1-
library(progressr)
1+
source("incl/start.R")
22

3-
options(progressr.delay = 0.01)
4-
options(progressr.times = +Inf)
5-
options(progressr.interval = 0.2)
63
options(progressr.clear = FALSE)
7-
delay <- getOption("progressr.delay", 0.5)
84

95
if (requireNamespace("progress", quietly = TRUE)) {
106
options(progressr.handlers = progress_handler)
@@ -17,9 +13,11 @@ message("progress_handler() ...")
1713
with_progress({
1814
progress <- progressor(along = x)
1915
for (ii in x) {
20-
Sys.sleep(delay)
16+
Sys.sleep(getOption("progressr.delay", 0.1))
2117
progress(message = sprintf("(%s)", paste(letters[1:ii], collapse="")))
2218
}
2319
})
2420

2521
message("progress_handler() ... done")
22+
23+
source("incl/end.R")

0 commit comments

Comments
 (0)