Skip to content

Commit 0ea29dc

Browse files
HenrikBengtssonHenrikBengtsson
committed
TESTS: Add more tests to increase test coverage
1 parent e0b3c41 commit 0ea29dc

5 files changed

Lines changed: 268 additions & 1 deletion

File tree

‎DESCRIPTION‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
Package: progressify
2-
Version: 0.1.0-9009
2+
Version: 0.1.0-9010
33
Title: Progress Reporting of Common Functions via One Magic Function
44
Description: The progressify() function rewrites (transpiles) calls to sequential and parallel map-reduce functions such as base::lapply(), purrr::map(), foreach::foreach(), and plyr::llply() to signal progress updates. By combining this function with R's native pipe operator, you have a straightforward way to report progress on iterative computations with minimal refactoring, e.g. 'lapply(x, fcn) |> progressify()' and 'purrr::map(x, fcn) |> progressify()'. It is compatible with the 'futurize' package for parallelization, e.g. 'lapply(x, fcn) |> progressify() |> futurize()' and 'purrr::map(x, fcn) |> futurize() |> progressify()'.
55
Authors@R: c(

‎inst/testme/test-progressify-api.R‎

Lines changed: 86 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,86 @@
1+
library(progressify)
2+
options(progressify.debug = TRUE)
3+
4+
# --------------------------------------------------------------------
5+
# progressify()
6+
# --------------------------------------------------------------------
7+
message("progressify(NA):")
8+
res <- progressify(NA)
9+
print(res)
10+
stopifnot(isTRUE(res))
11+
12+
message("progressify(FALSE):")
13+
res <- progressify(FALSE)
14+
print(res)
15+
stopifnot(isTRUE(res))
16+
17+
message("progressify(TRUE):")
18+
res <- progressify(TRUE)
19+
print(res)
20+
stopifnot(isFALSE(res))
21+
22+
if (requireNamespace("progressr", quietly = TRUE)) {
23+
message("progressify(when = FALSE):")
24+
y_truth <- lapply(1:3, identity)
25+
y <- lapply(1:3, identity) |> progressify(when = FALSE)
26+
stopifnot(identical(y, y_truth))
27+
y <- lapply(1:3, identity) |> progressify(when = TRUE)
28+
stopifnot(identical(y, y_truth))
29+
expr <- lapply(1:3, identity) |> progressify(when = FALSE, eval = FALSE)
30+
print(expr)
31+
}
32+
33+
## Cannot progressify non-calls
34+
res <- tryCatch(base::pi |> progressify::progressify(), error = identity)
35+
print(res)
36+
stopifnot(inherits(res, "error"))
37+
38+
## Cannot progressify non-calls
39+
res <- tryCatch(quote(1 + 2) |> progressify::progressify(), error = identity)
40+
print(res)
41+
stopifnot(inherits(res, "error"))
42+
43+
## Cannot progressify non-existing functions
44+
res <- tryCatch(progressify:::unknown |> progressify::progressify(), error = identity)
45+
print(res)
46+
stopifnot(inherits(res, "error"))
47+
48+
## Cannot progressify non-existing infix operators
49+
res <- tryCatch(progressify:::`%unknown%` |> progressify::progressify(), error = identity)
50+
print(res)
51+
stopifnot(inherits(res, "error"))
52+
53+
## Cannot progressify non-supported functions
54+
res <- tryCatch(progressify:::progressify_supported_packages() |> progressify::progressify(), error = identity)
55+
print(res)
56+
stopifnot(inherits(res, "error"))
57+
58+
## Cannot progressify private functions
59+
res <- tryCatch(progressify:::import_progressr() |> progressify::progressify(), error = identity)
60+
print(res)
61+
stopifnot(inherits(res, "error"))
62+
63+
64+
# --------------------------------------------------------------------
65+
# progressify_supported_packages() and progressify_supported_functions()
66+
# --------------------------------------------------------------------
67+
pkgs <- progressify_supported_packages()
68+
print(pkgs)
69+
70+
for (pkg in c(pkgs, "progressr", "aNonExistingPackage")) {
71+
cat(sprintf("Package %s:\n", pkg))
72+
fcns <- tryCatch({
73+
progressify::progressify_supported_functions(pkg)
74+
}, error = identity)
75+
print(fcns)
76+
}
77+
78+
## Assert that there are not clashes between supported packages
79+
pkgs <- progressify_supported_packages()
80+
for (pkg in rep(pkgs, times = 2L)) {
81+
cat(sprintf("Package %s:\n", pkg))
82+
fcns <- tryCatch({
83+
progressify::progressify_supported_functions(pkg)
84+
}, error = identity)
85+
print(fcns)
86+
}

‎inst/testme/test-progressify-internals.R‎

Lines changed: 173 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,173 @@
1+
library(progressify)
2+
options(progressify.debug = TRUE)
3+
4+
message("*** Internals")
5+
6+
# --------------------------------------------------------------------
7+
# Debug functions
8+
# --------------------------------------------------------------------
9+
message("debug_indent()")
10+
oopts <- options(warn = 2L)
11+
res <- tryCatch(progressify:::debug_indent(delta = -1L), error = identity)
12+
print(res)
13+
stopifnot(inherits(res, "error"))
14+
options(oopts)
15+
16+
17+
# --------------------------------------------------------------------
18+
# .onLoad()
19+
# --------------------------------------------------------------------
20+
message(".onLoad()")
21+
progressify:::.onLoad("progressify", "progressify")
22+
23+
24+
# --------------------------------------------------------------------
25+
# bquote_compile() and bquote_apply()
26+
# --------------------------------------------------------------------
27+
message("bquote_compile() and bquote_apply()")
28+
bquote_compile <- progressify:::bquote_compile
29+
bquote_apply <- progressify:::bquote_apply
30+
31+
tmpl <- bquote_compile(function(a = .(X), b = .(Y)) { a + b })
32+
expr <- bquote_apply(tmpl, X = 42, Y = NULL)
33+
f <- formals(eval(expr))
34+
stopifnot(identical(f$a, 42))
35+
stopifnot(is.null(f$b))
36+
37+
38+
# --------------------------------------------------------------------
39+
# import_progressr() and import_from()
40+
# --------------------------------------------------------------------
41+
message("import_progressr() and import_from()")
42+
import_from <- progressify:::import_from
43+
import_progressr <- progressify:::import_progressr
44+
45+
fcn <- import_progressr("progressor")
46+
stopifnot(is.function(fcn))
47+
48+
fcn <- import_progressr("nonExistingFcn", default = identity)
49+
stopifnot(identical(fcn, identity))
50+
51+
res <- tryCatch(
52+
import_progressr("nonExistingFcn"),
53+
error = identity
54+
)
55+
stopifnot(inherits(res, "error"))
56+
57+
fcn <- import_from("lapply", package = "base")
58+
stopifnot(identical(fcn, base::lapply))
59+
60+
fcn <- import_from("nonExisting", package = "base", default = sum)
61+
stopifnot(identical(fcn, sum))
62+
63+
res <- tryCatch(
64+
import_from("nonExisting", package = "base"),
65+
error = identity
66+
)
67+
stopifnot(inherits(res, "error"))
68+
69+
70+
# --------------------------------------------------------------------
71+
# S3 dispatching
72+
# --------------------------------------------------------------------
73+
message("S3 dispatch")
74+
is_s3_generic <- progressify:::is_s3_generic
75+
find_s3_method <- progressify:::find_s3_method
76+
77+
my_generic <- function(x) UseMethod("my_generic")
78+
stopifnot(is_s3_generic(my_generic))
79+
stopifnot(!is_s3_generic(lapply))
80+
stopifnot(!is_s3_generic(sum))
81+
stopifnot(!is_s3_generic(function() NULL))
82+
83+
my_generic.default <- function(x) "default"
84+
my_generic.my_class <- function(x) "my_class"
85+
86+
obj <- structure(list(), class = "my_class")
87+
res <- find_s3_method(my_generic, "my_generic", quote(my_generic(obj)), envir = environment())
88+
stopifnot(identical(res$name, "my_generic.my_class"))
89+
90+
fempty <- function() {}
91+
res_empty <- find_s3_method(fempty, "fempty", quote(fempty()), envir = environment())
92+
stopifnot(is.null(res_empty))
93+
94+
fdots <- function(...) {}
95+
res_dots <- find_s3_method(fdots, "fdots", quote(fdots()), envir = environment())
96+
stopifnot(is.null(res_dots))
97+
98+
res_unmatched <- find_s3_method(my_generic, "my_generic", quote(my_generic(a, b, c)), envir = environment())
99+
stopifnot(is.null(res_unmatched))
100+
101+
res_lit <- find_s3_method(my_generic, "my_generic", quote(my_generic(1)), envir = environment())
102+
stopifnot(is.null(res_lit))
103+
104+
res_null <- find_s3_method(my_generic, "my_generic", quote(my_generic(nonexistent_obj)), envir = environment())
105+
stopifnot(is.null(res_null))
106+
107+
108+
# --------------------------------------------------------------------
109+
# S4 dispatching
110+
# --------------------------------------------------------------------
111+
message("S4 dispatch")
112+
find_s4_method <- progressify:::find_s4_method
113+
114+
methods::setClass("MyS4Class", slots = list(name = "character"))
115+
methods::setGeneric("my_s4_generic", function(x) standardGeneric("my_s4_generic"))
116+
methods::setMethod("my_s4_generic", signature = "MyS4Class", function(x) "s4_method")
117+
118+
obj <- methods::new("MyS4Class", name = "test")
119+
res <- find_s4_method(my_s4_generic, "my_s4_generic", quote(my_s4_generic(obj)), envir = environment())
120+
stopifnot(identical(res$name, "my_s4_generic"))
121+
122+
res_nons4 <- find_s4_method(identity, "identity", quote(identity(1)), envir = environment())
123+
stopifnot(is.null(res_nons4))
124+
125+
126+
# --------------------------------------------------------------------
127+
# Transpiler registry
128+
# --------------------------------------------------------------------
129+
message("Transpiler registry")
130+
transpilers_for_package <- progressify:::transpilers_for_package
131+
transpiler_packages <- progressify:::transpiler_packages
132+
list_transpilers <- progressify:::list_transpilers
133+
134+
transpilers_for_package(type = "test-type", package = "test-pkg", action = "reset")
135+
transpilers_for_package(type = "test-type", package = "test-pkg", fcn = function() "test-pkg", action = "add")
136+
137+
res_get <- transpilers_for_package(type = "test-type", package = "test-pkg", action = "get")
138+
stopifnot(length(res_get) == 1L)
139+
140+
res_list <- transpilers_for_package(type = "test-type", action = "list")
141+
stopifnot(length(res_list) >= 1L)
142+
143+
res_make <- transpilers_for_package(type = "test-type", package = "test-pkg", action = "make")
144+
stopifnot(identical(res_make, "test-pkg"))
145+
146+
df_pkgs <- transpiler_packages(classes = "test-type")
147+
stopifnot(is.data.frame(df_pkgs))
148+
149+
df_list <- list_transpilers(class = "progressify::built-in")
150+
stopifnot(is.data.frame(df_list))
151+
152+
df_filtered <- list_transpilers(pattern = "^ba", class = "progressify::built-in")
153+
stopifnot(is.data.frame(df_filtered))
154+
155+
156+
# --------------------------------------------------------------------
157+
# parse_call() and transpile() edge cases
158+
# --------------------------------------------------------------------
159+
message("parse_call and transpile edge cases")
160+
parse_call <- progressify:::parse_call
161+
transpile <- progressify:::transpile
162+
163+
res <- tryCatch({
164+
parse_call(quote(1))
165+
}, error = function(e) e)
166+
stopifnot(inherits(res, "error"))
167+
168+
append_call_arguments <- progressify:::append_call_arguments
169+
res_appended <- append_call_arguments(quote(my_fcn(x)), y = 2)
170+
stopifnot(identical(res_appended, quote(my_fcn(x, y = 2))))
171+
172+
register_all_transpilers <- progressify:::register_all_transpilers
173+
register_all_transpilers()

‎tests/test-progressify-api.R‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,4 @@
1+
#! /usr/bin/env Rscript
2+
## This runs testme test script inst/testme/test-progressify-api.R
3+
## Don't edit - it was autogenerated by inst/testme/deploy.R
4+
progressify:::testme("progressify-api")

‎tests/test-progressify-internals.R‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,4 @@
1+
#! /usr/bin/env Rscript
2+
## This runs testme test script inst/testme/test-progressify-internals.R
3+
## Don't edit - it was autogenerated by inst/testme/deploy.R
4+
progressify:::testme("progressify-internals")

0 commit comments

Comments
 (0)