Fix type errors in checkVersions() that caused addPackages() to fail. #…

…99

R/addPackages.R

@@ -26,7 +26,7 @@ checkVersions <- function(pkgs = NULL, path = NULL, type = "source",
   if (is.null(path)) stop("path must be specified.")
   if (!file.exists(path)) stop("invalid path, ", path)
 
-  duplicatePkgs <- sapply(type, function(type) {
+  do_one <- function(type) {
     pkgPath <- repoBinPath(path, type, Rversion)
     if (is.null(pkgs)) {
       files <- dir(pkgPath)
@@ -35,15 +35,17 @@ checkVersions <- function(pkgs = NULL, path = NULL, type = "source",
     }
     files <- unlist(files)
     pkgFiles <- grep("\\.(tar\\.gz|zip|tgz)$", basename(files), value = TRUE)
-
+    
     # identify duplicate packages and warn the user
     pkgs <- sapply(strsplit(files, "_"), "[[", 1)
     dupes <- pkgs[duplicated(pkgs)]
     if (length(dupes)) warning("Duplicate package(s): ", paste(dupes, collapse = ", "))
     file.path(pkgPath, pkgFiles)
-  })
+  }
+
+  duplicatePkgs <- sapply(type, do_one, simplify = FALSE)
   names(duplicatePkgs) <- type
-  return(invisible(duplicatePkgs))
+  duplicatePkgs
 }
 
 
@@ -72,31 +74,41 @@ addPackage <- function(pkgs = NULL, path = NULL, repos = getOption("repos"),
                        writePACKAGES = TRUE, deps = TRUE, quiet = FALSE) {
   if (is.null(path) || is.null(pkgs)) stop("path and pkgs must both be specified.")
 
-  lapply(type, function(t) {
+  do_one <- function(t) {
     prev <- checkVersions(pkgs = pkgs, path = path, type = t, Rversion = Rversion)
+    prev <- prev[[1]]
     prev.df <- getPkgVersFromFile(prev)
-
+    
     if (deps) pkgs <- pkgDep(pkgs, repos = repos, type = t, Rversion = Rversion)
-
+    
     makeRepo(pkgs = pkgs, path = path, repos = repos, type = t, Rversion = Rversion,
              download = TRUE, writePACKAGES = FALSE, quiet = quiet)
-
+    
     if (length(prev)) {
       curr <- suppressWarnings(
         checkVersions(pkgs = pkgs, path = path, type = t, Rversion = Rversion)
       )
+      curr <- curr[[1]]
       curr.df <- getPkgVersFromFile(curr)
-
+
+      findPrevPackage <- function(x) {
+        grep(paste0("^", x), basename(prev)) 
+        }
+
       dupes <- with(curr.df, package[duplicated(package)])
       if (length(dupes)) {
-        old <- lapply(dupes, function(x) { grep(paste0("^", x), basename(prev)) } )
-        file.remove(prev[unlist(old)])
+        to_remove <- lapply(dupes, findPrevPackage)
+        if(length(unlist(to_remove))){
+          file.remove(prev[unlist(to_remove)])
+        }
       }
     }
-  })
+  }
+
+  lapply(type, do_one)
 
   n <- if (writePACKAGES) updateRepoIndex(path = path, type = type, Rversion = Rversion)
-  return(invisible(n))
+  invisible(n)
 }
 
 
@@ -142,11 +154,13 @@ addOldPackage <- function(pkgs = NULL, path = NULL, vers = NULL,
 
   pkgPath <- repoBinPath(path = path, type = type, Rversion = Rversion)
   if (!file.exists(pkgPath)) dir.create(pkgPath, recursive = TRUE)
-  sapply(oldPkgs, function(x) {
+
+  do_one <- function(x) {
     result <- utils::download.file(x, destfile = file.path(pkgPath, basename(x)),
                                    method = "auto", mode = "wb", quiet = quiet)
     if (result != 0) warning("error downloading file ", x)
-  })
+  }
+  sapply(oldPkgs, do_one)
   if (writePACKAGES) invisible(updateRepoIndex(path = path, type = type, Rversion))
 }
 

R/updatePackages.R

@@ -73,7 +73,8 @@ oldPackages <- function(path = NULL, repos = getOption("repos"),
 updatePackages <- function(path = NULL, repos = getOption("repos"), method, ask = TRUE,
                            availPkgs = pkgAvail(repos = repos, type = type, Rversion = Rversion),
                            oldPkgs = NULL, type = "source", Rversion = R.version, quiet = FALSE) {
-  lapply(type, function(t) {
+
+  do_one <- function(t){
     force(ask)
     simplifyRepos <- function(repos, t) {
       tail <- substring(contribUrl("---", type = t, Rversion = Rversion), 4)
@@ -137,5 +138,7 @@ updatePackages <- function(path = NULL, repos = getOption("repos"), method, ask
       addPackage(update[, "Package"], path = path, repos = repos, type = t,
                  quiet = quiet, deps = FALSE, Rversion = Rversion)
     }
-  })
+  }
+
+  lapply(type, do_one)
 }

tests/testthat/test-5-updateRepo.R

@@ -17,7 +17,9 @@ if (!is.online(revolution, tryHttp = FALSE)) {
 rvers <- "3.1"
 pkgs <- c("chron", "adaptivetau")
 
-types <- c("source", "win.binary", "mac.binary")
+types <- c("win.binary", "mac.binary", "source")
+# types <- c("win.binary")
+
 names(types) <- types
 
 test_that("sample repo is setup correctly", {
@@ -39,8 +41,9 @@ test_that("sample repo is setup correctly", {
 
 # Add packages to repo ----------------------------------------------------
 
-pkgsAdd <- c("aprof")
+pkgsAdd <- c("forecast")
 
+pkg_type <- names(types)[1]
 for (pkg_type in names(types)) {
 
   context(sprintf(" - Add packages to repo (%s)", pkg_type))
@@ -112,9 +115,7 @@ for (pkg_type in names(types)) {
     expect_true(
       file.copy(from = f, to = file.path(tmpdir, "MASS_7.3-0.tar.gz"))
     )
-    expect_true(
-      length(list.files(tmpdir)) == 2
-    )
+    expect_equal(length(list.files(tmpdir)), 2)
 
     addLocalPackage(pkgs = pkgsAddLocal, pkgPath = tmpdir, path = repo_root,
                     type = pkg_type, quiet = TRUE, Rversion = rvers)
@@ -139,7 +140,7 @@ for (pkg_type in names(types)) {
 # Check for updates -------------------------------------------------------
 
 
-MRAN_mirror <- MRAN("2014-12-01")
+MRAN_mirror <- MRAN("2015-01-01")
 if (!is.online(MRAN_mirror, tryHttp = FALSE)) {
   # Use http:// for older versions of R
   MRAN_mirror <- sub("^https://", "http://", revolution)
@@ -157,21 +158,30 @@ for (pkg_type in names(types)) {
     prefix <- repoPrefix(pkg_type, Rversion = rvers)
 
     suppressWarnings(
-    old <- oldPackages(path = repo_root, repos = MRAN_mirror, 
-                       type = pkg_type, Rversion = rvers,
-                       quiet = FALSE)
+      old <- oldPackages(path = repo_root, repos = MRAN_mirror, 
+                         type = pkg_type, Rversion = rvers,
+                         quiet = FALSE)
     )
 
-    expect_equal(nrow(old), 2)
+    # In the following allow for differences between mac.binary and other types
+    expect_true(nrow(old) >= 10)
+    expect_true(nrow(old) <= 12)
     expect_equal(ncol(old), 4)
-    expect_equal(rownames(old), c("adaptivetau", "aprof"))
+    expect_true(
+      all(
+        rownames(old) %in% 
+          c("adaptivetau", "BH", "digest", "forecast", "Hmisc", "mvtnorm", 
+            "RColorBrewer", "RcppArmadillo", "reshape2", "timeDate", 
+            "timeSeries", "tis")
+      )
+    )
 
     updatePackages(path = repo_root, repos = MRAN_mirror, type = pkg_type,
                    ask = FALSE, quiet = TRUE, Rversion = rvers)
 
     updateVers <- getPkgVersFromFile(
       list.files(file.path(repo_root, prefix))
-      )
+    )
 
     expect_true(
       .checkForRepoFiles(repo_root, pkgList[[pkg_type]], prefix)
@@ -202,8 +212,8 @@ for (pkg_type in names(types)) {
     skip_on_cran()
     skip_if_offline(MRAN_mirror)
 
-    oldVersions <- list(package = c("aprof"),
-                        version = c("0.2.1"))
+    oldVersions <- list(package = c("acepack"),
+                        version = c("1.3-2"))
     if (pkg_type != "source") {
       expect_error(
         addOldPackage(oldVersions[["package"]], path = repo_root, 
@@ -215,7 +225,7 @@ for (pkg_type in names(types)) {
                     vers = oldVersions[["version"]],
                     repos = MRAN_mirror, type = pkg_type)
       files <- suppressWarnings(
-        checkVersions(path = repo_root, type = pkg_type)
+        checkVersions(path = repo_root, type = pkg_type)[[pkg_type]]
       )
 
       expect_true(