diff --git a/R/install-version.R b/R/install-version.R index d2956c7f..ff99b34f 100644 --- a/R/install-version.R +++ b/R/install-version.R @@ -103,13 +103,38 @@ download_version <- function(package, version = NULL, download_version_url <- function(package, version, repos, type) { + filters <- getOption("available_packages_filters") + if (is.null(filters)) { + filters <- c("R_version", "OS_type", "subarch") + } else { + filters <- setdiff(filters, "duplicates") + } + contriburl <- contrib.url(repos, type) - available <- available.packages(contriburl) + available <- available.packages(contriburl, filters = filters) if (package %in% row.names(available)) { - current.version <- available[package, 'Version'] - if (is.null(version) || version == current.version) { - row <- available[which(rownames(available) == package)[1], ] + the_package <- row.names(available) == package + if (is.null(version)) { + available <- available[the_package, , drop = FALSE] + # Sort by version if there are duplicates + for (i in seq_len(nrow(available) - 1L)) { + j <- i + 1L + if (compareVersion(available[i, "Version"], available[j, "Version"]) > 0) { + available[c(i, j), ] <- available[c(j, i), ] + } + } + row <- available[nrow(available), ] + } else { + the_version <- available[, "Version"] == version + available <- available[the_package & the_version, , drop = FALSE] + if (nrow(available) > 0) { + row <- available[1L, ] + } else { + row <- NULL + } + } + if (!is.null(row)) { return(paste0( row[["Repository"]], "/", diff --git a/tests/testthat/test-install-version.R b/tests/testthat/test-install-version.R index 73ea764f..aba234be 100644 --- a/tests/testthat/test-install-version.R +++ b/tests/testthat/test-install-version.R @@ -127,6 +127,108 @@ test_that("install_version for archived packages", { ) }) +test_that("install_version with specific version on duplicating repository", { + + skip_on_cran() + skip_if_offline() + + Sys.unsetenv("R_TESTS") + + # path to install + lib <- tempfile() + setup(dir.create(lib)) + teardown(unlink(lib, recursive = TRUE)) + + # path to local repository + local_cran <- tempfile("testdir") + contrib <- file.path(local_cran, "src", "contrib") + setup(dir.create(contrib, recursive = TRUE)) + teardown(unlink(local_cran, recursive = TRUE)) + + # create local repository + download_rstudioapi <- function(version) { + filename <- sprintf("rstudioapi_%s.tar.gz", version) + url <- sprintf("https://cloud.r-project.org/src/contrib/Archive/rstudioapi/%s", filename) + destfile <- file.path(contrib, filename) + download.file(url, destfile = destfile) + } + download_rstudioapi("0.1") + download_rstudioapi("0.10") + download_rstudioapi("0.3.1") + download_rstudioapi("0.5") + tools::write_PACKAGES(contrib, latestOnly = FALSE) + + # set CRAN mirror + repos <- getOption("repos") + if (length(repos) == 0) repos <- character() + repos[repos == "@CRAN@"] <- + if (.Platform$OS.type == "windows") { + sprintf("file:///%s", gsub("\\\\", "/", local_cran)) + } else { + sprintf("file://%s", local_cran) + } + + # run test + install_version("rstudioapi", lib = lib, repos = repos, quiet = TRUE) + expect_silent(packageDescription("rstudioapi", lib.loc = lib)) + desc <- packageDescription("rstudioapi", lib.loc = lib) + expect_equal(desc$Version, "0.10") + expect_null(desc$RemoteType) + expect_null(desc$RemoteSubdir) + expect_null(desc$RemoteUrl) +}) + +test_that("install_version latest version on duplicating repository", { + + skip_on_cran() + skip_if_offline() + + Sys.unsetenv("R_TESTS") + + # path to install + lib <- tempfile() + setup(dir.create(lib)) + teardown(unlink(lib, recursive = TRUE)) + + # path to local repository + local_cran <- tempfile("testdir") + contrib <- file.path(local_cran, "src", "contrib") + setup(dir.create(contrib, recursive = TRUE)) + teardown(unlink(local_cran, recursive = TRUE)) + + # create local repository + download_rstudioapi <- function(version) { + filename <- sprintf("rstudioapi_%s.tar.gz", version) + url <- sprintf("https://cloud.r-project.org/src/contrib/Archive/rstudioapi/%s", filename) + destfile <- file.path(contrib, filename) + download.file(url, destfile = destfile) + } + download_rstudioapi("0.1") + download_rstudioapi("0.10") + download_rstudioapi("0.3.1") + download_rstudioapi("0.5") + tools::write_PACKAGES(contrib, latestOnly = FALSE) + + # set CRAN mirror + repos <- getOption("repos") + if (length(repos) == 0) repos <- character() + repos[repos == "@CRAN@"] <- + if (.Platform$OS.type == "windows") { + sprintf("file:///%s", gsub("\\\\", "/", local_cran)) + } else { + sprintf("file://%s", local_cran) + } + + # run test + install_version("rstudioapi", "0.3.1", lib = lib, repos = repos, quiet = TRUE) + expect_silent(packageDescription("rstudioapi", lib.loc = lib)) + desc <- packageDescription("rstudioapi", lib.loc = lib) + expect_equal(desc$Version, "0.3.1") + expect_null(desc$RemoteType) + expect_null(desc$RemoteSubdir) + expect_null(desc$RemoteUrl) +}) + test_that("install_version for other types fails", { expect_error( install_version("igraph0", type = "binary"),