Skip to content

Commit

Permalink
Merge pull request #51 from wlandau/112
Browse files Browse the repository at this point in the history
_binaries check API
wlandau authored Dec 6, 2024
2 parents d44eace + 596ec83 commit e53c161
Showing 13 changed files with 398 additions and 222 deletions.
3 changes: 2 additions & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
@@ -2,7 +2,7 @@ Package: multiverse.internals
Title: Internal Infrastructure for R-multiverse
Description: R-multiverse requires this internal infrastructure package to
automate contribution reviews and populate universes.
Version: 0.3.1
Version: 0.3.2
License: MIT + file LICENSE
URL:
https://r-multiverse.org/multiverse.internals/,
@@ -37,6 +37,7 @@ Imports:
jsonlite,
nanonext,
pkgsearch,
rversions,
stats,
utils,
vctrs,
2 changes: 2 additions & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
@@ -38,6 +38,8 @@ importFrom(nanonext,ncurl)
importFrom(nanonext,parse_url)
importFrom(nanonext,status_code)
importFrom(pkgsearch,cran_package)
importFrom(rversions,r_release)
importFrom(rversions,r_versions)
importFrom(stats,aggregate)
importFrom(utils,available.packages)
importFrom(utils,compareVersion)
7 changes: 7 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
@@ -1,3 +1,10 @@
# multiverse.internals 0.3.2

* Use the `_binaries` field of the R-universe check API.
* Enforce `R CMD check` errors and warnings.
* Report check errors more clearly.
* Make it easy to add/remove the check platforms and R versions we enforce.

# multiverse.internals 0.3.1

* Add extra checks for `Authors@R` in `assert_parsed_description()`.
43 changes: 25 additions & 18 deletions R/interpret_status.R
Original file line number Diff line number Diff line change
@@ -46,9 +46,9 @@ interpret_advisories <- function(issue) {
return(character(0L))
}
paste0(
"\n\nFound the following advisories in the ",
"R Consortium Advisory Database:\n\n",
as.character(yaml::as.yaml(advisories))
"<br><br>Found the following advisories in the ",
"R Consortium Advisory Database:<br><br>",
as.character(yaml_html(advisories))
)
}

@@ -57,13 +57,15 @@ interpret_checks <- function(issue) {
if (is.null(checks)) {
return(character(0L))
}
checks$url <- sprintf("<a href=\"%s\">%s</a>", checks$url, checks$url)
paste0(
"\n\nNot all checks succeeded on R-universe. ",
"The following output shows the check status on each platform, ",
"the overall build status, and the ",
"build URL. Visit the build URL for specific details ",
"on the check failures.\n\n",
as.character(yaml::as.yaml(checks))
"<br><br>Not all checks succeeded on R-universe. ",
"The following output shows the check status on each enforced platform ",
"and version of R. The GitHub Actions URL links to the check logs ",
"on all platforms that R-universe runs.",
"Visit that URL to see specific details ",
"on the check failures.<br><br>",
as.character(yaml_html(checks))
)
}

@@ -75,7 +77,7 @@ interpret_dependencies <- function(issue, package) {
direct <- names(dependencies)[lengths(dependencies) < 1L]
indirect <- setdiff(names(dependencies), direct)
text <- paste0(
"\n\nOne or more dependencies have issues. Packages ",
"<br><br>One or more dependencies have issues. Packages ",
paste(names(dependencies), collapse = ", "),
" are causing problems upstream. "
)
@@ -102,8 +104,8 @@ interpret_dependencies <- function(issue, package) {
package,
", but ",
ifelse(length(indirect) == 1L, "it is", "they are"),
" upstream of one or more direct dependencies:\n\n",
as.character(yaml::as.yaml(dependencies[indirect]))
" upstream of one or more direct dependencies:<br><br>",
as.character(yaml_html(dependencies[indirect]))
)
}
text
@@ -115,7 +117,7 @@ interpret_licenses <- function(issue, package) {
return(character(0L))
}
paste(
"\n\nPackage",
"<br><br>Package",
package,
"declares license",
shQuote(license),
@@ -134,8 +136,8 @@ interpret_remotes <- function(issue) {
return(character(0L))
}
paste0(
"\n\nPackage releases should not use the 'Remotes:' field. Found:",
as.character(yaml::as.yaml(remotes))
"<br><br>Package releases should not use the 'Remotes:' field. Found:",
as.character(yaml_html(remotes))
)
}

@@ -145,11 +147,16 @@ interpret_versions <- function(issue) {
return(character(0L))
}
paste0(
"\n\nThe version number of the current release ",
"<br><br>The version number of the current release ",
"should be highest version of all the releases so far. ",
"Here is the current version of the package, ",
"the highest version number ever recorded by R-multiverse, ",
"and the latest remote hash of each:\n\n",
as.character(yaml::as.yaml(versions))
"and the latest remote hash of each:<br><br>",
as.character(yaml_html(versions))
)
}

yaml_html <- function(x) {
out <- yaml::as.yaml(x, line.sep = "\n")
gsub(pattern= "\n", replacement = "<br>", x = out)
}
21 changes: 2 additions & 19 deletions R/issues_checks.R
Original file line number Diff line number Diff line change
@@ -18,23 +18,6 @@
#' issues <- issues_checks(meta = meta)
#' str(issues)
issues_checks <- function(meta = meta_checks()) {
fields_check <- c(
"_linuxdevel",
"_macbinary",
"_winbinary",
"_status"
)
fields_info <- c(
"_buildurl"
)
fields <- c(fields_check, fields_info)
for (field in fields) {
meta[[field]][is.na(meta[[field]])] <- "src-failure"
}
success <- rep(TRUE, nrow(meta))
for (field in fields_check) {
success <- success & (meta[[field]] %in% c("success", "skipped"))
}
meta <- meta[!success,, drop = FALSE] # nolint
issues_list(meta[, c("package", fields)])
meta <- meta[lengths(meta$issues) > 0L,, drop = FALSE] # nolint
issues_list(meta[, c("package", "url", "issues")])
}
85 changes: 69 additions & 16 deletions R/meta_checks.R
Original file line number Diff line number Diff line change
@@ -4,33 +4,86 @@
#' @description List package checks results reported by the
#' R-universe package API.
#' @return A data frame with one row per package and columns with
#' package check results.
#' package check details.
#' @param repo Character of length 1, URL of the package repository.
#' R-multiverse uses `"https://community.r-multiverse.org"`.
#' @examples
#' meta_checks(repo = "https://wlandau.r-universe.dev")
meta_checks <- function(repo = "https://community.r-multiverse.org") {
fields <- c(
"_buildurl",
"_linuxdevel",
"_macbinary",
"_wasmbinary",
"_winbinary",
"_status"
)
listing <- file.path(
trim_url(repo),
"api",
paste0("packages?stream=true&fields=", paste(fields, collapse = ","))
)
base <- file.path(trim_url(repo), "api", "packages?stream=true&fields=")
out <- jsonlite::stream_in(
con = gzcon(url(listing)),
con = gzcon(url(paste0(base, "_buildurl,_binaries"))),
verbose = FALSE,
simplifyVector = TRUE,
simplifyDataFrame = TRUE,
simplifyMatrix = TRUE
)
out$url <- out[["_buildurl"]]
out$issues <- lapply(out[["_binaries"]], meta_checks_issues)
colnames(out) <- tolower(colnames(out))
rownames(out) <- out$package
out
out[, c("package", "url", "issues")]
}

meta_checks_issues <- function(binaries) {
check <- .subset2(binaries, "check")
os <- .subset2(binaries, "os")
arch <- .subset2(binaries, "arch")
r <- .subset2(binaries, "r")
devel <- is_r_devel(r)
release <- is_r_release(r)
results <- c(
target_check("linux", "R-devel", os, arch, r, devel, check),
target_check("mac", "R-release", os, arch, r, release, check),
target_check("win", "R-release", os, arch, r, release, check)
)
as.list(results)
}

target_check <- function(
target_os,
target_r,
os,
arch,
r,
is_target_r,
check
) {
is_target <- (target_os == os) & is_target_r
if (!any(is_target) || all(is.na(check[is_target]))) {
out <- "MISSING"
names(out) <- paste0(target_os, " ", target_r)
return(out)
}
is_failure <- is_target & check %in% c("WARNING", "ERROR")
if (!any(is_failure)) {
return()
}
check <- check[is_failure]
os <- os[is_failure]
r <- paste0("R-", r[is_failure])
if (!is.null(arch)) {
arch <- arch[is_failure]
os <- paste(os, arch, sep = " ")
}
names(check) <- paste(os, r, sep = " ")
check
}

is_r_release <- function(r) {
if (is.null(r_versions_envir$release)) {
r_versions_envir$release <- rversions::r_release(dots = TRUE)$version
}
r == r_versions_envir$release
}

is_r_devel <- function(r) {
if (is.null(r_versions_envir$all)) {
history <- rversions::r_versions(dots = TRUE)
cutoff <- as.POSIXct(Sys.Date() - as.difftime(104, units = "weeks"))
r_versions_envir$all <- history$version[history$date > cutoff]
}
!(r %in% r_versions_envir$all)
}

r_versions_envir <- new.env(parent = emptyenv())
1 change: 1 addition & 0 deletions R/package.R
Original file line number Diff line number Diff line change
@@ -5,6 +5,7 @@
#' @importFrom jsonlite parse_json read_json stream_in write_json
#' @importFrom nanonext ncurl parse_url status_code
#' @importFrom pkgsearch cran_package
#' @importFrom rversions r_release r_versions
#' @importFrom stats aggregate
#' @importFrom utils available.packages compareVersion contrib.url unzip
#' @importFrom vctrs vec_rbind vec_slice
2 changes: 1 addition & 1 deletion man/meta_checks.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

246 changes: 150 additions & 96 deletions tests/testthat/helper-mock.R
Original file line number Diff line number Diff line change
@@ -2,110 +2,164 @@
mock_meta_checks <- structure(
list(
package = c(
"zstdlite", "multiverse.internals",
"cmdstanr", "tinytest", "tidypolars", "duckdb", "polars", "secretbase",
"audio.whisper", "ichimoku", "string2path",
"tidytensor", "audio.vadwebrtc",
"stantargets", "mirai", "INLA", "multitools", "SBC", "httpgd",
"nanonext", "targetsketch"
"demographr", "httpgd", "healthyr",
"prophet", "jagstargets", "adbcdrivermanager", "duckdb", "igraph",
"targetsketch", "nanonext", "prqlr", "milRex", "glaredb", "polars",
"stantargets", "wildfires", "audio.whisper", "unigd", "secretbase",
"arrow", "rJavaEnv", "IMD", "adbcflightsql", "crew", "string2path",
"rlang", "tidypolars", "colorout", "adbcsnowflake", "asylum",
"cmdstanr", "adbcbigquery", "multiverse.internals", "webchem",
"audio.vadwebrtc", "tidytensor", "later", "zstdlite", "loneliness",
"webseq", "mirai", "multitools", "nanoarrow", "geographr", "taxizedb",
"SBC", "INLA", "litedown", "ichimoku"
),
"_user" = c(
"r-multiverse", "r-multiverse",
"r-multiverse", "r-multiverse", "r-multiverse", "r-multiverse",
"r-multiverse", "r-multiverse", "r-multiverse", "r-multiverse",
"r-multiverse", "r-multiverse", "r-multiverse", "r-multiverse",
"r-multiverse", "r-multiverse", "r-multiverse", "r-multiverse",
"r-multiverse", "r-multiverse", "r-multiverse"
url = c(
"https://github.com/r-universe/r-multiverse/actions/runs/11898760503",
"https://github.com/r-universe/r-multiverse/actions/runs/11967099549",
"https://github.com/r-universe/r-multiverse/actions/runs/11898763290",
"https://github.com/r-universe/r-multiverse/actions/runs/12111791338",
"https://github.com/r-universe/r-multiverse/actions/runs/12169701148",
"https://github.com/r-universe/r-multiverse/actions/runs/11809347578",
"https://github.com/r-universe/r-multiverse/actions/runs/12191121856",
"https://github.com/r-universe/r-multiverse/actions/runs/12133807748",
"https://github.com/r-universe/r-multiverse/actions/runs/12024341431",
"https://github.com/r-universe/r-multiverse/actions/runs/12131104675",
"https://github.com/r-universe/r-multiverse/actions/runs/11620617366",
"https://github.com/r-universe/r-multiverse/actions/runs/11759164159",
"https://github.com/r-universe/r-multiverse/actions/runs/11876493507",
"https://github.com/r-universe/r-multiverse/actions/runs/11915003763",
"https://github.com/r-universe/r-multiverse/actions/runs/12139784185",
"https://github.com/r-universe/r-multiverse/actions/runs/11898765070",
"https://github.com/r-universe/r-multiverse/actions/runs/12103194809",
"https://github.com/r-universe/r-multiverse/actions/runs/11736635533",
"https://github.com/r-universe/r-multiverse/actions/runs/12102519290",
"https://github.com/r-universe/r-multiverse/actions/runs/11998874677",
"https://github.com/r-universe/r-multiverse/actions/runs/11791709062",
"https://github.com/r-universe/r-multiverse/actions/runs/12079584194",
"https://github.com/r-universe/r-multiverse/actions/runs/11997200932",
"https://github.com/r-universe/r-multiverse/actions/runs/11859816932",
"https://github.com/r-universe/r-multiverse/actions/runs/11997101671",
"https://github.com/r-universe/r-multiverse/actions/runs/11867687560",
"https://github.com/r-universe/r-multiverse/actions/runs/11917344474",
"https://github.com/r-universe/r-multiverse/actions/runs/12063016496",
"https://github.com/r-universe/r-multiverse/actions/runs/11997200944",
"https://github.com/r-universe/r-multiverse/actions/runs/11905603813",
"https://github.com/r-universe/r-multiverse/actions/runs/12103194199",
"https://github.com/r-universe/r-multiverse/actions/runs/11997200992",
"https://github.com/r-universe/r-multiverse/actions/runs/12186568387",
"https://github.com/r-universe/r-multiverse/actions/runs/11863597537",
"https://github.com/r-universe/r-multiverse/actions/runs/12133502918",
"https://github.com/r-universe/r-multiverse/actions/runs/12133663821",
"https://github.com/r-universe/r-multiverse/actions/runs/12061739398",
"https://github.com/r-universe/r-multiverse/actions/runs/11906793626",
"https://github.com/r-universe/r-multiverse/actions/runs/11898763908",
"https://github.com/r-universe/r-multiverse/actions/runs/11825909757",
"https://github.com/r-universe/r-multiverse/actions/runs/11855336066",
"https://github.com/r-universe/r-multiverse/actions/runs/11886155826",
"https://github.com/r-universe/r-multiverse/actions/runs/11789981334",
"https://github.com/r-universe/r-multiverse/actions/runs/11898762523",
"https://github.com/r-universe/r-multiverse/actions/runs/11825909535",
"https://github.com/r-universe/r-multiverse/actions/runs/11947266936",
"https://github.com/r-universe/r-multiverse/actions/runs/11566311732",
"https://github.com/r-universe/r-multiverse/actions/runs/12194073268",
"https://github.com/r-universe/r-multiverse/actions/runs/11927536639"
),
"_type" = c(
"src",
"src", "src", "src", "src", "src", "src", "src", "src", "src",
"src", "src", "src", "src", "src", "failure", "src", "src", "src",
"src", "src"
),
"_status" = c(
"success", "success", "success",
"success", "success", "success", "success", "success", "success",
"success", "success", "failure", "success", "success", "success",
NA, "success", "failure", "success", "success", "success"
),
"_winbinary" = c(
"success",
"success", "success", "success", "success", "success", "success",
"success", "success", "success", "success", "success", "success",
"success", "success", NA, "success", "success", "success", "success",
"success"
),
"_macbinary" = c(
"success", "success", "success",
"success", "success", "success", "arm64-failure", "success",
"success", "success", "success", "success", "success", "success",
"success", NA, "success", "success", "success", "success", "success"
),
"_wasmbinary" = c(
"success", "success", "success", "success",
"success", "success", "none", "success", "success", "success",
"success", "success", "success", "success", "success", NA, "success",
"success", "none", "success", "success"
),
"_linuxdevel" = c(
"success",
"success", "success", "success", "success", "success", "failure",
"success", "success", "success", "success", "failure", "success",
"failure", "success", NA, "success", "failure", "success", "success",
"success"
),
"_buildurl" = c(
"https://github.com/r-universe/r-multiverse/actions/runs/9412009683",
"https://github.com/r-universe/r-multiverse/actions/runs/9420167853",
"https://github.com/r-universe/r-multiverse/actions/runs/9407999221",
"https://github.com/r-universe/r-multiverse/actions/runs/9352924033",
"https://github.com/r-universe/r-multiverse/actions/runs/9364583983",
"https://github.com/r-universe/r-multiverse/actions/runs/9412010159",
"https://github.com/r-universe/r-multiverse/actions/runs/9360739181",
"https://github.com/r-universe/r-multiverse/actions/runs/9412009508",
"https://github.com/r-universe/r-multiverse/actions/runs/9412009855",
"https://github.com/r-universe/r-multiverse/actions/runs/9423785225",
"https://github.com/r-universe/r-multiverse/actions/runs/9326435602",
"https://github.com/r-universe/r-multiverse/actions/runs/9412009544",
"https://github.com/r-universe/r-multiverse/actions/runs/9412009640",
"https://github.com/r-universe/r-multiverse/actions/runs/9412009826",
"https://github.com/r-universe/r-multiverse/actions/runs/9423785674",
"https://github.com/r-universe/r-multiverse/actions/runs/9296256187",
"https://github.com/r-universe/r-multiverse/actions/runs/9288035966",
"https://github.com/r-universe/r-multiverse/actions/runs/9412009979",
"https://github.com/r-universe/r-multiverse/actions/runs/9403635056",
"https://github.com/r-universe/r-multiverse/actions/runs/9354527129",
"https://github.com/r-universe/r-multiverse/actions/runs/9412009721"
),
"_indexed" = c(
FALSE, TRUE, FALSE, FALSE, FALSE, FALSE, FALSE,
FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, NA, TRUE,
FALSE, FALSE, FALSE, FALSE
),
"_binaries" = list(
issues = list(
list(
`linux R-4.5.0` = "WARNING",
`mac R-4.4.2` = "WARNING",
`win R-4.4.2` = "WARNING"
),
list(),
list(
`linux R-4.5.0` = "WARNING",
`mac R-4.4.2` = "WARNING",
`win R-4.4.2` = "WARNING"
),
list(), list(), list(), list(),
list(`win x86_64 R-4.4.2` = "WARNING"),
list(), list(),
list(), list(), list(), list(), list(), list(), list(), list(),
list(), list(), list(), list(), list(), list(), list(), list(),
list(), list(), list()
),
"_failure" = structure(
list(`mac R-release` = "MISSING", `win R-release` = "MISSING"),
list(),
list(`win R-release` = "MISSING"),
list(),
list(
buildurl = c(
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
file.path(
"https://github.com/r-universe/r-multiverse",
"actions/runs/9296256187"
),
NA, NA, NA, NA, NA
)
`linux R-4.5.0` = "WARNING",
`mac R-4.4.2` = "WARNING",
`win R-4.4.2` = "WARNING"
),
list(
`linux R-4.5.0` = "WARNING",
`mac R-4.4.2` = "WARNING",
`win R-4.4.2` = "WARNING"
),
list(
`linux x86_64 R-4.5.0` = "WARNING",
`mac aarch64 R-4.4.2` = "WARNING",
`mac x86_64 R-4.4.2` = "WARNING",
`win x86_64 R-4.4.2` = "WARNING"
),
list(), list(), list(),
list(), list(), list(), list(), list(), list(), list(),
list(
`mac aarch64 R-4.4.2` = "WARNING",
`mac x86_64 R-4.4.2` = "WARNING",
`win R-release` = "MISSING"
),
list(), list(), list(),
list(), list(), list(), list(),
list(
`linux R-4.5.0` = "WARNING",
`mac R-4.4.2` = "WARNING",
`win R-4.4.2` = "WARNING"
),
list(), list(),
list(
`linux R-4.5.0` = "WARNING",
`mac R-4.4.2` = "WARNING",
`win R-4.4.2` = "WARNING"
),
list(
`linux R-4.5.0` = "WARNING",
`mac R-4.4.2` = "WARNING",
`win R-4.4.2` = "WARNING"
),
class = "data.frame",
row.names = c(NA, 21L)
list(), list(), list(),
list(
`linux R-4.5.0` = "WARNING",
`mac R-4.4.2` = "WARNING",
`win R-4.4.2` = "WARNING"
),
list(
`mac R-4.4.2` = "ERROR",
`win R-4.4.2` = "ERROR"
),
list(
`linux R-4.5.0` = "WARNING",
`mac R-4.4.2` = "WARNING",
`win R-4.4.2` = "WARNING"
),
list(
`linux R-devel` = "MISSING",
`mac R-release` = "MISSING",
`win R-release` = "MISSING"
),
list(), list()
)
),
class = "data.frame",
row.names = c(NA, 21L)
row.names = c(
"demographr",
"httpgd", "healthyr", "prophet", "jagstargets", "adbcdrivermanager",
"duckdb", "igraph", "targetsketch", "nanonext", "prqlr", "milRex",
"glaredb", "polars", "stantargets", "wildfires", "audio.whisper",
"unigd", "secretbase", "arrow", "rJavaEnv", "IMD", "adbcflightsql",
"crew", "string2path", "rlang", "tidypolars", "colorout", "adbcsnowflake",
"asylum", "cmdstanr", "adbcbigquery", "multiverse.internals",
"webchem", "audio.vadwebrtc", "tidytensor", "later", "zstdlite",
"loneliness", "webseq", "mirai", "multitools", "nanoarrow", "geographr",
"taxizedb", "SBC", "INLA", "litedown", "ichimoku"
)
)

# dput(meta_packages(repo = "https://community.r-multiverse.org")) # nolint
21 changes: 10 additions & 11 deletions tests/testthat/test-interpret_status.R
Original file line number Diff line number Diff line change
@@ -102,7 +102,7 @@ test_that("interpret_status() checks etc.", {
expect_true(
grepl(
"Not all checks succeeded on R-universe",
interpret_status("polars", issues)
interpret_status("colorout", issues)
)
)
expect_true(
@@ -119,6 +119,7 @@ test_that("interpret_status() checks etc.", {
fixed = TRUE
)
)
issues$tidypolars$dependencies <- list(x = "y")
expect_true(
grepl(
"One or more dependencies have issues",
@@ -151,7 +152,6 @@ test_that("interpret_status() with complicated dependency problems", {
writeLines(lines, versions)
meta_checks <- mock_meta_checks[1L, ]
meta_checks$package <- "crew"
meta_checks[["_winbinary"]] <- "failure"
suppressMessages(
record_issues(
versions = versions,
@@ -195,18 +195,17 @@ test_that("interpret_status() with complicated dependency problems", {
issues$crew,
list(
checks = list(
"_linuxdevel" = "success",
"_macbinary" = "success",
"_winbinary" = "failure",
"_status" = "success",
"_buildurl" = file.path(
url = file.path(
"https://github.com/r-universe/r-multiverse/actions",
"runs/9412009683"
"runs/11898760503"
),
issues = list(
`linux R-4.5.0` = "WARNING",
`mac R-4.4.2` = "WARNING",
`win R-4.4.2` = "WARNING"
)
),
dependencies = list(
nanonext = "mirai"
),
dependencies = list(nanonext = "mirai"),
date = "2024-01-01",
version = "0.9.3.9002",
remote_hash = "eafad0276c06dec2344da2f03596178c754c8b5e"
130 changes: 110 additions & 20 deletions tests/testthat/test-issues_checks.R
Original file line number Diff line number Diff line change
@@ -2,34 +2,124 @@ test_that("issues_checks() mocked", {
issues <- issues_checks(meta = mock_meta_checks)
url <- "https://github.com/r-universe/r-multiverse/actions/runs"
expected <- list(
audio.whisper = list(
url = file.path(url, "12103194809"),
issues = list(
"linux x86_64 R-4.5.0" = "WARNING",
"mac aarch64 R-4.4.2" = "WARNING",
"mac x86_64 R-4.4.2" = "WARNING",
"win x86_64 R-4.4.2" = "WARNING"
)
),
colorout = list(
url = file.path(url, "12063016496"),
issues = list(
"mac aarch64 R-4.4.2" = "WARNING",
"mac x86_64 R-4.4.2" = "WARNING",
"win R-release" = "MISSING"
)
),
demographr = list(
url = file.path(url, "11898760503"),
issues = list(
"linux R-4.5.0" = "WARNING",
"mac R-4.4.2" = "WARNING",
"win R-4.4.2" = "WARNING"
)
),
geographr = list(
url = file.path(url, "11898762523"),
issues = list(
"linux R-4.5.0" = "WARNING",
"mac R-4.4.2" = "WARNING",
"win R-4.4.2" = "WARNING"
)
),
glaredb = list(
url = file.path(url, "11876493507"),
issues = list("win R-release" = "MISSING")
),
healthyr = list(
url = file.path(url, "11898763290"),
issues = list(
"linux R-4.5.0" = "WARNING",
"mac R-4.4.2" = "WARNING",
"win R-4.4.2" = "WARNING"
)
),
igraph = list(
url = file.path(url, "12133807748"),
issues = list("win x86_64 R-4.4.2" = "WARNING")
),
INLA = list(
"_linuxdevel" = "src-failure", "_macbinary" = "src-failure",
"_winbinary" = "src-failure",
"_status" = "src-failure",
"_buildurl" = file.path(url, "9296256187")
url = file.path(url, "11566311732"),
issues = list(
"linux R-devel" = "MISSING",
"mac R-release" = "MISSING",
"win R-release" = "MISSING"
)
),
loneliness = list(
url = file.path(url, "11898763908"),
issues = list(
"linux R-4.5.0" = "WARNING",
"mac R-4.4.2" = "WARNING",
"win R-4.4.2" = "WARNING"
)
),
polars = list(
"_linuxdevel" = "failure", "_macbinary" = "arm64-failure",
"_winbinary" = "success", "_status" = "success",
"_buildurl" = file.path(url, "9360739181")
prqlr = list(
url = file.path(url, "11620617366"),
issues = list(
"mac R-release" = "MISSING",
"win R-release" = "MISSING"
)
),
SBC = list(
"_linuxdevel" = "failure", "_macbinary" = "success",
"_winbinary" = "success",
"_status" = "failure",
"_buildurl" = file.path(url, "9412009979")
url = file.path(url, "11947266936"),
issues = list(
"linux R-4.5.0" = "WARNING",
"mac R-4.4.2" = "WARNING",
"win R-4.4.2" = "WARNING"
)
),
stantargets = list(
"_linuxdevel" = "failure", "_macbinary" = "success",
"_winbinary" = "success",
"_status" = "success",
"_buildurl" = file.path(url, "9412009826")
url = file.path(url, "12139784185"),
issues = list(
"linux R-4.5.0" = "WARNING",
"mac R-4.4.2" = "WARNING",
"win R-4.4.2" = "WARNING"
)
),
taxizedb = list(
url = file.path(url, "11825909535"),
issues = list(
"mac R-4.4.2" = "ERROR",
"win R-4.4.2" = "ERROR"
)
),
tidytensor = list(
"_linuxdevel" = "failure", "_macbinary" = "success",
"_winbinary" = "success",
"_status" = "failure",
"_buildurl" = file.path(url, "9412009544")
url = file.path(url, "12133663821"),
issues = list(
"linux R-4.5.0" = "WARNING",
"mac R-4.4.2" = "WARNING",
"win R-4.4.2" = "WARNING"
)
),
webseq = list(
url = file.path(url, "11825909757"),
issues = list(
"linux R-4.5.0" = "WARNING",
"mac R-4.4.2" = "WARNING",
"win R-4.4.2" = "WARNING"
)
),
wildfires = list(
url = file.path(url, "11898765070"),
issues = list(
"linux R-4.5.0" = "WARNING",
"mac R-4.4.2" = "WARNING",
"win R-4.4.2" = "WARNING"
)
)
)
expect_equal(issues[order(names(issues))], expected[order(names(expected))])
9 changes: 1 addition & 8 deletions tests/testthat/test-meta_checks.R
Original file line number Diff line number Diff line change
@@ -2,13 +2,6 @@ test_that("meta_checks()", {
out <- meta_checks(repo = "https://wlandau.r-universe.dev")
expect_true(is.data.frame(out))
expect_gt(nrow(out), 1L)
fields <- c(
"_status",
"_winbinary",
"_macbinary",
"_wasmbinary",
"_linuxdevel",
"_buildurl"
)
fields <- c("package", "url", "issues")
expect_true(all(fields %in% colnames(out)))
})
50 changes: 18 additions & 32 deletions tests/testthat/test-record_issues.R
Original file line number Diff line number Diff line change
@@ -15,16 +15,11 @@ test_that("record_issues() mocked", {
sort(names(issues)),
sort(
c(
"audio.whisper",
"INLA",
"polars",
"SBC",
"stantargets",
"targetsketch",
"tidypolars",
"tidytensor",
"version_decremented",
"version_unmodified"
"audio.whisper", "colorout", "demographr", "geographr", "glaredb",
"healthyr", "igraph", "INLA", "loneliness",
"prqlr", "SBC", "stantargets",
"taxizedb", "tidytensor", "webseq", "wildfires", "targetsketch",
"tidypolars", "version_decremented", "version_unmodified"
)
)
)
@@ -33,11 +28,12 @@ test_that("record_issues() mocked", {
issues$INLA,
list(
checks = list(
"_linuxdevel" = "src-failure",
"_macbinary" = "src-failure",
"_winbinary" = "src-failure",
"_status" = "src-failure",
"_buildurl" = file.path(runs, "9296256187")
url = file.path(runs, "11566311732"),
issues = list(
`linux R-devel` = "MISSING",
`mac R-release` = "MISSING",
`win R-release` = "MISSING"
)
),
date = "2024-01-01",
version = list(),
@@ -48,11 +44,12 @@ test_that("record_issues() mocked", {
issues$stantargets,
list(
checks = list(
"_linuxdevel" = "failure",
"_macbinary" = "success",
"_winbinary" = "success",
"_status" = "success",
"_buildurl" = file.path(runs, "9412009826")
url = file.path(runs, "12139784185"),
issues = list(
`linux R-4.5.0` = "WARNING",
`mac R-4.4.2` = "WARNING",
`win R-4.4.2` = "WARNING"
)
),
descriptions = list(
remotes = c("hyunjimoon/SBC", "stan-dev/cmdstanr")
@@ -136,7 +133,6 @@ test_that("record_issues() date works", {
)
once_fixed <- c(
"audio.whisper",
"polars",
"SBC",
"tidypolars",
"version_unmodified"
@@ -198,7 +194,6 @@ test_that("record_issues() with dependency problems", {
writeLines(lines, versions)
meta_checks <- mock_meta_checks[1L, ]
meta_checks$package <- "crew"
meta_checks[["_winbinary"]] <- "failure"
suppressMessages(
record_issues(
versions = versions,
@@ -241,16 +236,7 @@ test_that("record_issues() with dependency problems", {
expect_equal(
issues$crew,
list(
checks = list(
"_linuxdevel" = "success",
"_macbinary" = "success",
"_winbinary" = "failure",
"_status" = "success",
"_buildurl" = file.path(
"https://github.com/r-universe/r-multiverse/actions",
"runs/9412009683"
)
),
checks = list(url = meta_checks$url, issues = meta_checks$issues[[1L]]),
dependencies = list(
nanonext = "mirai"
),

0 comments on commit e53c161

Please sign in to comment.