Skip to content

Commit 3ec2edf

Browse files
radbasajakubnowickijimhester
authored
klmr/box support (#526)
* increment version * an app with box modules example * boilerplate for box coverage test * ready to write box support * now works with basic box modules * Forgot an s Co-authored-by: Jakub Nowicki <[email protected]> * Smaller version increment as suggested Co-authored-by: Jakub Nowicki <[email protected]> * got it to work! * added support for R6 classes attached as box modules * increment dev version * forgot to update the unit test with R6 modules attached * some refactoring to clean up code * tests for klmr/box attached modules, functions, three dots, and aliases * a little bit of cleanup * code cleanup. finally broke the unlist puzzle * clean up nested (( * test: Fix box cache cleaning in tests. * chore: Add box to suggested dependencies. * chore: Update package version. * added entry in NEWS.md * Trigger CICD * Another CI test trigger pr (#21) * Added `replacements_box()` for `klmr/box` support. * Extracted `traverse_R6()` from `replacements_R6()` to reuse code in `replacements_box()`. * R6 class box modules test cases separated to handle a known R6 issues with `r-devel`. `skip_if(is_r_devel())` is used in the R6 test cases. * Update to covr 3.6.3 (#23) * Adjusted DESCRIPTION and NEWS.md * Different condition to skip tests * Bump version for release --------- Co-authored-by: Jim Hester <[email protected]> * box 1.2.0 released with backports compatibility fixes --------- Co-authored-by: Jakub Nowicki <[email protected]> Co-authored-by: Jakub Nowicki <[email protected]> Co-authored-by: Jim Hester <[email protected]>
1 parent 54de614 commit 3ec2edf

File tree

28 files changed

+387
-13
lines changed

28 files changed

+387
-13
lines changed

‎DESCRIPTION‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
Encoding: UTF-8
22
Package: covr
33
Title: Test Coverage for Packages
4-
Version: 3.6.4.9000
4+
Version: 3.6.4.9001
55
Authors@R: c(
66
person("Jim", "Hester", email = "[email protected]", role = c("aut", "cre")),
77
person("Willem", "Ligtenberg", role = "ctb"),
@@ -68,7 +68,8 @@ Suggests:
6868
parallel,
6969
memoise,
7070
mockery,
71-
covr
71+
covr,
72+
box (>= 1.2.0)
7273
License: MIT + file LICENSE
7374
VignetteBuilder: knitr
7475
RoxygenNote: 7.2.3

‎NEWS.md‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,7 @@
11
# covr (development version)
22

3+
* Added support for `klmr/box` modules. This works best with `file_coverage()`. (@radbasa, #491)
4+
35
# covr 3.6.4
46

57
* Fix for a failing test on CRAN

‎R/R6.R‎

Lines changed: 15 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -2,18 +2,22 @@ replacements_R6 <- function(env) {
22
unlist(recursive = FALSE, eapply(env, all.names = TRUE,
33
function(obj) {
44
if (inherits(obj, "R6ClassGenerator")) {
5-
unlist(recursive = FALSE, eapply(obj,
6-
function(o) {
7-
if (inherits(o, "list")) {
8-
lapply(names(o),
9-
function(f_name) {
10-
f <- get(f_name, o)
11-
if (inherits(f, "function")) {
12-
replacement(f_name, env = env, target_value = f)
13-
}
14-
})
5+
traverse_R6(obj, env)
156
}
167
}))
178
}
18-
}))
9+
10+
traverse_R6 <- function(obj, env) {
11+
unlist(recursive = FALSE, eapply(obj,
12+
function(o) {
13+
if (inherits(o, "list")) {
14+
lapply(names(o),
15+
function(f_name) {
16+
f <- get(f_name, o)
17+
if (inherits(f, "function")) {
18+
replacement(f_name, env = env, target_value = f)
19+
}
20+
})
21+
}
22+
}))
1923
}

‎R/box.R‎

Lines changed: 32 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,32 @@
1+
replacements_box <- function(env) {
2+
unlist(recursive = FALSE, eapply(env, all.names = TRUE,
3+
function(obj) {
4+
if (inherits(attr(obj, "spec"), "box$mod_spec")) {
5+
obj_impl <- attr(obj, "namespace")
6+
compact(
7+
c(
8+
lapply(ls(obj_impl),
9+
function(f_name) {
10+
f <- get(f_name, obj_impl)
11+
if (inherits(f, "function")) {
12+
replacement(f_name, env = obj, target_value = f)
13+
}
14+
}
15+
),
16+
unlist(recursive = FALSE,
17+
lapply(ls(obj_impl),
18+
function(f_name) {
19+
f <- get(f_name, obj_impl)
20+
if (inherits(f, "R6ClassGenerator")) {
21+
traverse_R6(f, obj)
22+
}
23+
}
24+
)
25+
)
26+
)
27+
)
28+
}
29+
}
30+
)
31+
)
32+
}

‎R/covr.R‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -93,6 +93,7 @@ trace_environment <- function(env) {
9393
replacements_S4(env),
9494
replacements_RC(env),
9595
replacements_R6(env),
96+
replacements_box(env),
9697
lapply(ls(env, all.names = TRUE), replacement, env = env)))
9798

9899
lapply(the$replacements, replace)

‎tests/testthat/Testbox/app/app.R‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,8 @@
1+
options(box.path = file.path(getwd()))
2+
# remove box cache
3+
loaded_mods <- loadNamespace("box")$loaded_mods
4+
rm(list = ls(loaded_mods), envir = loaded_mods)
5+
6+
box::use(
7+
app/modules/module
8+
)

‎tests/testthat/Testbox/app/modules/module.R‎

Lines changed: 14 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,14 @@
1+
#' an example function
2+
#'
3+
#' @export
4+
a <- function(x) {
5+
if (x <= 1) {
6+
1
7+
} else {
8+
2
9+
}
10+
}
11+
12+
private_function <- function(x) {
13+
x ^ 2
14+
}

‎tests/testthat/Testbox/tests/testthat.R‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,8 @@
1+
options(box.path = file.path(getwd()))
2+
# remove box cache
3+
loaded_mods <- loadNamespace("box")$loaded_mods
4+
rm(list = ls(loaded_mods), envir = loaded_mods)
5+
6+
library(testthat)
7+
8+
test_dir("tests/testthat")

‎tests/testthat/Testbox/tests/testthat/test-module.R‎

Lines changed: 23 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,23 @@
1+
box::use(
2+
testthat[test_that, expect_equal]
3+
)
4+
5+
box::use(
6+
app/modules/module
7+
)
8+
9+
impl <- attr(module, "namespace")
10+
11+
test_that("regular function `a` works as expected", {
12+
expect_equal(module$a(1), 1)
13+
expect_equal(module$a(2), 2)
14+
expect_equal(module$a(3), 2)
15+
expect_equal(module$a(4), 2)
16+
expect_equal(module$a(0), 1)
17+
})
18+
19+
test_that("private function works as expected", {
20+
expect_equal(impl$private_function(2), 4)
21+
expect_equal(impl$private_function(3), 9)
22+
expect_equal(impl$private_function(4), 16)
23+
})

‎tests/testthat/Testbox_R6/app/app.R‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,8 @@
1+
options(box.path = file.path(getwd()))
2+
# remove box cache
3+
loaded_mods <- loadNamespace("box")$loaded_mods
4+
rm(list = ls(loaded_mods), envir = loaded_mods)
5+
6+
box::use(
7+
app/modules/moduleR6
8+
)

0 commit comments

Comments
 (0)