tests: clean up, simplify tests (#716)

cynkra · Oct 2, 2023 · 5f18bc2 · 5f18bc2
2 parents 12fb287 + 72b23ec
commit 5f18bc2
Show file tree

Hide file tree

Showing 21 changed files with 286 additions and 260 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -54,14 +54,13 @@ Suggests:
     httptest2,
     jsonlite,
     knitr,
-    mockery,
     parsedate,
     pkgbuild,
     pkgload,
     rmarkdown,
     rstudioapi,
     rversions,
-    testthat (>= 3.0.0),
+    testthat (>= 3.1.10),
     vctrs,
     withr
 Config/Needs/readme: r-lib/downlit@f-readme-document

diff --git a/R/auto.R b/R/auto.R
@@ -206,7 +206,7 @@ update_cran_comments <- function() {
 }
 
 get_crp_date <- function() {
-  cmt <- gh::gh("/repos/eddelbuettel/crp/commits")[[1]]
+  cmt <- gh("/repos/eddelbuettel/crp/commits")[[1]]
   date <- cmt$commit$committer$date
   as.Date(date)
 }
@@ -396,7 +396,7 @@ create_github_release <- function() {
   slug <- github_slug()
   tag <- get_tag_info()
 
-  out <- gh::gh(
+  out <- gh(
     glue("POST /repos/{slug}/releases"),
     tag_name = tag$name,
     name = tag$header,
@@ -453,7 +453,7 @@ is_ignored <- function(path) {
 }
 
 create_pull_request <- function(release_branch, main_branch, remote_name, force) {
-  # FIXME: Use gh::gh() to determine if we need to create the pull request
+  # FIXME: Use gh() to determine if we need to create the pull request
   create <- TRUE
 
   if (create) {
@@ -462,7 +462,7 @@ create_pull_request <- function(release_branch, main_branch, remote_name, force)
     template_path <- system.file("templates", "pr.md", package = "fledge")
     body <- glue_collapse(readLines(template_path), sep = "\n")
 
-    pr <- gh::gh(
+    pr <- gh(
       "POST /repos/:owner/:repo/pulls",
       owner = info$owner$login,
       repo = info$name,
@@ -479,7 +479,7 @@ create_pull_request <- function(release_branch, main_branch, remote_name, force)
     )
 
     ## ensure that label exists ----
-    labels <- gh::gh(
+    labels <- gh(
       "GET /repos/:owner/:repo/labels",
       owner = info$owner$login,
       repo = info$name
@@ -489,7 +489,7 @@ create_pull_request <- function(release_branch, main_branch, remote_name, force)
     no_cran_release_label <- (length(cran_release_label) == 0)
     if (no_cran_release_label) {
       cran_release_label <- "CRAN release :station:"
-      gh::gh(
+      gh(
         "POST /repos/:owner/:repo/labels",
         owner = info[["owner"]][["login"]],
         repo = info[["name"]],
@@ -499,7 +499,7 @@ create_pull_request <- function(release_branch, main_branch, remote_name, force)
     }
 
     ## add label to PR ----
-    gh::gh(
+    gh(
       "PATCH /repos/:owner/:repo/issues/:issue_number",
       owner = info[["owner"]][["login"]],
       repo = info[["name"]],
@@ -517,7 +517,7 @@ release_after_cran_built_binaries <- function() {
   remote <- "origin"
   github_info <- github_info(remote)
 
-  prs <- gh::gh(
+  prs <- gh(
     "GET /repos/:owner/:repo/pulls",
     owner = github_info[["owner"]][["login"]],
     repo = github_info[["name"]],

diff --git a/R/gh-helpers.R b/R/gh-helpers.R
@@ -29,6 +29,6 @@ extract_repo <- function(url) {
 }
 
 get_repo_data <- function(repo) {
-  req <- gh::gh("/repos/:repo", repo = repo)
+  req <- gh("/repos/:repo", repo = repo)
   return(req)
 }
diff --git a/R/parse-news-items.R b/R/parse-news-items.R
@@ -279,7 +279,7 @@ harvest_pr_data <- function(message) {
       {
         # suppressMessages() for quiet mocking
         suppressMessages(
-          gh::gh(glue("GET /repos/{slug}/pulls/{pr_number}"))
+          gh(glue("GET /repos/{slug}/pulls/{pr_number}"))
         )
       },
       error = function(e) {
@@ -360,10 +360,10 @@ has_internet <- function() {
   if (!rlang::is_installed("curl")) {
     return(FALSE)
   }
-  if (nzchar(Sys.getenv("YES_INTERNET_TEST_FLEDGE"))) {
+  if (nzchar(Sys.getenv("FLEDGE_YES_INTERNET_TEST"))) {
     return(TRUE)
   }
-  if (nzchar(Sys.getenv("NO_INTERNET_TEST_FLEDGE"))) {
+  if (nzchar(Sys.getenv("FLEDGE_NO_INTERNET_TEST"))) {
     return(FALSE)
   }
   curl::has_internet()

diff --git a/R/repo-helper.R b/R/repo-helper.R
@@ -7,8 +7,6 @@
 #' @param date String of time for DESCRIPTION and git.
 #' @param dir Directory within which to create the mock package folder.
 #' @param news If TRUE, create a NEWS.md file.
-#' @param dev_md Whether to use "(development version)" (with `dev_md = TRUE`) or the current version
-#' number, in the first NEWS.md header.
 #'
 #' @return The path to the newly created mock package.
 #' @export
@@ -19,8 +17,7 @@ create_demo_project <- function(open = rlang::is_interactive(),
                                 email = NULL,
                                 date = "2021-09-27",
                                 dir = file.path(tempdir(), "fledge"),
-                                news = FALSE,
-                                dev_md = FALSE) {
+                                news = FALSE) {
   if (is.null(maintainer)) {
     maintainer <- whoami::fullname(fallback = "Kirill M\u00fcller")
   }
@@ -65,35 +62,17 @@ create_demo_project <- function(open = rlang::is_interactive(),
   gert::git_config_set(name = "init.defaultbranch", value = "main")
 
   if (news) {
-    usethis::with_project(
-      path = pkg,
-      {
-        rlang::with_interactive(
-          {
-            # we now have to create a demo project with a preambled NEWS.md for tests to pass
-            withr::with_options(
-              list(repos = c("CRAN" = "https://cloud.r-project.org")),
-              {
-                usethis::use_news_md()
-              }
-            )
-
-            news_lines <- readLines("NEWS.md")
-            if (!dev_md) {
-              news_lines <- sub("\\(development version\\)", desc::desc_get_version(), news_lines)
-            }
-            news_lines <- c(news_preamble(), "", news_lines)
-            writeLines(news_lines, "NEWS.md")
-          },
-          value = FALSE
-        )
-        gert::git_add("NEWS.md")
-        gert::git_commit(
-          "Add NEWS.md to track changes.",
-          author = default_gert_author(),
-          committer = default_gert_committer()
-        )
-      }
+    news_lines <- c(
+      news_preamble(), "",
+      sprintf("# %s %s", name, as.character(desc::desc_get_version())), "",
+      "* Added a `NEWS.md` file to track changes to the package."
+    )
+    brio::write_lines(news_lines, "NEWS.md")
+    gert::git_add("NEWS.md")
+    gert::git_commit(
+      "Add NEWS.md to track changes.",
+      author = default_gert_author(),
+      committer = default_gert_committer()
     )
   }
 
@@ -142,16 +121,19 @@ with_demo_project <- function(code, dir = NULL, news = TRUE, quiet = FALSE) {
 #' @return `local_demo_project()` is called for its side effect and returns `NULL`, invisibly.
 #' @rdname with_demo_project
 #' @export
-local_demo_project <- function(dir = NULL, news = TRUE, quiet = FALSE, .local_envir = parent.frame()) {
-  if (is.null(dir)) {
-    dir <- withr::local_tempdir(pattern = "fledge", .local_envir = .local_envir)
-  }
+local_demo_project <- function(dir = NULL,
+                               news = TRUE,
+                               quiet = FALSE,
+                               .local_envir = parent.frame()) {
+  dir <- dir %||%
+    withr::local_tempdir(pattern = "fledge", .local_envir = .local_envir)
 
   if (!dir.exists(dir)) {
     cli::cli_abort(c(x = "Can't find the directory {.file {dir}}."))
   }
 
   repo <- create_demo_project(dir = dir, news = news)
+
   usethis::local_project(
     path = repo,
     quiet = quiet,

diff --git a/R/utils-gh.R b/R/utils-gh.R
@@ -0,0 +1,3 @@
+gh <- function(...) {
+  gh::gh(...)
+}
diff --git a/man/create_demo_project.Rd b/man/create_demo_project.Rd
diff --git a/tests/testthat/_snaps/bump_version.md b/tests/testthat/_snaps/bump_version.md
@@ -23,8 +23,12 @@
 
 ---
 
-    x No change since last version.
-    i Use `no_change_behavior = "bump"` to force a version bump, or `no_change_behavior = "noop"` to do nothing.
+    Code
+      bump_version(no_change_behavior = "fail")
+    Condition
+      Error in `bump_version_impl()`:
+      x No change since last version.
+      i Use `no_change_behavior = "bump"` to force a version bump, or `no_change_behavior = "noop"` to do nothing.
 
 ---
 
@@ -80,21 +84,37 @@
 
 # bump_version() errors informatively for forbidden notifications
 
-    x Unindexed change(s) in `DESCRIPTION`.
-    i Commit the change(s) before running any fledge function again.
+    Code
+      bump_version()
+    Condition
+      Error in `check_clean()`:
+      x Unindexed change(s) in `DESCRIPTION`.
+      i Commit the change(s) before running any fledge function again.
 
 # bump_version() errors informatively for wrong branch
 
-    x Must be on the main branch ("main") for running fledge functions.
-    i Currently on branch "bla".
+    Code
+      bump_version()
+    Condition
+      Error in `check_main_branch()`:
+      x Must be on the main branch ("main") for running fledge functions.
+      i Currently on branch "bla".
 
 # bump_version() errors well for wrong arguments
 
-    `no_change_behavior` must be one of "bump", "noop", or "fail", not "blabla".
+    Code
+      bump_version(no_change_behavior = "blabla")
+    Condition
+      Error in `bump_version()`:
+      ! `no_change_behavior` must be one of "bump", "noop", or "fail", not "blabla".
 
 ---
 
-    `which` must be one of "dev", "patch", "pre-minor", "minor", "pre-major", or "major", not "blabla".
+    Code
+      bump_version(which = "blabla")
+    Condition
+      Error in `bump_version()`:
+      ! `which` must be one of "dev", "patch", "pre-minor", "minor", "pre-major", or "major", not "blabla".
 
 # bump_version() does nothing if no preamble and not interactive
 

diff --git a/tests/testthat/_snaps/parse-news-items.md b/tests/testthat/_snaps/parse-news-items.md
@@ -80,8 +80,13 @@
 
 # Can parse PR merge commits - PAT absence
 
-    x Can't find a GitHub Personal Access Token (PAT).
-    i See for instance `?gh::gh_token` or <https://usethis.r-lib.org/reference/github-token.html>
+    Code
+      extract_newsworthy_items(
+        "Merge pull request #332 from cynkra/conventional-parsing")
+    Condition
+      Error in `check_gh_pat()`:
+      x Can't find a GitHub Personal Access Token (PAT).
+      i See for instance `?gh::gh_token` or <https://usethis.r-lib.org/reference/github-token.html>
 
 # Can parse PR merge commits - other error
 

diff --git a/tests/testthat/_snaps/tag_version.md b/tests/testthat/_snaps/tag_version.md
@@ -17,7 +17,11 @@
 
 ---
 
-    Tag "v0.0.0.9000" exists, use `force = TRUE` to overwrite.
+    Code
+      shut_up_fledge(tag_version(force = FALSE))
+    Condition
+      Error in `tag_version_impl()`:
+      ! Tag "v0.0.0.9000" exists, use `force = TRUE` to overwrite.
 
 ---
 

diff --git a/tests/testthat/_snaps/with_demo_project.md b/tests/testthat/_snaps/with_demo_project.md
@@ -1,4 +1,8 @@
 # with_demo_project errors informatively
 
-    x Can't find the directory 'unexisting-dir'.
+    Code
+      with_demo_project(1 + 1, dir = "unexisting-dir")
+    Condition
+      Error in `local_demo_project()`:
+      x Can't find the directory 'unexisting-dir'.
 
diff --git a/tests/testthat/helper-conventional-commits.R b/tests/testthat/helper-conventional-commits.R
@@ -46,7 +46,7 @@ Also tweak the CI workflow accordingly. :sweat_smile:",
   )
 }
 
-sort_of_commit <- function(commit_message, repo) {
+sort_of_commit <- function(commit_message, repo = ".") {
   file <- digest::sha1(commit_message)
   file.create(file.path(repo, file))
   gert::git_add(file, repo = repo)

diff --git a/tests/testthat/helper-remote.R b/tests/testthat/helper-remote.R
@@ -1,24 +1,36 @@
-create_remote <- function() {
-  # assuming this is a temporary directory :-)
-  parent_dir <- dirname(getwd())
-  dir.create(file.path(parent_dir, "remote"))
-  gert::git_init(file.path(parent_dir, "remote"), bare = TRUE)
-  remote_url <- file.path(parent_dir, "remote")
-  gert::git_remote_add(remote_url, name = "origin")
+create_remote <- function(tempdir_remote) {
+  gert::git_init(tempdir_remote, bare = TRUE)
+
+  current_remotes <- gert::git_remote_list()
+  origin_exists <- "origin" %in% current_remotes[["name"]]
+  if (origin_exists) {
+    cli::cli_abort(c(
+      "Found an origin, we're in {getwd()}, was this expected?",
+      i = "Did you forget to set up a local toy repo?"
+    ))
+  }
+
+  gert::git_remote_add(tempdir_remote, name = "origin")
   gert::git_push(remote = "origin")
-  remote_url
+
+  tempdir_remote
 }
 
 show_tags <- function(remote_url) {
   tempdir_remote <- withr::local_tempdir(pattern = "remote")
+
   withr::with_dir(tempdir_remote, {
-    gert::git_clone(remote_url)
+    gert::git_clone(remote_url, path = "remote")
     gert::git_tag_list(repo = "remote")[, c("name", "ref")]
   })
 }
+
 show_files <- function(remote_url) {
   if (!gert::user_is_configured()) {
-    usethis::use_git_config(user.name = "Jane Doe", user.email = "[email protected]")
+    usethis::use_git_config(
+      user.name = "Jane Doe",
+      user.email = "[email protected]"
+    )
   }
 
   git_config <- gert::git_config_global()
@@ -28,7 +40,7 @@ show_files <- function(remote_url) {
 
   tempdir_remote <- withr::local_tempdir(pattern = "remote")
   withr::with_dir(tempdir_remote, {
-    gert::git_clone(remote_url)
+    gert::git_clone(remote_url, path = "remote")
     suppressMessages(gert::git_branch_checkout("main", force = TRUE, repo = "remote"))
     fs::dir_ls("remote", recurse = TRUE)
   })