Draft for testing revdep checks: https://github.com/hadley/devtools/issues/1302

test-revdep.R

#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))