Commit 74be387b authored by Dorchies David's avatar Dorchies David

test: Implementation of the testthat framework and first tests on vignette execution (failed)

Refs #52
parent 568b1945
# Specific files for airGR
packrat/lib*/
# Compiled files
/src/*.o
/src/*.dll
# Test temporary files
/tests/tmp/
######################################################################################################
### Generic .gitignore for R (source: https://github.com/github/gitignore/blob/master/R.gitignore) ###
######################################################################################################
......@@ -52,3 +59,4 @@ docs/
.vscode/*
*.code-workspace
.history/
.Rproj.user
library(testthat)
library(airgr)
test_check("airgr")
#' Extract chunks from Rmd files (knitr::purl) and source them
#'
#' @param fileRmd Rmd file to
#' @param tmpFolder Folder storing the script containing extracted chunks
#' @param force.eval Force execution of chunks with parameter eval=FALSE
RunRmdChunks <- function(fileRmd,
tmpFolder = "../tmp",
force.eval = FALSE) {
dir.create(tmpFolder, showWarnings = FALSE)
output = file.path(tmpFolder,
gsub("\\.Rmd", "\\.R", basename(fileRmd), ignore.case = TRUE))
knitr::purl(fileRmd, output = output, quiet = TRUE)
sTxt = readLines(output)
if (force.eval) {
sectionLines = grep("^## ----", sTxt)
chunksEvalStart = grep("^## ----.*eval=F", sTxt)
if (length(chunksEvalStart) > 0) {
if (sectionLines[length(sectionLines)] == chunksEvalStart[length(chunksEvalStart)]) {
lastEvalStart = length(chunksEvalStart) - 1
} else {
lastEvalStart = length(chunksEvalStart)
}
# Search for end lines of eval=F chunks
chunksEvalEnd = sectionLines[sapply(chunksEvalStart[1:lastEvalStart], function(x) {which(sectionLines == x)}) + 1] - 1
if(lastEvalStart) {
# Add last line if last chunk is eval=FALSE
chunksEvalEnd = c(chunksEvalEnd, length(sTxt))
}
chunksEvalStart = chunksEvalStart + 1 # Chunks begin one line after the section comment
for (i in 1:length(chunksEvalStart)) {
# Remove comments on eval=F chunk lines
sTxt[chunksEvalStart[i]:chunksEvalEnd[i]] = gsub(pattern = "^## ",
replace = "",
x = sTxt[chunksEvalStart[i]:chunksEvalEnd[i]])
}
}
}
# Remove line of code displaying data
removeFromGrep <- function(pattern, x) {
i <- grep(pattern, x)
if (length(i) > 0) {
x <- x[-i]
}
return(x)
}
sTxt <- removeFromGrep("^summary\\(.*\\)$", sTxt)
sTxt <- removeFromGrep("^str\\(.*\\)$", sTxt)
# Switch echo off for some functions
sTxt = gsub("trace\\s?=\\s?[0-9]+", "trace = 0", sTxt)
# Add parameters to example calls
exLines = grep("^example\\(.*\\)", sTxt)
sTxt[exLines] = paste0(substr(sTxt[exLines], 1, nchar(sTxt[exLines]) - 1), ", local = TRUE, echo = FALSE, verbose = FALSE, ask = FALSE)")
# Remove question "Hit <Return> to see next plot"
sTxt = c("par(ask=F)", sTxt)
# Write the transformed script
writeLines(sTxt, output)
# Silently run the chunks
invisible(capture.output(suppressMessages(suppressWarnings(source(output))), type="output"))
}
context("Test vignette chunks")
test_that("V01_get_started works", {
RunRmdChunks("../../vignettes/V01_get_started.Rmd")
})
test_that("V02.1_param_optim works", {
RunRmdChunks("../../vignettes/V02.1_param_optim.Rmd", force.eval = TRUE)
})
test_that("V02.2_param_mcmc works", {
RunRmdChunks("../../vignettes/V02.2_param_mcmc.Rmd", force.eval = TRUE)
})
test_that("V03_param_sets_GR4J works", {
RunRmdChunks("../../vignettes/V03_param_sets_GR4J.Rmd", force.eval = TRUE)
})
test_that("V04_cemaneige_hysteresis works", {
RunRmdChunks("../../vignettes/V04_cemaneige_hysteresis.Rmd", force.eval = TRUE)
})
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