regression.R 3.5 KB
Newer Older
1
2
# Helper functions for regression

3
StoreStableExampleResults <- function(
4
  package = "airGR",
5
6
  path = file.path("tests/tmp", Sys.getenv("R_VERSION"), "stable"),
  ...) {
Dorchies David's avatar
Dorchies David committed
7
  install.packages(package, repos = "http://cran.r-project.org")
8
  StoreExampleResults(package = package, path = path, ...)
Dorchies David's avatar
Dorchies David committed
9
10
}

11
StoreDevExampleResults <- function(
12
13
  package = "airGR",
  path = file.path("tests/tmp", Sys.getenv("R_VERSION"), "dev"),
14
15
  ...) {
  StoreExampleResults(package = package, path = path, ...)
Dorchies David's avatar
Dorchies David committed
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
}

#' 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)
Dorchies David's avatar
Dorchies David committed
33

Dorchies David's avatar
Dorchies David committed
34
35
  # Get the list of documentation pages
  rd <- unique(readRDS(system.file("help", "aliases.rds", package = package)))
Dorchies David's avatar
Dorchies David committed
36

37
  unlink(path, recursive = TRUE)
38
  dir.create(path, recursive = TRUE)
Dorchies David's avatar
Dorchies David committed
39

Dorchies David's avatar
Dorchies David committed
40
  lapply(
Dorchies David's avatar
Dorchies David committed
41
42
    rd,
    StoreTopicResults,
Dorchies David's avatar
Dorchies David committed
43
44
    package, path, run.dontrun = run.dontrun, run.donttest = run.donttest
  )
45

Dorchies David's avatar
Dorchies David committed
46
47
48
}

StoreTopicResults <- function(topic, package, path, run.dontrun = TRUE, run.donttest = TRUE) {
Dorchies David's avatar
Dorchies David committed
49

Dorchies David's avatar
Dorchies David committed
50
51
52
53
  cat("*******************************\n")
  cat("*", topic, "\n")
  cat("*******************************\n")

54
  par(ask = FALSE) #https://stackoverflow.com/questions/34756905/how-to-turn-off-the-hit-return-to-see-next-plot-prompt-plot3d
Dorchies David's avatar
Dorchies David committed
55
56
57
58

  varBefore <- c()
  varBefore <- ls(envir = globalenv())

59
60
  start_time = Sys.time()

Dorchies David's avatar
Dorchies David committed
61
62
63
64
  example(
    topic, package = package, character.only = TRUE, echo = FALSE, ask = FALSE, local = FALSE, setRNG = TRUE,
    run.dontrun = run.dontrun, run.donttest = run.donttest
  )
65
66

  end_time = Sys.time()
Dorchies David's avatar
Dorchies David committed
67
  dev.off()
Dorchies David's avatar
Dorchies David committed
68

69
70
71
72
73
  write.table(data.frame(topic = topic, time = end_time - start_time),
            file.path(path, "timing.csv"),
            row.names = FALSE, col.names = FALSE, quote = FALSE,
            sep = "\t", append = TRUE)

Dorchies David's avatar
Dorchies David committed
74
  varAfter <- ls(envir = globalenv())
Dorchies David's avatar
Dorchies David committed
75

Dorchies David's avatar
Dorchies David committed
76
  varToSave <- setdiff(varAfter, varBefore)
Dorchies David's avatar
Dorchies David committed
77

78
  if (length(varToSave) > 0) {
Dorchies David's avatar
Dorchies David committed
79
80
81
82
83
84
    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")))
    })
  }
Dorchies David's avatar
Dorchies David committed
85

Dorchies David's avatar
Dorchies David committed
86
  rm(list = varToSave, envir = globalenv())
Dorchies David's avatar
Dorchies David committed
87

Dorchies David's avatar
Dorchies David committed
88
89
}

90
CompareStableDev <- function() {
91
92
  res <- testthat::test_file("tests/testthat/regression.R")
  dRes <- as.data.frame(res)
93
  if (any(dRes[, "failed"] > 0) | any(dRes[, "error"])) {
94
95
    quit(status = 1)
  }
96
}
97
98
99
100
101
102
103
104
105
106
107
108
109
110

###############
# MAIN SCRIPT #
###############

# Execute Regression test by comparing RD files stored in folders /tests/tmp/ref and /tests/tmp/test
Args <- commandArgs(trailingOnly = TRUE)

lActions <- list(
  stable = StoreStableExampleResults,
  dev = StoreDevExampleResults,
  compare = CompareStableDev
)

111
if (length(Args) == 1 && Args %in% names(lActions)) {
112
113
114
115
116
117
118
119
120
  lActions[[Args]]()
} else {
  stop("This script should be run with one argument in the command line:\n",
       "`Rscript tests/regression_tests.R [stable|dev|compare]`.\n",
       "Available arguments are:\n",
       "- stable: install stable version from CRAN, run and store examples\n",
       "- dev: install dev version from current directory, run and store examples\n",
       "- compare: stored results of both versions")
}