75 lines
2.5 KiB
R
75 lines
2.5 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]
|
|
}
|