Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- #library(devtools)
- devtools::load_all()
- #' # Testing revdep_check()
- #'
- #' Functions:
- create_deps_tested <- function() {
- deps <- list(
- testee = character(),
- revdep1 = c("testee", "revdep1.dep"),
- revdep1.dep = c("revdep1.dep.dep")
- )
- pkgs <- pkgs_from_deps(deps)
- combs <- combinat::permn(length(pkgs))
- combs_tested <- sample(combs, N_TESTED)
- combs_tested_recode <- lapply(combs_tested, function(x) setNames(paste0("p", x, ".", pkgs), pkgs))
- deps_tested <- lapply(
- combs_tested_recode,
- function(recode) {
- deps_recode <- deps
- names(deps_recode) <- unname(recode[names(deps_recode)])
- deps_recode <- lapply(deps_recode, function(x) unname(recode[x]))
- deps_recode
- }
- )
- deps_tested
- }
- pkgs_from_deps <- function(deps) {
- unique(c(names(deps), unlist(deps)))
- }
- create_pkgs <- function(root, deps) {
- pkgs <- pkgs_from_deps(deps)
- lapply(
- setNames(nm = pkgs),
- function(pkg) {
- path <- file.path(root, pkg)
- create(path, rstudio = FALSE, quiet = TRUE)
- add_imports(path, deps[[pkg]])
- path
- }
- )
- }
- add_imports <- function(path, imports) {
- d <- desc::description$new(path)
- if (length(imports) > 0) {
- d$set_dep(imports)
- d$write()
- }
- d
- }
- initialize_scenario <- function(current_dep) {
- current_revdep_dir <- file.path(revdep_dir, current_dep)
- unlink(current_revdep_dir, force = TRUE)
- dir.create(current_revdep_dir)
- deps <- deps_tested[[current_dep]]
- pkg_paths <- create_pkgs(current_revdep_dir, deps)
- built_paths <- vapply(pkg_paths, devtools::build, quiet = TRUE, character(1))
- repo_dir <- file.path(current_revdep_dir, "repo")
- dir.create(repo_dir)
- contrib_dir <- file.path(repo_dir, "src", "contrib")
- dir.create(contrib_dir, recursive = TRUE)
- file.copy(built_paths, contrib_dir)
- tools::write_PACKAGES(contrib_dir)
- lib_dir <- file.path(current_revdep_dir, "lib")
- dir.create(lib_dir)
- tibble::lst(
- id = current_dep,
- deps = deps_tested[[current_dep]],
- revdep_pkg = pkg_paths[[1]],
- repo_dir,
- contrib_dir,
- lib_dir
- )
- }
- test_scenario <- function(scenario) {
- rule("Testing scenario ", scenario$id, pad = "*")
- rule(format_deps(scenario$deps), pad = "*")
- testthat::with_mock(
- `devtools::cran_packages` = function() available.packages(contriburl = file_url(scenario$contrib_dir)),
- `devtools::cran_mirror` = function() file_url(scenario$repo_dir),
- withr::with_options(
- list(repos = paste0("file://", normalizePath(scenario$repo_dir, winslash = "/"))),
- {
- revdep_check_reset(scenario$revdep_pkg)
- revdep_check(scenario$revdep_pkg, libpath = normalizePath(scenario$lib_dir))
- revdep_check_save_summary(scenario$revdep_pkg)
- }
- )
- )
- rule("Finished testing scenario ", scenario$id, pad = "*")
- message()
- }
- format_deps <- function(deps) {
- deps <- deps[vapply(deps, length, integer(1)) != 0]
- dep1 <- paste0("(", vapply(deps, paste, collapse = ", ", character(1)), ")")
- paste0(names(deps), " -> ", dep1, collapse = "; ")
- }
- file_url <- function(path) {
- paste0("file://", normalizePath(path, winslash = "/"))
- }
- #' For reproducibility:
- set.seed(123)
- #' Creating three scenarios: Same dependency structure, different ordering
- #' of package names.
- N_TESTED <- 3
- #' Clean start:
- revdep_dir <- "test-revdep"
- unlink(revdep_dir, recursive = TRUE, force = TRUE)
- dir.create(revdep_dir)
- #' Create dependency structures with mingled ordering:
- deps_tested <- create_deps_tested()
- #' Create scenarios:
- #' - Package sources
- #' - Built packages
- #' - CRAN-like repository
- #' - Revdep library
- scenarios <- lapply(seq_along(deps_tested), initialize_scenario)
- #' Test all scenarios:
- invisible(lapply(scenarios, test_scenario))
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement