diff --git a/R/get_ref.R b/R/get_ref.R index 8319aab1..2bc46d40 100644 --- a/R/get_ref.R +++ b/R/get_ref.R @@ -468,32 +468,37 @@ get_release_date.remote_ref <- function(remote_ref) { #' verdepcheck:::get_cran_data("dplyr") #' verdepcheck:::get_cran_data("SummarizedExperiment") get_cran_data <- function(package) { - cran_archive <- pkgcache::cran_archive_list(packages = package)[, c( - "package", "version", "mtime" - )] - cran_current <- pkgcache::meta_cache_list(packages = package)[, c( - "type", "package", "version", "published" - )] - if (all(is.na(cran_current$published))) { - # workaround of https://github.com/r-lib/pkgcache/issues/109 - if (is.null(pkgenv$cache_db)) { - pkgenv$cache_db <- tools::CRAN_package_db() - } - db <- subset(pkgenv$cache_db, pkgenv$cache_db$Package == package) - cran_current <- data.frame( - type = "cran", - package = package, - version = db$Version, - published = as.POSIXct(db$`Date/Publication`) - ) - } + cran_archive <- pkgcache::cran_archive_list(packages = package)[, c("package", "version", "mtime")] + cran_current <- head( + pkgcache::meta_cache_list(packages = package)[, c("type", "package", "version", "published")], + 1 + ) - # Bioc custom logic as packages in Bioconductor do not return a published date - # this will be immediately obsolete if {pkgcache} starts to return a non-NA value - # note: a date is required for the `min_cohort` strategy - bioc_na_mtime_ix <- is.na(cran_current$published) & cran_current$type == "bioc" - if (NROW(cran_current[bioc_na_mtime_ix, ]) > 0) { - cran_current[bioc_na_mtime_ix, "published"] <- Sys.Date() + # handle missing dates + if (nrow(cran_current > 0)) { + if (is.na(cran_current$published)) { + if (cran_current$type == "cran") { + # in general, this should not happen for cran - https://github.com/r-lib/pkgcache/issues/109 + # this is a temporary workaround + if (is.null(pkgenv$cache_db)) { + pkgenv$cache_db <- tools::CRAN_package_db() + } + db <- subset(pkgenv$cache_db, pkgenv$cache_db$Package == package) + cran_current <- data.frame( + type = "cran", + package = package, + version = db$Version[1], + published = as.POSIXct(db$`Date/Publication`[1]) + ) + } else if (cran_current$type == "bioc") { + cran_current <- data.frame( + type = "bioc", + package = package, + version = cran_current$version, + published = Sys.Date() + ) + } + } } # Remove extra columns diff --git a/R/utils.R b/R/utils.R index 5593412b..89f44219 100644 --- a/R/utils.R +++ b/R/utils.R @@ -36,7 +36,7 @@ get_ppm_snapshot_by_date <- function(date) { # https://github.com/r-lib/pkgcache/issues/110 # uncomment this: pkgcache::repo_resolve(sprintf("PPM@%s", as.character(as.Date(date) + 1))) snaps <- pkgcache::ppm_snapshots() - date_snap <- as.character(snaps[as.Date(snaps$date) > as.Date(date), "date"][1]) + date_snap <- as.character(head(snaps[as.Date(snaps$date) > as.Date(date), "date"], 1)) if (length(date_snap) == 0) { stop("No PPM snapshot found for the given date.") } diff --git a/tests/testthat/test-deps_installation_proposal.R b/tests/testthat/test-deps_installation_proposal.R index d9263da1..8eb903bc 100644 --- a/tests/testthat/test-deps_installation_proposal.R +++ b/tests/testthat/test-deps_installation_proposal.R @@ -289,10 +289,7 @@ test_that("new_min_cohort_deps_installation_proposal correctly handles Bioc pack d_std_path <- local_description(list(SummarizedExperiment = "Import")) - expect_warning( - x <- new_min_cohort_deps_installation_proposal(d_std_path), - "Cannot find PPM snapshot" - ) + x <- new_min_cohort_deps_installation_proposal(d_std_path) withr::defer(unlink(x$get_config()$library)) @@ -309,10 +306,7 @@ test_that("new_min_isolated_deps_installation_proposal correctly handles Bioc pa withr::defer(unlink(x$get_config()$library)) - expect_warning( - test_proposal_common_bioc(x, "SummarizedExperiment"), - "Cannot find PPM snapshot" - ) + test_proposal_common_bioc(x, "SummarizedExperiment") }) test_that("new_release_deps_installation_proposal correctly handles Bioc package", { diff --git a/tests/testthat/test-get_ref.R b/tests/testthat/test-get_ref.R index 6c5ac605..524da724 100644 --- a/tests/testthat/test-get_ref.R +++ b/tests/testthat/test-get_ref.R @@ -24,7 +24,7 @@ test_that("get_release_date.remote_ref_github will only retrieve 1 date for rlan expect_identical(as.Date(result), as.Date("2022-01-20T16:47:02Z")) }) -test_that("get_release_date.remote_ref_github will retrieve missing date (NA) for rlang@0.0.0", { +test_that("get_release_date.remote_ref_github will retrieve missing date (NA) for r-lib/rlang@v0.0.0", { skip_if_offline() skip_if_empty_gh_token() @@ -37,7 +37,7 @@ test_that("get_release_date.remote_ref_github will retrieve missing date (NA) fo expect_s3_class(result, "Date") }) -test_that("get_release_date.remote_ref_cran will retrieve missing date (NA) for rlang@0.0.0", { +test_that("get_release_date.remote_ref_cran will retrieve missing date (NA) for package.does.not.exist@1.1.0", { skip_if_offline() skip_if_empty_gh_token() diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index 1e30911d..6bf3a044 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -101,10 +101,7 @@ test_that("get_ppm_snapshot_by_date will accept NA", { test_that("get_ppm_snapshot_by_date will accept dates in the future", { skip_if_offline() auxiliary_fun <- function(days = 0) { - expect_warning( - expect_latest_ppm(get_ppm_snapshot_by_date(Sys.Date())), - "Cannot find PPM snapshot for date" - ) + expect_latest_ppm(get_ppm_snapshot_by_date(Sys.Date())) } auxiliary_fun(0)