Skip to content

Commit

Permalink
Merge branch '99-addPackage-fail' into dev
Browse files Browse the repository at this point in the history
* 99-addPackage-fail:
  Fix type errors in checkVersions() that caused addPackages() to fail. #99
  • Loading branch information
andrie committed Oct 20, 2017
2 parents d699466 + 917c0b5 commit 71d11a0
Show file tree
Hide file tree
Showing 3 changed files with 59 additions and 32 deletions.
44 changes: 29 additions & 15 deletions R/addPackages.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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
}


Expand Down Expand Up @@ -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)
}


Expand Down Expand Up @@ -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)

This comment has been minimized.

Copy link
@mungojam

mungojam Oct 21, 2017

Contributor

Does this one need a simplify = FALSE too?

This comment has been minimized.

Copy link
@andrie

andrie Oct 21, 2017

Author Owner

In some ways I'm indifferent about this one, since the result is not being used.

However, there is another problem here: the return value of the function will sometimes be the result of sapply() (which itself can vary) and sometimes be the result of updateRepoIndex().

That is just bad practise, and we should define what the result should be, and always return that.

if (writePACKAGES) invisible(updateRepoIndex(path = path, type = type, Rversion))
}

Expand Down
7 changes: 5 additions & 2 deletions R/updatePackages.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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)
}
40 changes: 25 additions & 15 deletions tests/testthat/test-5-updateRepo.R
Original file line number Diff line number Diff line change
Expand Up @@ -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", {
Expand All @@ -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))
Expand Down Expand Up @@ -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)
Expand All @@ -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)
Expand All @@ -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)
Expand Down Expand Up @@ -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,
Expand All @@ -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(
Expand Down

0 comments on commit 71d11a0

Please sign in to comment.