pat-s
c3e95f7c69Decide the already-built candidates from one listing per slot and one ABI-verdict query instead of a DB connection and several S3 requests per package; anything undecidable still goes through bincraft.
114 lines
4 KiB
R
114 lines
4 KiB
R
# Evaluate every R constraint, including patch-level and upper bounds.
|
|
r_requirement_satisfied <- function(depends, r_version) {
|
|
if (is.na(depends) || !nzchar(trimws(depends))) {
|
|
return(TRUE)
|
|
}
|
|
entries <- trimws(strsplit(depends, ",", fixed = TRUE)[[1L]])
|
|
entries <- entries[grepl("^R(\\s|\\(|$)", entries)]
|
|
all(vapply(
|
|
entries,
|
|
function(entry) {
|
|
if (entry == "R") {
|
|
return(TRUE)
|
|
}
|
|
match <- regmatches(
|
|
entry,
|
|
regexec(
|
|
"^R\\s*\\(\\s*(>=|<=|==|>|<)\\s*([0-9]+(?:[.-][0-9]+)*)\\s*\\)$",
|
|
entry,
|
|
perl = TRUE
|
|
)
|
|
)[[1L]]
|
|
if (length(match) != 3L) {
|
|
stop("Cannot parse R dependency: ", entry)
|
|
}
|
|
comparison <- utils::compareVersion(r_version, match[3L])
|
|
switch(
|
|
match[2L],
|
|
">=" = comparison >= 0L,
|
|
"<=" = comparison <= 0L,
|
|
"==" = comparison == 0L,
|
|
">" = comparison > 0L,
|
|
"<" = comparison < 0L
|
|
)
|
|
},
|
|
logical(1L)
|
|
))
|
|
}
|
|
|
|
# Use unfiltered current CRAN metadata: available.packages() would hide exactly
|
|
# the packages that cannot run under the primary interpreter.
|
|
# Propagate R incompatibility through required dependencies, not Suggests.
|
|
newer_r_candidates <- function(db, primary_r, target_r) {
|
|
db <- as.data.frame(db, stringsAsFactors = FALSE)
|
|
# CRAN also lists R-specific Recommended copies (e.g. Matrix for R-devel).
|
|
# Prefer the ordinary contrib record, or a future-R copy can incorrectly
|
|
# block every package depending on Matrix on all released interpreters.
|
|
if ("Path" %in% names(db)) {
|
|
db <- db[order(!is.na(db$Path) & nzchar(db$Path)), , drop = FALSE]
|
|
}
|
|
db <- db[!duplicated(db$Package), , drop = FALSE]
|
|
deps <- tools::package_dependencies(
|
|
packages = db$Package,
|
|
db = as.matrix(db),
|
|
which = c("Depends", "Imports", "LinkingTo"),
|
|
recursive = FALSE
|
|
)
|
|
supported <- function(version) {
|
|
ok <- vapply(db$Depends, r_requirement_satisfied, logical(1L), version)
|
|
repeat {
|
|
blocked <- db$Package[!ok]
|
|
next_ok <- ok &
|
|
!vapply(deps, function(x) any(x %in% blocked), logical(1L))
|
|
if (identical(ok, next_ok)) {
|
|
return(ok)
|
|
}
|
|
ok <- next_ok
|
|
}
|
|
}
|
|
selected <- !supported(primary_r) & supported(target_r)
|
|
if ("OS_type" %in% names(db)) {
|
|
selected <- selected & (is.na(db$OS_type) | db$OS_type != "windows")
|
|
}
|
|
result <- db[selected, c("Package", "Version"), drop = FALSE]
|
|
result[order(result$Package), , drop = FALSE]
|
|
}
|
|
|
|
# Candidates that still need a build, decided from one bucket listing per slot
|
|
# instead of a metadata-DB connection and several S3 requests per package.
|
|
#
|
|
# Mirrors bincraft's own skip decision: a package is done when a binary sits at
|
|
# the path its cached ABI verdict routes it to, `<slot>/<minor>/` when
|
|
# r-minor-sensitive and the flat `<slot>/` otherwise. A CRAN source sitting at
|
|
# that key is a fallback, not a binary (see outstanding_packages()). Whatever
|
|
# this cannot decide, no cached verdict or a slot that could not be listed,
|
|
# stays in the list, so bincraft makes that call exactly as before.
|
|
#
|
|
# `sensitive` cached verdicts for the current classifier, named `<pkg>_<ver>`
|
|
# `flat_etags` listing of the flat slot as for outstanding_packages(), or
|
|
# NULL when it could not be listed
|
|
# `minor_etags` the same for this interpreter's per-minor slot
|
|
newer_r_outstanding <- function(
|
|
pkgs,
|
|
sensitive,
|
|
flat_etags,
|
|
minor_etags,
|
|
cran_md5
|
|
) {
|
|
verdict <- unname(sensitive[paste(pkgs$Package, pkgs$Version, sep = "_")])
|
|
version <- stats::setNames(pkgs$Version, pkgs$Package)
|
|
keep <- rep(TRUE, nrow(pkgs))
|
|
routes <- list(
|
|
list(sensitive = FALSE, etags = flat_etags),
|
|
list(sensitive = TRUE, etags = minor_etags)
|
|
)
|
|
for (route in routes) {
|
|
idx <- which(verdict %in% route$sensitive)
|
|
if (length(idx) == 0L || is.null(route$etags)) {
|
|
next
|
|
}
|
|
keep[idx] <- pkgs$Package[idx] %in%
|
|
outstanding_packages(pkgs$Package[idx], route$etags, version, cran_md5)
|
|
}
|
|
pkgs[keep, , drop = FALSE]
|
|
}
|