Commit 5ce5d5b8 authored by Dorchies David's avatar Dorchies David
Browse files

test: Add regression tests

- Add function that run examples and store results in RDS files for CRAN and dev versions of airGR package
- Add test for comparing the 2 versions of results files

Refs #59
parent 40187eae
StoreRefExampleResults <- function(package, ...) {
install.packages(package)
StoreExampleResults(package = package, path = "tests/tmp/ref", ...)
}
StoreTestExampleResults <- function(package, ...) {
StoreExampleResults(package = package, path = "tests/tmp/test", ...)
}
#' Run examples of a package and store the output variables in RDS files for further testing.
#'
#' @param package Name of the package from which examples are tested.
#' @param path Path where to record the files.
#' @param run.dontrun See \code{\link{example}}.
#' @param run.donttest See \code{\link{example}}.
#'
#' @return
#' @export
#'
#' @examples
StoreExampleResults <- function(package, path, run.dontrun = FALSE, run.donttest = TRUE) {
# Install and load stable version of the package
library(package, character.only = TRUE)
# Get the list of documentation pages
rd <- unique(readRDS(system.file("help", "aliases.rds", package = package)))
dir.create(path, showWarnings = FALSE)
lapply(
rd,
StoreTopicResults,
package, path, run.dontrun = run.dontrun, run.donttest = run.donttest
)
}
StoreTopicResults <- function(topic, package, path, run.dontrun = TRUE, run.donttest = TRUE) {
cat("*******************************\n")
cat("*", topic, "\n")
cat("*******************************\n")
par(ask=F) #https://stackoverflow.com/questions/34756905/how-to-turn-off-the-hit-return-to-see-next-plot-prompt-plot3d
varBefore <- c()
varBefore <- ls(envir = globalenv())
example(
topic, package = package, character.only = TRUE, echo = FALSE, ask = FALSE, local = FALSE, setRNG = TRUE,
run.dontrun = run.dontrun, run.donttest = run.donttest
)
dev.off()
varAfter <- ls(envir = globalenv())
varToSave <- setdiff(varAfter, varBefore)
if(length(varToSave) > 0) {
path <- file.path(path, topic)
dir.create(path, showWarnings = FALSE, recursive = TRUE)
lapply(varToSave, function(x) {
saveRDS(get(x), file = file.path(path, paste0(x, ".rds")))
})
}
rm(list = varToSave, envir = globalenv())
}
context("Compare example outputs with CRAN")
CompareWithRef <- function(refVarFile, testDir, regIgnore) {
v <- data.frame(
topic = basename(dirname(refVarFile)),
var = gsub("\\.rds$", "", basename(refVarFile))
)
if(is.null(regIgnore) || all(apply(regIgnore, 1, function(x) {!all(x == v)}))) {
test_that(paste("Compare", v$topic, v$var), {
skip_on_cran()
testVarFile <- paste0("../tmp/test/", file.path(v$topic, v$var), ".rds")
expect_true(file.exists(testVarFile))
if(file.exists(testVarFile)) {
testVar <- readRDS(testVarFile)
refVar <- readRDS(refVarFile)
expect_equivalent(testVar, refVar)
}
})
}
}
if(dir.exists("../tmp/ref") & dir.exists("../tmp/test")) {
refVarFiles <- list.files("../tmp/ref", recursive = TRUE, full.names = TRUE)
regIgnoreFile <- "../../.regressionignore2"
if(file.exists(regIgnoreFile)) {
regIgnore <- read.table(
file = regIgnoreFile,
sep = " ", header = FALSE, skip = 5, col.names = c("topic", "var"),
stringsAsFactors = FALSE
)
} else {
regIgnore <- NULL
}
lapply(X = refVarFiles, CompareWithRef, testDir = "../tmp/test", regIgnore = regIgnore)
} else {
warning("Regression tests compared to released version needs that you run the following instructions first:\n",
"Rscript -e 'source(\"tests/testthat/store_examples.R\"); StoreRefExampleResults(\"airGR\");'\n",
"R CMD INSTALL .\n",
"Rscript -e 'source(\"tests/testthat/store_examples.R\"); StoreTestExampleResults(\"airGR\");'\n")
}
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment