diff --git a/DESCRIPTION b/DESCRIPTION index 2ff0126..c2e7ca7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: r.releases.internals Title: Internal Infrastructure for An R Universe of Package Releases Description: Internal infrastructure for an R universe of package releases. -Version: 0.0.15 +Version: 0.0.16 License: MIT + file LICENSE URL: https://github.com/r-releases/r.releases.internals BugReports: https://github.com/r-releases/r.releases.internals/issues @@ -33,6 +33,8 @@ Imports: pkgsearch, utils, vctrs +Suggests: + testthat (>= 3.0.0) Encoding: UTF-8 Language: en-US Config/testthat/edition: 3 diff --git a/NEWS.md b/NEWS.md index 9b0740b..8116f1f 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,8 @@ +# r.releases.internals 0.0.16 + +* Retry failed merge attempts. +* Use `testthat` + # r.releases.internals 0.0.15 * Add explicit check that each contribution has only 1 line. diff --git a/R/review_pull_request.R b/R/review_pull_request.R index d017670..27167ea 100644 --- a/R/review_pull_request.R +++ b/R/review_pull_request.R @@ -184,15 +184,19 @@ pull_request_merge <- function(owner, repo, number) { .limit = Inf ) labels <- pull_request_labels(pull_request) - if (!(label_manual_review %in% labels)) { + if (!(label_retry_review %in% labels)) { gh::gh( "POST /repos/:owner/:repo/issues/:number/comments", owner = owner, repo = repo, number = number, body = paste0( - "There was a problem merging pull request ", - number + "Pull request ", + number, + " is approved in its current state, ", + "but the bot encountered an error trying to merge it. ", + "The bot will repeat the review and retry the merge ", + "next time it reviews pull requests." ) ) gh::gh( @@ -200,7 +204,7 @@ pull_request_merge <- function(owner, repo, number) { owner = owner, repo = repo, number = number, - labels = list(label_manual_review) + labels = list(label_retry_review) ) } } else { @@ -231,3 +235,5 @@ pull_request_labels <- function(pull_request) { } label_manual_review <- "manual-review" + +label_retry_review <- "retry-review" diff --git a/tests/test-assert_package.R b/tests/test-assert_package.R deleted file mode 100644 index 527884a..0000000 --- a/tests/test-assert_package.R +++ /dev/null @@ -1,248 +0,0 @@ -stopifnot( - grepl( - "Invalid package name", - r.releases.internals::assert_package(name = letters, url = "xy"), - fixed = TRUE - ) -) - -stopifnot( - grepl( - "Invalid package name", - r.releases.internals::assert_package( - name = ".gh", - url = "https://github.com/r-lib/gh" - ), - fixed = TRUE - ) -) - -stopifnot( - grepl( - "looks like custom JSON", - r.releases.internals::assert_package(name = "xy", url = "{"), - fixed = TRUE - ) -) - -stopifnot( - grepl( - "looks like custom JSON", - r.releases.internals::assert_package(name = "xy", url = "}"), - fixed = TRUE - ) -) - -stopifnot( - grepl( - "Invalid package URL", - r.releases.internals::assert_package( - name = "xy", - url = letters - ), - fixed = TRUE - ) -) - -stopifnot( - grepl( - "Invalid package URL", - r.releases.internals::assert_package(name = "xy", url = letters), - fixed = TRUE - ) -) - -stopifnot( - grepl( - "Found malformed URL", - r.releases.internals::assert_package( - name = "gh", - url = "github.com/r-lib/gh" - ), - fixed = TRUE - ) -) - -stopifnot( - grepl( - "Found malformed URL", - r.releases.internals::assert_package( - name = "gh", - url = "github.com/r-lib/gh" - ), - fixed = TRUE - ) -) - -stopifnot( - grepl( - "appears to disagree with the repository name in the URL", - r.releases.internals::assert_package( - name = "gh2", - url = "https://github.com/r-lib/gh" - ), - fixed = TRUE - ) -) - -stopifnot( - grepl( - "is not https", - r.releases.internals::assert_package( - name = "gh", - url = "http://github.com/r-lib/gh" - ), - fixed = TRUE - ) -) - -stopifnot( - grepl( - "is not a GitHub or GitLab URL", - r.releases.internals::assert_package( - name = "gh", - url = "https://github.gov/r-lib/gh" - ), - fixed = TRUE - ) -) - -stopifnot( - grepl( - "appears to be an owner", - r.releases.internals::assert_package( - name = "gh", - url = "https://github.com/gh" - ), - fixed = TRUE - ) -) - -stopifnot( - grepl( - "appears to use a CRAN mirror", - r.releases.internals::assert_package( - name = "gh", - url = "https://github.com/cran/gh" - ), - fixed = TRUE - ) -) - -stopifnot( - grepl( - "does not appear in its DESCRIPTION file published on CRAN", - r.releases.internals::assert_cran_url( - name = "gh", - url = "https://github.com/r-lib/gha" - ), - fixed = TRUE - ) -) - -stopifnot( - grepl( - "does not appear in its DESCRIPTION file published on CRAN", - r.releases.internals::assert_cran_url( - name = "assertthat", - url = "https://github.com/hadley/assertthat" - ), - fixed = TRUE - ) -) - -stopifnot( - grepl( - "returned HTTP error", - r.releases.internals::assert_package( - name = "afantasticallylongandimpossiblepackage", - url = "https://github.com/r-lib/afantasticallylongandimpossiblepackage" - ), - fixed = TRUE - ) -) - -stopifnot( - grepl( - "No full release found at URL", - r.releases.internals::assert_package( - name = "test.no.release", - url = "https://github.com/wlandau/test.no.release" - ), - fixed = TRUE - ) -) - -stopifnot( - grepl( - "No full release found at URL", - r.releases.internals::assert_package( - name = "test.no.release", - url = "https://gitlab.com/wlandau/test.no.release" - ), - fixed = TRUE - ) -) - -stopifnot( - is.null( - r.releases.internals::assert_package( - name = "gh", - url = "https://github.com/r-lib/gh" - ) - ) -) - -stopifnot( - is.null( - r.releases.internals::assert_package( - name = "test", - url = "https://gitlab.com/wlandau/test" - ) - ) -) - -stopifnot( - is.null( - r.releases.internals::assert_cran_url( - name = "gh", - url = "https://github.com/r-lib/gh" - ) - ) -) - -stopifnot( - is.null( - r.releases.internals::assert_cran_url( - name = "curl", - url = "https://github.com/jeroen/curl/" - ) - ) -) - -stopifnot( - is.null( - r.releases.internals::assert_cran_url( - name = "curl", - url = "https://github.com/jeroen/curl/" - ) - ) -) - -stopifnot( - is.null( - r.releases.internals::assert_cran_url( - name = "jsonlite", - url = "https://github.com/jeroen/jsonlite" - ) - ) -) - -stopifnot( - is.null( - r.releases.internals::assert_cran_url( - name = "packageNOTonCRAN", - url = "https://github.com/jeroen/jsonlite" - ) - ) -) diff --git a/tests/test-record_versions.R b/tests/test-record_versions.R deleted file mode 100644 index 87ebb6c..0000000 --- a/tests/test-record_versions.R +++ /dev/null @@ -1,174 +0,0 @@ -# Temporary files used in the mock test. -manifest <- tempfile() -issues <- tempfile() - -# First update to the manifest. -contents <- data.frame( - package = c( - "package_unmodified", - "version_decremented", - "version_incremented", - "version_unmodified" - ), - version_current = rep("1.0.0", 4L), - hash_current = rep("hash_1.0.0", 4L) -) -r.releases.internals::record_versions( - manifest = manifest, - issues = issues, - current = contents -) -written <- jsonlite::read_json(manifest) -expected <- list( - list( - package = "package_unmodified", - version_current = "1.0.0", - hash_current = "hash_1.0.0" - ), - list( - package = "version_decremented", - version_current = "1.0.0", - hash_current = "hash_1.0.0" - ), - list( - package = "version_incremented", - version_current = "1.0.0", - hash_current = "hash_1.0.0" - ), - list( - package = "version_unmodified", - version_current = "1.0.0", - hash_current = "hash_1.0.0" - ) -) -stopifnot(identical(written, expected)) -stopifnot(!file.exists(issues)) - -# Update the manifest after no changes to packages or versions. -r.releases.internals::record_versions( - manifest = manifest, - issues = issues, - current = contents -) -written <- jsonlite::read_json(manifest) -expected <- list( - list( - package = "package_unmodified", - version_current = "1.0.0", - hash_current = "hash_1.0.0", - version_highest = "1.0.0", - hash_highest = "hash_1.0.0" - ), - list( - package = "version_decremented", - version_current = "1.0.0", - hash_current = "hash_1.0.0", - version_highest = "1.0.0", - hash_highest = "hash_1.0.0" - ), - list( - package = "version_incremented", - version_current = "1.0.0", - hash_current = "hash_1.0.0", - version_highest = "1.0.0", - hash_highest = "hash_1.0.0" - ), - list( - package = "version_unmodified", - version_current = "1.0.0", - hash_current = "hash_1.0.0", - version_highest = "1.0.0", - hash_highest = "hash_1.0.0" - ) -) -stopifnot(identical(written, expected)) -stopifnot(file.exists(issues)) -stopifnot(identical(jsonlite::read_json(issues), list())) - -# Update the packages in all the ways indicated above. -index <- contents$package == "version_decremented" -contents$version_current[index] <- "0.0.1" -contents$hash_current[index] <- "hash_0.0.1" -index <- contents$package == "version_incremented" -contents$version_current[index] <- "2.0.0" -contents$hash_current[index] <- "hash_2.0.0" -index <- contents$package == "version_unmodified" -contents$version_current[index] <- "1.0.0" -contents$hash_current[index] <- "hash_1.0.0-modified" -for (index in seq_len(2L)) { - r.releases.internals::record_versions( - manifest = manifest, - issues = issues, - current = contents - ) - written <- jsonlite::read_json(manifest) - expected <- list( - list( - package = "package_unmodified", - version_current = "1.0.0", - hash_current = "hash_1.0.0", - version_highest = "1.0.0", - hash_highest = "hash_1.0.0" - ), - list( - package = "version_decremented", - version_current = "0.0.1", - hash_current = "hash_0.0.1", - version_highest = "1.0.0", - hash_highest = "hash_1.0.0" - ), - list( - package = "version_incremented", - version_current = "2.0.0", - hash_current = "hash_2.0.0", - version_highest = "2.0.0", - hash_highest = "hash_2.0.0" - ), - list( - package = "version_unmodified", - version_current = "1.0.0", - hash_current = "hash_1.0.0-modified", - version_highest = "1.0.0", - hash_highest = "hash_1.0.0" - ) - ) - stopifnot(identical(written, expected)) - stopifnot(file.exists(issues)) - written_issues <- jsonlite::read_json(issues) - expected_issues <- list( - list( - package = "version_decremented", - version_current = "0.0.1", - hash_current = "hash_0.0.1", - version_highest = "1.0.0", - hash_highest = "hash_1.0.0" - ), - list( - package = "version_unmodified", - version_current = "1.0.0", - hash_current = "hash_1.0.0-modified", - version_highest = "1.0.0", - hash_highest = "hash_1.0.0" - ) - ) - stopifnot(identical(written_issues, expected_issues)) -} - -# Remove temporary files -unlink(c(manifest, issues)) - -# The manifest can be created and updated from the actual repo. -manifest <- tempfile() -issues <- tempfile() -r.releases.internals::record_versions(manifest = manifest, issues = issues) -stopifnot(file.exists(manifest)) -contents <- do.call(vctrs::vec_rbind, jsonlite::read_json(manifest)) -contents <- lapply(contents, as.character) -lapply(contents, function(x) stopifnot(!anyNA(x))) -r.releases.internals::record_versions(manifest = manifest, issues = issues) -contents <- jsonlite::read_json(manifest) -stopifnot(is.character(contents[[1L]]$package)) -stopifnot(length(contents[[1L]]$package) == 1L) -stopifnot(file.exists(manifest)) -stopifnot(file.exists(issues)) -unlink(c(manifest, issues)) diff --git a/tests/test-write_universe_manifest.R b/tests/test-write_universe_manifest.R deleted file mode 100644 index 5da6b8b..0000000 --- a/tests/test-write_universe_manifest.R +++ /dev/null @@ -1,278 +0,0 @@ -# Success test case for ordinary URLs. -packages <- tempfile() -dir.create(packages) -writeLines("https://github.com/r-lib/gh", file.path(packages, "gh")) -writeLines( - "https://github.com/jeroen/jsonlite", - file.path(packages, "jsonlite") -) -universe <- file.path(tempfile(), "out") -r.releases.internals::write_universe_manifest( - input = packages, - output = universe -) -json <- jsonlite::read_json(universe) -exp <- list( - list( - package = "gh", - url = "https://github.com/r-lib/gh", - branch = "*release" - ), - list( - package = "jsonlite", - url = "https://github.com/jeroen/jsonlite", - branch = "*release" - ) -) -stopifnot(identical(json, exp)) -unlink(packages, recursive = TRUE) -unlink(universe) - -# Exempt `"branch": "release"` in certain cases. -packages <- tempfile() -dir.create(packages) -writeLines("https://github.com/r-lib/gh", file.path(packages, "gh")) -writeLines( - "https://github.com/jeroen/jsonlite", - file.path(packages, "jsonlite") -) -writeLines( - "https://github.com/wlandau/crew", - file.path(packages, "crew") -) -writeLines( - "https://github.com/cran/quarto", - file.path(packages, "quarto") -) -universe <- file.path(tempfile(), "out") -r.releases.internals::write_universe_manifest( - input = packages, - output = universe, - release_exceptions = c( - "https://github.com/cran", - "https://github.com/wlandau" - ) -) -json <- jsonlite::read_json(universe) -exp <- list( - list( - package = "crew", - url = "https://github.com/wlandau/crew" - ), - list( - package = "gh", - url = "https://github.com/r-lib/gh", - branch = "*release" - ), - list( - package = "jsonlite", - url = "https://github.com/jeroen/jsonlite", - branch = "*release" - ), - list( - package = "quarto", - url = "https://github.com/cran/quarto" - ) -) -stopifnot(identical(json, exp)) -unlink(packages, recursive = TRUE) -unlink(universe) - -# One of the URLs is malformed. -packages <- tempfile() -dir.create(packages) -writeLines("https://github.com/r-lib/gh", file.path(packages, "gh")) -writeLines( - c("https://github.com/jeroen/jsonlite", "bad"), - file.path(packages, "jsonlite") -) -universe <- file.path(tempfile(), "out") -out <- try( - r.releases.internals::write_universe_manifest( - input = packages, - output = universe - ), - silent = TRUE -) -stopifnot(inherits(out, "try-error")) -unlink(packages, recursive = TRUE) -unlink(universe) - -# Acceptable custom JSON. -packages <- tempfile() -dir.create(packages) -writeLines("https://github.com/r-lib/gh", file.path(packages, "gh")) -writeLines( - c( - "{", - " \"package\": \"paws.analytics\",", - " \"url\": \"https://github.com/paws-r/paws\",", - " \"subdir\": \"cran/paws.analytics\",", - " \"branch\": \"*release\"", - "}" - ), - file.path(packages, "paws.analytics") -) -universe <- file.path(tempfile(), "out") -r.releases.internals::write_universe_manifest( - input = packages, - output = universe -) -out <- jsonlite::read_json(path = universe) -exp <- list( - list( - package = "gh", - url = "https://github.com/r-lib/gh", - branch = "*release" - ), - list( - package = "paws.analytics", - url = "https://github.com/paws-r/paws", - branch = "*release", - subdir = "cran/paws.analytics" - ) -) -stopifnot(identical(out, exp)) -unlink(packages, recursive = TRUE) -unlink(universe) - - -# Malformed URL in JSON. -packages <- tempfile() -dir.create(packages) -writeLines("https://github.com/r-lib/gh", file.path(packages, "gh")) -writeLines( - c( - "{", - " \"package\": \"paws.analytics\",", - " \"url\": \"b a d u r l\",", - " \"subdir\": \"cran/paws.analytics\",", - " \"branch\": \"*release\"", - "}" - ), - file.path(packages, "paws.analytics") -) -universe <- file.path(tempfile(), "out") -out <- try( - r.releases.internals::write_universe_manifest( - input = packages, - output = universe - ), - silent = TRUE -) -stopifnot( - grepl( - pattern = "Found malformed URL", - x = r.releases.internals::try_message(out) - ) -) -unlink(packages, recursive = TRUE) -unlink(universe) - -# Missing branch field -packages <- tempfile() -dir.create(packages) -writeLines("https://github.com/r-lib/gh", file.path(packages, "gh")) -writeLines( - c( - "{", - " \"package\": \"paws.analytics\",", - " \"url\": \"https://github.com/paws-r/paws\",", - " \"subdir\": \"cran/paws.analytics\"", - "}" - ), - file.path(packages, "paws.analytics") -) -universe <- file.path(tempfile(), "out") -out <- try( - r.releases.internals::write_universe_manifest( - input = packages, - output = universe - ), - silent = TRUE -) -stopifnot(inherits(out, "try-error")) -stopifnot( - grepl( - pattern = "JSON entry for package", - x = r.releases.internals::try_message(out), - fixed = TRUE - ) -) -stopifnot( - grepl( - pattern = "must have fields", - x = r.releases.internals::try_message(out), - fixed = TRUE - ) -) -unlink(packages, recursive = TRUE) -unlink(universe) - -# Disagreeing package field -packages <- tempfile() -dir.create(packages) -writeLines("https://github.com/r-lib/gh", file.path(packages, "gh")) -writeLines( - c( - "{", - " \"package\": \"paws.analytics2\",", - " \"url\": \"https://github.com/paws-r/paws\",", - " \"subdir\": \"cran/paws.analytics\",", - " \"branch\": \"*release\"", - "}" - ), - file.path(packages, "paws.analytics") -) -universe <- file.path(tempfile(), "out") -out <- try( - r.releases.internals::write_universe_manifest( - input = packages, - output = universe - ), - silent = TRUE -) -stopifnot(inherits(out, "try-error")) -stopifnot( - grepl( - pattern = "The 'packages' field disagrees with the package name", - x = r.releases.internals::try_message(out), - fixed = TRUE - ) -) -unlink(packages, recursive = TRUE) -unlink(universe) - -# Bad branch field -packages <- tempfile() -dir.create(packages) -writeLines("https://github.com/r-lib/gh", file.path(packages, "gh")) -writeLines( - c( - "{", - " \"package\": \"paws.analytics\",", - " \"url\": \"https://github.com/paws-r/paws\",", - " \"subdir\": \"cran/paws.analytics\",", - " \"branch\": \"development\"", - "}" - ), - file.path(packages, "paws.analytics") -) -universe <- file.path(tempfile(), "out") -out <- try( - r.releases.internals::write_universe_manifest( - input = packages, - output = universe - ), - silent = TRUE -) -stopifnot(inherits(out, "try-error")) -stopifnot( - grepl( - pattern = "The 'branch' field of package", - x = r.releases.internals::try_message(out), - fixed = TRUE - ) -) -unlink(packages, recursive = TRUE) -unlink(universe) diff --git a/tests/testthat.R b/tests/testthat.R new file mode 100644 index 0000000..65a4479 --- /dev/null +++ b/tests/testthat.R @@ -0,0 +1,12 @@ +# This file is part of the standard setup for testthat. +# It is recommended that you do not modify it. +# +# Where should you do additional test configuration? +# Learn more about the roles of various files in: +# * https://r-pkgs.org/testing-design.html#sec-tests-files-overview +# * https://testthat.r-lib.org/articles/special-files.html + +library(testthat) +library(r.releases.internals) + +test_check("r.releases.internals") diff --git a/tests/testthat/test-assert_package.R b/tests/testthat/test-assert_package.R new file mode 100644 index 0000000..fc818b6 --- /dev/null +++ b/tests/testthat/test-assert_package.R @@ -0,0 +1,209 @@ +test_that("invalid package name with vector", { + expect_true( + grepl( + "Invalid package name", + r.releases.internals::assert_package(name = letters, url = "xy"), + fixed = TRUE + ) + ) +}) + +test_that("invalid package name with dot", { + expect_true( + grepl( + "Invalid package name", + r.releases.internals::assert_package( + name = ".gh", + url = "https://github.com/r-lib/gh" + ), + fixed = TRUE + ) + ) +}) + +test_that("custom JSON", { + expect_true( + grepl( + "looks like custom JSON", + r.releases.internals::assert_package(name = "xy", url = "{"), + fixed = TRUE + ) + ) +}) + +test_that("invalid vector URL", { + expect_true( + grepl( + "Invalid package URL", + r.releases.internals::assert_package( + name = "xy", + url = letters + ), + fixed = TRUE + ) + ) +}) + +test_that("malformed URL", { + expect_true( + grepl( + "Found malformed URL", + r.releases.internals::assert_package( + name = "gh", + url = "github.com/r-lib/gh" + ), + fixed = TRUE + ) + ) +}) + +test_that("package name/repo disagreement", { + expect_true( + grepl( + "appears to disagree with the repository name in the URL", + r.releases.internals::assert_package( + name = "gh2", + url = "https://github.com/r-lib/gh" + ), + fixed = TRUE + ) + ) +}) + +test_that("https", { + expect_true( + grepl( + "is not https", + r.releases.internals::assert_package( + name = "gh", + url = "http://github.com/r-lib/gh" + ), + fixed = TRUE + ) + ) +}) + +test_that("GitHub/GitLab URL", { + expect_true( + grepl( + "is not a GitHub or GitLab URL", + r.releases.internals::assert_package( + name = "gh", + url = "https://github.gov/r-lib/gh" + ), + fixed = TRUE + ) + ) +}) + +test_that("owner URL", { + expect_true( + grepl( + "appears to be an owner", + r.releases.internals::assert_package( + name = "gh", + url = "https://github.com/gh" + ), + fixed = TRUE + ) + ) +}) + +test_that("CRAN mirror", { + expect_true( + grepl( + "appears to use a CRAN mirror", + r.releases.internals::assert_package( + name = "gh", + url = "https://github.com/cran/gh" + ), + fixed = TRUE + ) + ) +}) + +test_that("CRAN URL alignment", { + expect_true( + grepl( + "does not appear in its DESCRIPTION file published on CRAN", + r.releases.internals::assert_cran_url( + name = "gh", + url = "https://github.com/r-lib/gha" + ), + fixed = TRUE + ) + ) +}) + +test_that("HTTP error", { + expect_true( + grepl( + "returned HTTP error", + r.releases.internals::assert_package( + name = "afantasticallylongandimpossiblepackage", + url = "https://github.com/r-lib/afantasticallylongandimpossiblepackage" + ), + fixed = TRUE + ) + ) +}) + +test_that("release URL", { + expect_true( + grepl( + "No full release found at URL", + r.releases.internals::assert_package( + name = "test.no.release", + url = "https://github.com/wlandau/test.no.release" + ), + fixed = TRUE + ) + ) +}) + +test_that("good GitHub registration", { + expect_null( + r.releases.internals::assert_package( + name = "gh", + url = "https://github.com/r-lib/gh" + ) + ) +}) + +test_that("good GitLab registration", { + suppressMessages( + expect_null( + r.releases.internals::assert_package( + name = "test", + url = "https://gitlab.com/wlandau/test" + ) + ) + ) +}) + +test_that("good registration with trailing slash", { + expect_null( + r.releases.internals::assert_cran_url( + name = "curl", + url = "https://github.com/jeroen/curl/" + ) + ) +}) + +test_that("good alignment with CRAN URL", { + expect_null( + r.releases.internals::assert_cran_url( + name = "jsonlite", + url = "https://github.com/jeroen/jsonlite" + ) + ) +}) + +test_that("trivially good alignment with CRAN URL", { + expect_null( + r.releases.internals::assert_cran_url( + name = "packageNOTonCRAN", + url = "https://github.com/jeroen/jsonlite" + ) + ) +}) diff --git a/tests/testthat/test-record_versions.R b/tests/testthat/test-record_versions.R new file mode 100644 index 0000000..c1b10e3 --- /dev/null +++ b/tests/testthat/test-record_versions.R @@ -0,0 +1,189 @@ +test_that("record versions from a mock repo", { + # Temporary files used in the mock test. + manifest <- tempfile() + issues <- tempfile() + # First update to the manifest. + contents <- data.frame( + package = c( + "package_unmodified", + "version_decremented", + "version_incremented", + "version_unmodified" + ), + version_current = rep("1.0.0", 4L), + hash_current = rep("hash_1.0.0", 4L) + ) + r.releases.internals::record_versions( + manifest = manifest, + issues = issues, + current = contents + ) + written <- jsonlite::read_json(manifest) + expected <- list( + list( + package = "package_unmodified", + version_current = "1.0.0", + hash_current = "hash_1.0.0" + ), + list( + package = "version_decremented", + version_current = "1.0.0", + hash_current = "hash_1.0.0" + ), + list( + package = "version_incremented", + version_current = "1.0.0", + hash_current = "hash_1.0.0" + ), + list( + package = "version_unmodified", + version_current = "1.0.0", + hash_current = "hash_1.0.0" + ) + ) + expect_true(identical(written, expected)) + expect_true(!file.exists(issues)) + # Update the manifest after no changes to packages or versions. + suppressMessages( + r.releases.internals::record_versions( + manifest = manifest, + issues = issues, + current = contents + ) + ) + written <- jsonlite::read_json(manifest) + expected <- list( + list( + package = "package_unmodified", + version_current = "1.0.0", + hash_current = "hash_1.0.0", + version_highest = "1.0.0", + hash_highest = "hash_1.0.0" + ), + list( + package = "version_decremented", + version_current = "1.0.0", + hash_current = "hash_1.0.0", + version_highest = "1.0.0", + hash_highest = "hash_1.0.0" + ), + list( + package = "version_incremented", + version_current = "1.0.0", + hash_current = "hash_1.0.0", + version_highest = "1.0.0", + hash_highest = "hash_1.0.0" + ), + list( + package = "version_unmodified", + version_current = "1.0.0", + hash_current = "hash_1.0.0", + version_highest = "1.0.0", + hash_highest = "hash_1.0.0" + ) + ) + expect_true(identical(written, expected)) + expect_true(file.exists(issues)) + expect_true(identical(jsonlite::read_json(issues), list())) + # Update the packages in all the ways indicated above. + index <- contents$package == "version_decremented" + contents$version_current[index] <- "0.0.1" + contents$hash_current[index] <- "hash_0.0.1" + index <- contents$package == "version_incremented" + contents$version_current[index] <- "2.0.0" + contents$hash_current[index] <- "hash_2.0.0" + index <- contents$package == "version_unmodified" + contents$version_current[index] <- "1.0.0" + contents$hash_current[index] <- "hash_1.0.0-modified" + for (index in seq_len(2L)) { + r.releases.internals::record_versions( + manifest = manifest, + issues = issues, + current = contents + ) + written <- jsonlite::read_json(manifest) + expected <- list( + list( + package = "package_unmodified", + version_current = "1.0.0", + hash_current = "hash_1.0.0", + version_highest = "1.0.0", + hash_highest = "hash_1.0.0" + ), + list( + package = "version_decremented", + version_current = "0.0.1", + hash_current = "hash_0.0.1", + version_highest = "1.0.0", + hash_highest = "hash_1.0.0" + ), + list( + package = "version_incremented", + version_current = "2.0.0", + hash_current = "hash_2.0.0", + version_highest = "2.0.0", + hash_highest = "hash_2.0.0" + ), + list( + package = "version_unmodified", + version_current = "1.0.0", + hash_current = "hash_1.0.0-modified", + version_highest = "1.0.0", + hash_highest = "hash_1.0.0" + ) + ) + expect_true(identical(written, expected)) + expect_true(file.exists(issues)) + written_issues <- jsonlite::read_json(issues) + expected_issues <- list( + list( + package = "version_decremented", + version_current = "0.0.1", + hash_current = "hash_0.0.1", + version_highest = "1.0.0", + hash_highest = "hash_1.0.0" + ), + list( + package = "version_unmodified", + version_current = "1.0.0", + hash_current = "hash_1.0.0-modified", + version_highest = "1.0.0", + hash_highest = "hash_1.0.0" + ) + ) + expect_true(identical(written_issues, expected_issues)) + } + # Remove temporary files + unlink(c(manifest, issues)) +}) + +test_that("manifest can be created and updated from the actual repo", { + manifest <- tempfile() + issues <- tempfile() + temp <- utils::capture.output( + suppressMessages( + r.releases.internals::record_versions( + manifest = manifest, + issues = issues + ) + ) + ) + expect_true(file.exists(manifest)) + contents <- do.call(vctrs::vec_rbind, jsonlite::read_json(manifest)) + contents <- lapply(contents, as.character) + lapply(contents, function(x) expect_true(!anyNA(x))) + temp <- utils::capture.output( + suppressMessages( + r.releases.internals::record_versions( + manifest = manifest, + issues = issues + ) + ) + ) + contents <- jsonlite::read_json(manifest) + expect_true(is.character(contents[[1L]]$package)) + expect_true(length(contents[[1L]]$package) == 1L) + expect_true(file.exists(manifest)) + expect_true(file.exists(issues)) + unlink(c(manifest, issues)) +}) diff --git a/tests/testthat/test-write_universe_manifest.R b/tests/testthat/test-write_universe_manifest.R new file mode 100644 index 0000000..1f350bf --- /dev/null +++ b/tests/testthat/test-write_universe_manifest.R @@ -0,0 +1,301 @@ +test_that("ordinary URLs can be written", { + packages <- tempfile() + dir.create(packages) + writeLines("https://github.com/r-lib/gh", file.path(packages, "gh")) + writeLines( + "https://github.com/jeroen/jsonlite", + file.path(packages, "jsonlite") + ) + universe <- file.path(tempfile(), "out") + suppressMessages( + r.releases.internals::write_universe_manifest( + input = packages, + output = universe + ) + ) + json <- jsonlite::read_json(universe) + exp <- list( + list( + package = "gh", + url = "https://github.com/r-lib/gh", + branch = "*release" + ), + list( + package = "jsonlite", + url = "https://github.com/jeroen/jsonlite", + branch = "*release" + ) + ) + expect_true(identical(json, exp)) + unlink(packages, recursive = TRUE) + unlink(universe) +}) + +test_that("\"branch\": \"release\" in certain defined cases", { + packages <- tempfile() + dir.create(packages) + writeLines("https://github.com/r-lib/gh", file.path(packages, "gh")) + writeLines( + "https://github.com/jeroen/jsonlite", + file.path(packages, "jsonlite") + ) + writeLines( + "https://github.com/wlandau/crew", + file.path(packages, "crew") + ) + writeLines( + "https://github.com/cran/quarto", + file.path(packages, "quarto") + ) + universe <- file.path(tempfile(), "out") + suppressMessages( + r.releases.internals::write_universe_manifest( + input = packages, + output = universe, + release_exceptions = c( + "https://github.com/cran", + "https://github.com/wlandau" + ) + ) + ) + json <- jsonlite::read_json(universe) + exp <- list( + list( + package = "crew", + url = "https://github.com/wlandau/crew" + ), + list( + package = "gh", + url = "https://github.com/r-lib/gh", + branch = "*release" + ), + list( + package = "jsonlite", + url = "https://github.com/jeroen/jsonlite", + branch = "*release" + ), + list( + package = "quarto", + url = "https://github.com/cran/quarto" + ) + ) + expect_true(identical(json, exp)) + unlink(packages, recursive = TRUE) + unlink(universe) +}) + +test_that("one URL is malformed", { + packages <- tempfile() + dir.create(packages) + writeLines("https://github.com/r-lib/gh", file.path(packages, "gh")) + writeLines( + c("https://github.com/jeroen/jsonlite", "bad"), + file.path(packages, "jsonlite") + ) + universe <- file.path(tempfile(), "out") + out <- try( + suppressMessages( + r.releases.internals::write_universe_manifest( + input = packages, + output = universe + ) + ), + silent = TRUE + ) + expect_true(inherits(out, "try-error")) + unlink(packages, recursive = TRUE) + unlink(universe) +}) + +test_that("acceptable custom JSON", { + packages <- tempfile() + dir.create(packages) + writeLines("https://github.com/r-lib/gh", file.path(packages, "gh")) + writeLines( + c( + "{", + " \"package\": \"paws.analytics\",", + " \"url\": \"https://github.com/paws-r/paws\",", + " \"subdir\": \"cran/paws.analytics\",", + " \"branch\": \"*release\"", + "}" + ), + file.path(packages, "paws.analytics") + ) + universe <- file.path(tempfile(), "out") + suppressMessages( + r.releases.internals::write_universe_manifest( + input = packages, + output = universe + ) + ) + out <- jsonlite::read_json(path = universe) + exp <- list( + list( + package = "gh", + url = "https://github.com/r-lib/gh", + branch = "*release" + ), + list( + package = "paws.analytics", + url = "https://github.com/paws-r/paws", + branch = "*release", + subdir = "cran/paws.analytics" + ) + ) + expect_true(identical(out, exp)) + unlink(packages, recursive = TRUE) + unlink(universe) +}) + +test_that("malformed URL in JSON", { + packages <- tempfile() + dir.create(packages) + writeLines("https://github.com/r-lib/gh", file.path(packages, "gh")) + writeLines( + c( + "{", + " \"package\": \"paws.analytics\",", + " \"url\": \"b a d u r l\",", + " \"subdir\": \"cran/paws.analytics\",", + " \"branch\": \"*release\"", + "}" + ), + file.path(packages, "paws.analytics") + ) + universe <- file.path(tempfile(), "out") + out <- try( + suppressMessages( + r.releases.internals::write_universe_manifest( + input = packages, + output = universe + ) + ), + silent = TRUE + ) + expect_true( + grepl( + pattern = "Found malformed URL", + x = r.releases.internals::try_message(out) + ) + ) + unlink(packages, recursive = TRUE) + unlink(universe) +}) + +test_that("missing branch field", { + packages <- tempfile() + dir.create(packages) + writeLines("https://github.com/r-lib/gh", file.path(packages, "gh")) + writeLines( + c( + "{", + " \"package\": \"paws.analytics\",", + " \"url\": \"https://github.com/paws-r/paws\",", + " \"subdir\": \"cran/paws.analytics\"", + "}" + ), + file.path(packages, "paws.analytics") + ) + universe <- file.path(tempfile(), "out") + out <- try( + suppressMessages( + r.releases.internals::write_universe_manifest( + input = packages, + output = universe + ) + ), + silent = TRUE + ) + expect_true(inherits(out, "try-error")) + expect_true( + grepl( + pattern = "JSON entry for package", + x = r.releases.internals::try_message(out), + fixed = TRUE + ) + ) + expect_true( + grepl( + pattern = "must have fields", + x = r.releases.internals::try_message(out), + fixed = TRUE + ) + ) + unlink(packages, recursive = TRUE) + unlink(universe) +}) + +test_that("disagreeing package field", { + packages <- tempfile() + dir.create(packages) + writeLines("https://github.com/r-lib/gh", file.path(packages, "gh")) + writeLines( + c( + "{", + " \"package\": \"paws.analytics2\",", + " \"url\": \"https://github.com/paws-r/paws\",", + " \"subdir\": \"cran/paws.analytics\",", + " \"branch\": \"*release\"", + "}" + ), + file.path(packages, "paws.analytics") + ) + universe <- file.path(tempfile(), "out") + out <- try( + suppressMessages( + r.releases.internals::write_universe_manifest( + input = packages, + output = universe + ) + ), + silent = TRUE + ) + expect_true(inherits(out, "try-error")) + expect_true( + grepl( + pattern = "The 'packages' field disagrees with the package name", + x = r.releases.internals::try_message(out), + fixed = TRUE + ) + ) + unlink(packages, recursive = TRUE) + unlink(universe) +}) + +test_that("bad branch field", { + packages <- tempfile() + dir.create(packages) + writeLines("https://github.com/r-lib/gh", file.path(packages, "gh")) + writeLines( + c( + "{", + " \"package\": \"paws.analytics\",", + " \"url\": \"https://github.com/paws-r/paws\",", + " \"subdir\": \"cran/paws.analytics\",", + " \"branch\": \"development\"", + "}" + ), + file.path(packages, "paws.analytics") + ) + universe <- file.path(tempfile(), "out") + out <- try( + suppressMessages( + r.releases.internals::write_universe_manifest( + input = packages, + output = universe + ) + ), + silent = TRUE + ) + expect_true(inherits(out, "try-error")) + expect_true( + grepl( + pattern = "The 'branch' field of package", + x = r.releases.internals::try_message(out), + fixed = TRUE + ) + ) + unlink(packages, recursive = TRUE) + unlink(universe) +})