Advertisement
Guest User

Untitled

a guest
Aug 24th, 2016
58
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 3.66 KB | None | 0 0
  1. #library(devtools)
  2. devtools::load_all()
  3.  
  4. #' # Testing revdep_check()
  5. #'
  6. #' Functions:
  7.  
  8. create_deps_tested <- function() {
  9. deps <- list(
  10. testee = character(),
  11. revdep1 = c("testee", "revdep1.dep"),
  12. revdep1.dep = c("revdep1.dep.dep")
  13. )
  14.  
  15. pkgs <- pkgs_from_deps(deps)
  16.  
  17. combs <- combinat::permn(length(pkgs))
  18.  
  19. combs_tested <- sample(combs, N_TESTED)
  20.  
  21. combs_tested_recode <- lapply(combs_tested, function(x) setNames(paste0("p", x, ".", pkgs), pkgs))
  22.  
  23. deps_tested <- lapply(
  24. combs_tested_recode,
  25. function(recode) {
  26. deps_recode <- deps
  27. names(deps_recode) <- unname(recode[names(deps_recode)])
  28. deps_recode <- lapply(deps_recode, function(x) unname(recode[x]))
  29. deps_recode
  30. }
  31. )
  32.  
  33. deps_tested
  34. }
  35.  
  36. pkgs_from_deps <- function(deps) {
  37. unique(c(names(deps), unlist(deps)))
  38. }
  39.  
  40. create_pkgs <- function(root, deps) {
  41. pkgs <- pkgs_from_deps(deps)
  42.  
  43. lapply(
  44. setNames(nm = pkgs),
  45. function(pkg) {
  46. path <- file.path(root, pkg)
  47. create(path, rstudio = FALSE, quiet = TRUE)
  48. add_imports(path, deps[[pkg]])
  49. path
  50. }
  51. )
  52. }
  53.  
  54. add_imports <- function(path, imports) {
  55. d <- desc::description$new(path)
  56. if (length(imports) > 0) {
  57. d$set_dep(imports)
  58. d$write()
  59. }
  60. d
  61. }
  62.  
  63. initialize_scenario <- function(current_dep) {
  64. current_revdep_dir <- file.path(revdep_dir, current_dep)
  65. unlink(current_revdep_dir, force = TRUE)
  66. dir.create(current_revdep_dir)
  67.  
  68. deps <- deps_tested[[current_dep]]
  69.  
  70. pkg_paths <- create_pkgs(current_revdep_dir, deps)
  71. built_paths <- vapply(pkg_paths, devtools::build, quiet = TRUE, character(1))
  72.  
  73. repo_dir <- file.path(current_revdep_dir, "repo")
  74. dir.create(repo_dir)
  75.  
  76. contrib_dir <- file.path(repo_dir, "src", "contrib")
  77. dir.create(contrib_dir, recursive = TRUE)
  78.  
  79. file.copy(built_paths, contrib_dir)
  80. tools::write_PACKAGES(contrib_dir)
  81.  
  82. lib_dir <- file.path(current_revdep_dir, "lib")
  83. dir.create(lib_dir)
  84.  
  85. tibble::lst(
  86. id = current_dep,
  87. deps = deps_tested[[current_dep]],
  88. revdep_pkg = pkg_paths[[1]],
  89. repo_dir,
  90. contrib_dir,
  91. lib_dir
  92. )
  93. }
  94.  
  95. test_scenario <- function(scenario) {
  96. rule("Testing scenario ", scenario$id, pad = "*")
  97. rule(format_deps(scenario$deps), pad = "*")
  98. testthat::with_mock(
  99. `devtools::cran_packages` = function() available.packages(contriburl = file_url(scenario$contrib_dir)),
  100. `devtools::cran_mirror` = function() file_url(scenario$repo_dir),
  101. withr::with_options(
  102. list(repos = paste0("file://", normalizePath(scenario$repo_dir, winslash = "/"))),
  103. {
  104. revdep_check_reset(scenario$revdep_pkg)
  105. revdep_check(scenario$revdep_pkg, libpath = normalizePath(scenario$lib_dir))
  106. revdep_check_save_summary(scenario$revdep_pkg)
  107. }
  108. )
  109. )
  110.  
  111. rule("Finished testing scenario ", scenario$id, pad = "*")
  112. message()
  113. }
  114.  
  115. format_deps <- function(deps) {
  116. deps <- deps[vapply(deps, length, integer(1)) != 0]
  117. dep1 <- paste0("(", vapply(deps, paste, collapse = ", ", character(1)), ")")
  118. paste0(names(deps), " -> ", dep1, collapse = "; ")
  119. }
  120.  
  121. file_url <- function(path) {
  122. paste0("file://", normalizePath(path, winslash = "/"))
  123. }
  124.  
  125.  
  126. #' For reproducibility:
  127.  
  128. set.seed(123)
  129.  
  130. #' Creating three scenarios: Same dependency structure, different ordering
  131. #' of package names.
  132.  
  133. N_TESTED <- 3
  134.  
  135. #' Clean start:
  136.  
  137. revdep_dir <- "test-revdep"
  138. unlink(revdep_dir, recursive = TRUE, force = TRUE)
  139. dir.create(revdep_dir)
  140.  
  141. #' Create dependency structures with mingled ordering:
  142.  
  143. deps_tested <- create_deps_tested()
  144.  
  145. #' Create scenarios:
  146. #' - Package sources
  147. #' - Built packages
  148. #' - CRAN-like repository
  149. #' - Revdep library
  150.  
  151. scenarios <- lapply(seq_along(deps_tested), initialize_scenario)
  152.  
  153. #' Test all scenarios:
  154.  
  155. invisible(lapply(scenarios, test_scenario))
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement