Function for which we want to generate tests:
filter <- function(xs, p) xs[sapply(xs, p)]Example code:
is_even <- function(x) x %% 2L == 0L
is_odd <- function(x) !is_even(x)
nums <- 1L:10LCode from which to generate the code:
filter(nums, is_odd)## [1] 1 3 5 7 9Now we bring genthat in:
library(genthat)First, we need to decorate the function for which we want to generate tests:
decorate_function(filter)The body of the function is augmented with code to capture the calling arguments and return value:
body(filter)## {
## `__genthat_captured_seed` <- get(".Random.seed", envir = globalenv())
## ""
## on.exit({
## if (.Internal(getOption("genthat.tracing"))) {
## .Internal(options(genthat.tracing = FALSE))
## default <- genthat:::`__genthat_default_retv`
## retv <- returnValue(default = default)
## if (!identical(retv, default) && !genthat:::is_exception_returnValue(retv)) {
## genthat:::record_trace(name = "filter", pkg = NULL,
## args = as.list(match.call())[-1], retv = retv,
## seed = `__genthat_captured_seed`, env = parent.frame())
## }
## .Internal(options(genthat.tracing = TRUE))
## }
## })
## xs[sapply(xs, p)]
## }Next, we run the same code as before:
filter(nums, is_odd)## [1] 1 3 5 7 9Getting recorded trace:
traces <- copy_traces()
str(traces)## List of 1
## $ :List of 6
## ..$ fun : chr "filter"
## ..$ pkg : NULL
## ..$ args :List of 2
## .. ..$ xs: symbol nums
## .. ..$ p : symbol is_odd
## ..$ globals:List of 2
## .. ..$ is_odd:function (x)
## .. .. ..- attr(*, "genthat_extracted_closure")= logi TRUE
## .. ..$ nums : int [1:10] 1 2 3 4 5 6 7 8 9 10
## ..$ seed : int [1:626] 403 624 507561766 1260545903 1362917092 -1772566379 -1344458670 1072028587 -1293707536 1708789297 ...
## ..$ retv : int [1:5] 1 3 5 7 9
## ..- attr(*, "class")= chr "genthat_trace"trace <- traces[[1]]Notice that the is_odd is defined in terms of is_even which is now captured in the environment of the captured is_odd:
ls.str(environment(trace$globals$is_odd))## is_even : function (x)body(get("is_even", environment(trace$globals$is_odd)))## x%%2L == 0LA test is generated from a trace:
test <- generate_test(trace)We use testthat format for the unit test:
cat(paste(test, collapse="\n\n"))## library(testthat)
##
## .Random.seed <<- .ext.seed
##
## test_that("filter", {
## is_odd <- genthat::with_env(function(x) !is_even(x), env = list2env(list(is_even = genthat::with_env(function(x) x%%2L ==
## 0L, env = list2env(list(), parent = baseenv()))), parent = baseenv()))
## nums <- 1:10
## expect_equal(filter(xs = nums, p = is_odd), c(1L, 3L, 5L, 7L, 9L))
## })Big values are stored in externals attribute:
ls.str(attr(test, "externals"), all.names=TRUE)## .ext.seed : int [1:626] 403 624 507561766 1260545903 1362917092 -1772566379 -1344458670 1072028587 -1293707536 1708789297 ...To run the test, we first need to save it into a file:
test_file <- generate_test_file(trace, "tmp")The externals were stored in RDS format in a file next to the test:
ls.str(readRDS("tmp/_NULL_/filter/test-1.ext"), all.names=TRUE)## .ext.seed : int [1:626] 403 624 507561766 1260545903 1362917092 -1772566379 -1344458670 1072028587 -1293707536 1708789297 ...Running the tests:
result <- test_generated_file(test_file)
result## file context test nb failed skipped error warning user system
## 1 test-1.R filter 1 0 FALSE FALSE 0 0.074 0
## real
## 1 0.075Remove all the observed traces:
reset_traces()str(copy_traces())## list()Reset decorated functions:
reset_function(filter)body(filter)## xs[sapply(xs, p)]We have selected a sample package:
cat(paste(system2("tree", "packages/Rvmmin", stdout=TRUE), collapse="\n"))## packages/Rvmmin
## ├── build
## │ └── vignette.rds
## ├── demo
## │ ├── 00Index
## │ ├── broydt_test.R
## │ ├── cyq_test.R
## │ └── genrose_test.R
## ├── DESCRIPTION
## ├── inst
## │ └── doc
## │ ├── Rvmmin.pdf
## │ ├── Rvmmin.R
## │ └── Rvmmin.Rmd
## ├── man
## │ ├── Rvmminb.Rd
## │ ├── Rvmmin.Rd
## │ └── Rvmminu.Rd
## ├── MD5
## ├── NAMESPACE
## ├── NEWS
## ├── R
## │ ├── Rvmminb.R
## │ ├── Rvmmin.R
## │ └── Rvmminu.R
## ├── tests
## │ └── BTbad.R
## └── vignettes
## ├── Rvmmin.bib
## ├── Rvmmin.html
## └── Rvmmin.Rmd
##
## 8 directories, 22 filesCheck its current test coverage:
library(covr)
tests_coverage <- package_coverage("packages/Rvmmin", type="tests")
tests_coverage## Rvmmin Coverage: 3.85%## R/Rvmminb.R: 0.00%## R/Rvmminu.R: 0.00%## R/Rvmmin.R: 39.62%Run genthat:
result <-
gen_from_package(
"Rvmmin",
types="all",
action="generate",
prune_tests=TRUE,
output_dir="tmp"
)result## # A tibble: 8 x 4
## file output elapsed coverage
## <chr> <chr> <dbl> <dbl>
## 1 /tmp/RtmpXYedWL/genthat-gen_from… /home/rstudio/tmp/Rv… 0.0554 26.2
## 2 /tmp/RtmpXYedWL/genthat-gen_from… /home/rstudio/tmp/Rv… 0.0554 26.4
## 3 /tmp/RtmpXYedWL/genthat-gen_from… /home/rstudio/tmp/Rv… 0.0432 29.7
## 4 /tmp/RtmpXYedWL/genthat-gen_from… /home/rstudio/tmp/Rv… 0.446 56.9
## 5 /tmp/RtmpXYedWL/genthat-gen_from… /home/rstudio/tmp/Rv… 0.0385 57.1
## 6 /tmp/RtmpXYedWL/genthat-gen_from… /home/rstudio/tmp/Rv… 0.0323 71.2
## 7 /tmp/RtmpXYedWL/genthat-gen_from… /home/rstudio/tmp/Rv… 0.0610 72.1
## 8 /tmp/RtmpXYedWL/genthat-gen_from… /home/rstudio/tmp/Rv… 0.00855 72.5extra_test_code <- paste0("genthat::test_generated_file('", result$output, "')", collapse="\n")
cat(extra_test_code)## genthat::test_generated_file('/home/rstudio/tmp/Rvmmin/Rvmmin/test-7.R')
## genthat::test_generated_file('/home/rstudio/tmp/Rvmmin/Rvmmin/test-2.R')
## genthat::test_generated_file('/home/rstudio/tmp/Rvmmin/Rvmmin/test-4.R')
## genthat::test_generated_file('/home/rstudio/tmp/Rvmmin/Rvmmin/test-22.R')
## genthat::test_generated_file('/home/rstudio/tmp/Rvmmin/Rvmminu/test-35.R')
## genthat::test_generated_file('/home/rstudio/tmp/Rvmmin/Rvmmin/test-24.R')
## genthat::test_generated_file('/home/rstudio/tmp/Rvmmin/Rvmmin/test-12.R')
## genthat::test_generated_file('/home/rstudio/tmp/Rvmmin/Rvmminb/test-12.R')Check code coverage with genthat tests:
genthat_coverage <- package_coverage("packages/Rvmmin", type="tests", code=extra_test_code)
genthat_coverage## Rvmmin Coverage: 72.66%## R/Rvmminb.R: 70.92%## R/Rvmminu.R: 70.95%## R/Rvmmin.R: 88.68%Some statisticts: - all: number of captured unique function calls - number of traces - generated: number of traces which were successfully turned into tests - ran: number of passed tests - kept: number of tests that increase coverage - elapsed: tim to run the kept tests
attr(result, "stats")## all generated ran kept coverage elapsed
## 334.0000000 334.0000000 69.0000000 8.0000000 72.4770642 0.7402265The errors to see why the on-ran tests failed:
head(attr(result, "errors"))## file
## 1 /tmp/RtmpXYedWL/genthat-gen_from_packageda5836b5c4/examples/Rvmmin.Rd.R
## 2 /tmp/RtmpXYedWL/genthat-gen_from_packageda5836b5c4/examples/Rvmmin.Rd.R
## 3 /tmp/RtmpXYedWL/genthat-gen_from_packageda5836b5c4/examples/Rvmmin.Rd.R
## 4 /tmp/RtmpXYedWL/genthat-gen_from_packageda5836b5c4/examples/Rvmmin.Rd.R
## 5 /tmp/RtmpXYedWL/genthat-gen_from_packageda5836b5c4/examples/Rvmmin.Rd.R
## 6 /tmp/RtmpXYedWL/genthat-gen_from_packageda5836b5c4/examples/Rvmmin.Rd.R
## output
## 1 NA
## 2 NA
## 3 NA
## 4 NA
## 5 NA
## 6 NA
## error
## 1 Test failed: 'Rvmmin'\n* Rvmmin:::Rvmmin(par = xx, fn = genrose.f, gr = "grfwd", gs = 10) not equal to list(...).\nComponent “counts”: Mean relative difference: 0.2335329
## 2 Test failed: 'Rvmmin'\n* Rvmmin:::Rvmmin(...) not equal to list(...).\nComponent “counts”: Mean relative difference: 0.1904762
## 3 Test failed: 'Rvmmin'\n* Rvmmin:::Rvmmin(...) not equal to list(...).\nComponent “counts”: Mean relative difference: 0.3552632
## 4 Test failed: 'Rvmmin'\n* Rvmmin:::Rvmmin(...) not equal to list(...).\nComponent “counts”: Mean relative difference: 0.1923077
## 5 Test failed: 'Rvmmin'\n* Rvmmin:::Rvmmin(par = xx, fn = genrose.f, gs = 10) not equal to list(...).\nComponent “counts”: Mean relative difference: 0.09859155
## 6 Test failed: 'Rvmmin'\n* Rvmmin:::Rvmmin(...) not equal to list(...).\nComponent “counts”: Mean relative difference: 0.4310345Running the code from reverse dependencies:
rdeps <- tools::package_dependencies(
"Rvmmin",
which=c("Depends", "Imports", "LinkingTo", "Suggests"),
reverse=TRUE,
recursive=FALSE
)
rdeps <- unlist(rdeps, use.names=FALSE)
rdeps## [1] "nlmrt" "nlsr" "optimr" "optimx"result_rdeps <-
gen_from_package(
pkgs_to_trace="Rvmmin",
pkgs_to_run=c("Rvmmin", rdeps),
types="all", action="generate", prune_tests=TRUE, output_dir="tmp")coverage_rdeps <- compute_coverage(attr(result_rdeps, "raw_coverage"))
attr(result_rdeps, "stats")## all generated ran kept coverage elapsed
## 371.0000000 371.0000000 85.0000000 11.0000000 73.5779817 0.3710217