From 7cc2bdf74cbae90233fa6c84f221631d1876598d Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Tue, 24 May 2022 11:02:34 -0500 Subject: [PATCH] Use cli for messaging (#2429) * Update active.R + test * Update build-readme.R and tests * Update find_active_file(). Includes wrapper around rstudioapi::isAvailable() that returns FALSE when testing. * Update change_maintainer_email() + tests. Refactoring Maintainer check to make it more consistent * use_lifecycle() * Update package.R and tests. I realised that there was no way for `create` to work because `package_file()` will always error if it doesn't find a `DESCRIPTION`. So I deprecated it and removed the unused code * Re-document * Update release.R. I removed `email()` and `email_browser()` since as far as I can tell they are not used anywhere, and represent a very old style of CRAN submission. I don't know how to unit test this code so I did my best to carefully execute each change by hand. * Improve package_file() error * Fix R CMD check failure * Simplify local_package_create(). And give it a name consistent with latest standards * Update run-source.R + tests * Fix remaining simple stop() calls * Convert cli_alert_* to cli_inform() (except for vignette.R, which I'll do in #2425) Closes #2364 --- DESCRIPTION | 2 +- NAMESPACE | 1 + R/active.R | 19 +-- R/build-manual.R | 2 +- R/build-readme.R | 9 +- R/check-devtools.R | 4 +- R/check-doc.R | 4 +- R/check-mac.R | 13 +- R/check-win.R | 44 ++++--- R/check.R | 13 +- R/dev-mode.R | 14 +-- R/devtools-package.R | 36 ++++++ R/document.R | 2 +- R/lint.R | 2 +- R/package.R | 49 +++----- R/pkgbuild.R | 2 +- R/r-hub.R | 2 +- R/release.R | 114 +++++++----------- R/reload.R | 4 +- R/run-examples.R | 16 +-- R/run-source.R | 42 ++++--- R/show-news.R | 2 +- R/sitrep.R | 6 +- R/test.R | 6 +- R/uninstall.R | 2 +- R/utils.R | 8 ++ R/wd.R | 4 +- R/zzz.R | 35 ------ man/as.package.Rd | 6 +- man/{devtools.Rd => devtools-package.Rd} | 6 +- man/figures/lifecycle-archived.svg | 1 + man/figures/lifecycle-defunct.svg | 1 + man/figures/lifecycle-deprecated.svg | 1 + man/figures/lifecycle-experimental.svg | 1 + man/figures/lifecycle-maturing.svg | 1 + man/figures/lifecycle-questioning.svg | 1 + man/figures/lifecycle-stable.svg | 1 + man/figures/lifecycle-superseded.svg | 1 + man/run_examples.Rd | 6 +- tests/testthat/_snaps/active.md | 21 ++++ tests/testthat/_snaps/build-readme.md | 16 +++ tests/testthat/_snaps/check-win.md | 16 +++ tests/testthat/_snaps/package.md | 27 +++++ tests/testthat/_snaps/run-source.md | 51 ++++++++ tests/testthat/helper.R | 23 +--- tests/testthat/test-active.R | 10 +- tests/testthat/test-build-readme.R | 59 ++++----- tests/testthat/test-check-doc.R | 2 +- tests/testthat/test-check-win.R | 14 +++ tests/testthat/test-install.R | 2 +- tests/testthat/test-package.R | 12 ++ tests/testthat/test-run-source.R | 41 ++++--- tests/testthat/testError/R/error.R | 2 +- .../tests/testthat/test-warn.R | 2 +- 54 files changed, 455 insertions(+), 326 deletions(-) create mode 100644 R/devtools-package.R rename man/{devtools.Rd => devtools-package.Rd} (92%) create mode 100644 man/figures/lifecycle-archived.svg create mode 100644 man/figures/lifecycle-defunct.svg create mode 100644 man/figures/lifecycle-deprecated.svg create mode 100644 man/figures/lifecycle-experimental.svg create mode 100644 man/figures/lifecycle-maturing.svg create mode 100644 man/figures/lifecycle-questioning.svg create mode 100644 man/figures/lifecycle-stable.svg create mode 100644 man/figures/lifecycle-superseded.svg create mode 100644 tests/testthat/_snaps/active.md create mode 100644 tests/testthat/_snaps/build-readme.md create mode 100644 tests/testthat/_snaps/check-win.md create mode 100644 tests/testthat/_snaps/package.md create mode 100644 tests/testthat/_snaps/run-source.md create mode 100644 tests/testthat/test-check-win.R create mode 100644 tests/testthat/test-package.R diff --git a/DESCRIPTION b/DESCRIPTION index 88fb896c6..11015183c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -22,6 +22,7 @@ Imports: DT (>= 0.21), ellipsis (>= 0.3.2), fs (>= 1.5.2), + lifecycle (>= 1.0.1), memoise (>= 2.0.1), miniUI (>= 0.1.1.1), pkgbuild (>= 1.3.1), @@ -51,7 +52,6 @@ Suggests: gmailr (>= 1.0.1), httr (>= 1.4.2), knitr (>= 1.37), - lifecycle (>= 1.0.1), lintr (>= 2.0.1), MASS, mockery (>= 0.4.3), diff --git a/NAMESPACE b/NAMESPACE index 2fb640b16..b9b6527f3 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -83,6 +83,7 @@ import(fs) importFrom(cli,cat_bullet) importFrom(cli,cat_rule) importFrom(ellipsis,check_dots_used) +importFrom(lifecycle,deprecated) importFrom(memoise,memoise) importFrom(pkgbuild,clean_dll) importFrom(pkgbuild,find_rtools) diff --git a/R/active.R b/R/active.R index f3b8f236b..ebe7792a3 100644 --- a/R/active.R +++ b/R/active.R @@ -1,17 +1,18 @@ -find_active_file <- function(arg = "file") { - if (!rstudioapi::isAvailable()) { - stop("Argument `", arg, "` is missing, with no default", call. = FALSE) +find_active_file <- function(arg = "file", call = parent.frame()) { + if (!is_rstudio_running()) { + cli::cli_abort("Argument {.arg {arg}} is missing, with no default", call = call) } normalizePath(rstudioapi::getSourceEditorContext()$path) } -find_test_file <- function(path) { +find_test_file <- function(path, call = parent.frame()) { type <- test_file_type(path) if (any(is.na(type))) { - rlang::abort(c( - "Don't know how to find tests associated with the active file:", - path[is.na(type)] - )) + file <- path_file(path[is.na(type)]) + cli::cli_abort( + "Don't know how to find tests associated with the active file {.file {file}}", + call = call + ) } is_test <- type == "test" @@ -19,7 +20,7 @@ find_test_file <- function(path) { path <- unique(path[file_exists(path)]) if (length(path) == 0) { - rlang::abort("No test files found") + cli::cli_abort("No test files found", call = call) } path } diff --git a/R/build-manual.R b/R/build-manual.R index 2986809b7..0c9112db2 100644 --- a/R/build-manual.R +++ b/R/build-manual.R @@ -17,7 +17,7 @@ build_manual <- function(pkg = ".", path = NULL) { ), fail_on_status = TRUE, stderr = "2>&1", spinner = FALSE), error = function(e) { cat(e$stdout) - stop("Failed to build manual", call. = FALSE) + cli::cli_abort("Failed to build manual") }) cat(msg$stdout) diff --git a/R/build-readme.R b/R/build-readme.R index d7e569a1a..70bba4726 100644 --- a/R/build-readme.R +++ b/R/build-readme.R @@ -28,7 +28,7 @@ build_rmd <- function(files, path = ".", output_options = list(), ..., quiet = T cli::cli_abort("Can't find file{?s}: {.path {files[!ok]}}.") } - cli::cli_alert_info("Installing {.pkg {pkg$package}} in temporary library") + cli::cli_inform(c(i = "Installing {.pkg {pkg$package}} in temporary library")) withr::local_temp_libpaths() install(pkg, upgrade = "never", reload = FALSE, quick = TRUE, quiet = quiet) @@ -37,7 +37,7 @@ build_rmd <- function(files, path = ".", output_options = list(), ..., quiet = T for (path in paths) { - cli::cli_alert_info("Building {.path {path}}") + cli::cli_inform(c(i = "Building {.path {path}}")) callr::r_safe( function(...) rmarkdown::render(...), args = list(input = path, ..., output_options = output_options, quiet = quiet), @@ -58,11 +58,10 @@ build_readme <- function(path = ".", quiet = TRUE, ...) { readme_path <- path_abs(dir_ls(pkg$path, ignore.case = TRUE, regexp = "(inst/)?readme[.]rmd", recurse = 1, type = "file")) if (length(readme_path) == 0) { - rlang::abort("Can't find a 'README.Rmd' or 'inst/README.Rmd' file.") + cli::cli_abort("Can't find {.file README.Rmd} or {.file inst/README.Rmd}.") } - if (length(readme_path) > 1) { - rlang::abort("Can't have both a 'README.Rmd' and 'inst/README.Rmd' file.") + cli::cli_abort("Can't have both {.file README.Rmd} and {.file inst/README.Rmd}.") } build_rmd(readme_path, path = path, quiet = quiet, ...) diff --git a/R/check-devtools.R b/R/check-devtools.R index 2ed6492bb..96727b00e 100644 --- a/R/check-devtools.R +++ b/R/check-devtools.R @@ -131,11 +131,11 @@ check_status <- function(status, name, warning) { cat(" OK\n") } else { cat("\n") - cli::cli_alert_danger("WARNING: {warning}") + cli::cli_inform(c(x = "WARNING: {warning}")) }, error = function(e) { cat("\n") - cli::cli_alert_danger("ERROR: {conditionMessage(e)}") + cli::cli_inform(c(x = "ERROR: {conditionMessage(e)}")) FALSE } ) diff --git a/R/check-doc.R b/R/check-doc.R index c70036ca4..e809e3992 100644 --- a/R/check-doc.R +++ b/R/check-doc.R @@ -20,7 +20,7 @@ check_man <- function(pkg = ".") { old <- options(warn = -1) on.exit(options(old)) - cli::cli_alert_info("Checking documentation...") + cli::cli_inform(c(i = "Checking documentation...")) check_Rd_contents <- if (getRversion() < "4.1") { asNamespace("tools")$.check_Rd_contents @@ -42,7 +42,7 @@ check_man <- function(pkg = ".") { ) if (ok) { - cli::cli_alert_success("No issues detected") + cli::cli_inform(c(v = "No issues detected")) } invisible() diff --git a/R/check-mac.R b/R/check-mac.R index 05a332327..a275d5ee5 100644 --- a/R/check-mac.R +++ b/R/check-mac.R @@ -16,10 +16,10 @@ check_mac_release <- function(pkg = ".", dep_pkgs = character(), args = NULL, ma pkg <- as.package(pkg) if (!quiet) { - cli::cli_alert_info( + cli::cli_inform(c( "Building macOS version of {.pkg {pkg$package}} ({pkg$version})", - "with https://mac.r-project.org/macbuilder/submit.html." - ) + i = "Using https://mac.r-project.org/macbuilder/submit.html." + )) } built_path <- pkgbuild::build(pkg$path, tempdir(), @@ -62,9 +62,10 @@ check_mac_release <- function(pkg = ".", dep_pkgs = character(), args = NULL, ma if (!quiet) { time <- strftime(Sys.time() + 10 * 60, "%I:%M %p") - cli::cli_alert_success( - "[{Sys.Date()}] Check {.url {response_url}} for the results in 5-10 mins (~{time})." - ) + cli::cat_rule(col = "cyan") + cli::cli_inform(c( + i = "Check {.url {response_url}} the results in 5-10 mins (~{time})." + )) } invisible(response_url) diff --git a/R/check-win.R b/R/check-win.R index eec880a84..f8a2df83d 100644 --- a/R/check-win.R +++ b/R/check-win.R @@ -61,7 +61,7 @@ check_win <- function(pkg = ".", version = c("R-devel", "R-release", "R-oldrelea file_copy(desc_file, backup) on.exit(file_move(backup, desc_file), add = TRUE) - change_maintainer_email(desc_file, email) + change_maintainer_email(desc_file, email, call = parent.frame()) pkg <- as.package(pkg$path) } @@ -69,13 +69,13 @@ check_win <- function(pkg = ".", version = c("R-devel", "R-release", "R-oldrelea version <- match.arg(version, several.ok = TRUE) if (!quiet) { - cli::cli_alert_info( + cli::cli_inform(c( "Building windows version of {.pkg {pkg$package}} ({pkg$version})", - " for {paste(version, collapse = ', ')} with win-builder.r-project.org." - ) + i = "Using {paste(version, collapse = ', ')} with win-builder.r-project.org." + )) - email <- cli::style_bold(maintainer(pkg)$email) - if (interactive() && yesno("Email results to ", email, "?")) { + email <- maintainer(pkg)$email + if (interactive() && yesno("Email results to {.strong {email}}?")) { return(invisible()) } } @@ -96,32 +96,40 @@ check_win <- function(pkg = ".", version = c("R-devel", "R-release", "R-oldrelea time <- strftime(Sys.time() + 30 * 60, "%I:%M %p") email <- maintainer(pkg)$email - cli::cli_alert_success( - "[{Sys.Date()}] Check <{.email {email}}> for a link to results in 15-30 mins (~{time})." - ) + cli::cat_rule(col = "cyan") + cli::cli_inform(c( + i = "Check <{.email {email}}> for the results in 15-30 mins (~{time})." + )) } invisible() } -change_maintainer_email <- function(desc, email) { - desc <- desc::desc(file = desc) +change_maintainer_email <- function(path, email, call = parent.frame()) { + desc <- desc::desc(file = path) if (!desc$has_fields("Authors@R")) { - stop("DESCRIPTION must use `Authors@R` field to change the maintainer email", call. = FALSE) + cli::cli_abort( + "DESCRIPTION must use {.field Authors@R} field when changing {.arg email}", + call = call + ) + } + if (desc$has_fields("Maintainer")) { + cli::cli_abort( + "DESCRIPTION can't use {.field Maintainer} field when changing {.arg email}", + call = call + ) } + aut <- desc$get_authors() roles <- aut$role ## Broken person() API, vector for 1 author, list otherwise... - if (!is.list(roles)) roles <- list(roles) + if (!is.list(roles)) { + roles <- list(roles) + } is_maintainer <- vapply(roles, function(r) all("cre" %in% r), logical(1)) aut[is_maintainer]$email <- email - desc$set_authors(aut) - ## Check if the email is actually changed before we actually send the email - if(!grepl(email, desc$get_maintainer())){ - stop("Changing maintainer email failed. Possible reason is using both Authors@R and Maintainer fields in the DESCRIPTION file.", call. = FALSE) - } desc$write() } diff --git a/R/check.R b/R/check.R index f7b13f9cf..3e3dc0ecd 100644 --- a/R/check.R +++ b/R/check.R @@ -76,7 +76,7 @@ check <- function(pkg = ".", save_all() if (!missing(cleanup)) { - warning("`cleanup` is deprecated", call. = FALSE) + lifecycle::deprecate_stop("1.11.0", "lifecycle::check(cleanup = )") } if (missing(error_on) && !interactive()) { @@ -145,12 +145,11 @@ can_document <- function(pkg) { installed <- packageVersion("roxygen2") if (required != installed) { cli::cli_rule() - cli::cli_alert_info( - "Installed roxygen2 version ({installed}) doesn't match required version ({required})" - ) - cli::cli_alert_danger("check() will not re-document this package") + cli::cli_inform(c( + i = "Installed roxygen2 version ({installed}) doesn't match required ({required})", + x = "{.fun check} will not re-document this package" + )) cli::cli_rule() - FALSE } else { TRUE @@ -199,7 +198,7 @@ check_built <- function(path = NULL, cran = TRUE, } if (manual && !pkgbuild::has_latex()) { - cli::cli_alert_danger("pdflatex not found! Not building PDF manual or vignettes") + cli::cli_inform(c(x = "pdflatex not found! Not building PDF manual")) manual <- FALSE } diff --git a/R/dev-mode.R b/R/dev-mode.R index 525b5ae1b..dcc1488dc 100644 --- a/R/dev-mode.R +++ b/R/dev-mode.R @@ -32,17 +32,17 @@ dev_mode <- local({ dir_create(path) } if (!file_exists(path)) { - stop("Failed to create ", path, call. = FALSE) + cli::cli_abort("Failed to create {.path {path}}") } if (!is_library(path)) { - warning(path, " does not appear to be a library. ", - "Are sure you specified the correct directory?", - call. = FALSE - ) + cli::cli_warn(c( + "{.path {path}} does not appear to be a library.", + "Are sure you specified the correct directory?" + )) } - cli::cli_alert_success("Dev mode: ON") + cli::cli_inform(c(v = "Dev mode: ON")) options(dev_path = path) if (is.null(.prompt)) .prompt <<- getOption("prompt") @@ -50,7 +50,7 @@ dev_mode <- local({ .libPaths(c(path, lib_paths)) } else { - cli::cli_alert_success("Dev mode: OFF") + cli::cli_inform(c(v = "Dev mode: OFF")) options(dev_path = NULL) if (!is.null(.prompt)) options(prompt = .prompt) diff --git a/R/devtools-package.R b/R/devtools-package.R new file mode 100644 index 000000000..c8bfbeb49 --- /dev/null +++ b/R/devtools-package.R @@ -0,0 +1,36 @@ +#' @section Package options: +#' +#' Devtools uses the following [options()] to configure behaviour: +#' +#' \itemize{ +#' \item `devtools.path`: path to use for [dev_mode()] +#' +#' \item `devtools.name`: your name, used when signing draft +#' emails. +#' +#' \item `devtools.install.args`: a string giving extra arguments passed +#' to `R CMD install` by [install()]. +#' +#' \item `devtools.desc.author`: a string providing a default Authors@@R +#' string to be used in new \file{DESCRIPTION}s. Should be a R code, and +#' look like `"Hadley Wickham [aut, cre]"`. See +#' [utils::as.person()] for more details. +#' +#' \item `devtools.desc.license`: a default license string to use for +#' new packages. +#' +#' \item `devtools.desc.suggests`: a character vector listing packages to +#' to add to suggests by defaults for new packages. +# +#' \item `devtools.desc`: a named list listing any other +#' extra options to add to \file{DESCRIPTION} +#' +#' } +#' @docType package +#' @keywords internal +"_PACKAGE" + +## usethis namespace: start +#' @importFrom lifecycle deprecated +## usethis namespace: end +NULL diff --git a/R/document.R b/R/document.R index d1e1e0e43..febb346be 100644 --- a/R/document.R +++ b/R/document.R @@ -13,7 +13,7 @@ document <- function(pkg = ".", roclets = NULL, quiet = FALSE) { pkg <- as.package(pkg) if (!isTRUE(quiet)) { - cli::cli_alert_info("Updating {.pkg {pkg$package}} documentation") + cli::cli_inform(c(i = "Updating {.pkg {pkg$package}} documentation")) } save_all() diff --git a/R/lint.R b/R/lint.R index da17b0a2e..10f9b1ac5 100644 --- a/R/lint.R +++ b/R/lint.R @@ -15,7 +15,7 @@ lint <- function(pkg = ".", cache = TRUE, ...) { rlang::check_installed("lintr") pkg <- as.package(pkg) - cli::cli_alert_info("Linting {.pkg {pkg$package}}") + cli::cli_inform(c(i = "Linting {.pkg {pkg$package}}")) check_dots_used(action = getOption("devtools.ellipsis_action", rlang::warn)) diff --git a/R/package.R b/R/package.R index 8427d115c..debbb79f1 100644 --- a/R/package.R +++ b/R/package.R @@ -6,16 +6,17 @@ #' \item package object #' } #' @param x object to coerce to a package -#' @param create only relevant if a package structure does not exist yet: if -#' `TRUE`, create a package structure; if `NA`, ask the user -#' (in interactive mode only) +#' @param create `r lifecycle::badge("deprecated")` Hasn't worked for some time. #' @export #' @keywords internal -as.package <- function(x = NULL, create = NA) { +as.package <- function(x = NULL, create = deprecated()) { if (is.package(x)) return(x) + if (lifecycle::is_present(create)) { + lifecycle::deprecate_warn("2.5.0", "as.package(create = )") + } x <- package_file(path = x) - load_pkg_description(x, create = create) + load_pkg_description(x) } #' Find file in a package. @@ -34,23 +35,24 @@ as.package <- function(x = NULL, create = NA) { #' } package_file <- function(..., path = ".") { if (!is.character(path) || length(path) != 1) { - stop("`path` must be a string.", call. = FALSE) - } - path <- strip_slashes(path_real(path)) - - if (!file_exists(path)) { - stop("Can't find '", path, "'.", call. = FALSE) + cli::cli_abort("{.arg path} must be a string.") } - if (!is_dir(path)) { - stop("'", path, "' is not a directory.", call. = FALSE) + if (!dir_exists(path)) { + cli::cli_abort("{.path {path}} is not a directory.") } + base_path <- path + path <- strip_slashes(path_real(path)) + # Walk up to root directory while (!has_description(path)) { path <- path_dir(path) if (is_root(path)) { - stop("Could not find package root. Is your working directory inside a package?", call. = FALSE) + cli::cli_abort(c( + "Could not find package root.", + i = "Is {.path {base_path}} inside a package?" + )) } } @@ -71,25 +73,9 @@ strip_slashes <- function(x) { } # Load package DESCRIPTION into convenient form. -load_pkg_description <- function(path, create) { +load_pkg_description <- function(path) { path_desc <- path(path, "DESCRIPTION") - if (!file_exists(path_desc)) { - if (is.na(create)) { - if (interactive()) { - cli::cli_alert_danger("No package infrastructure found in {.file {path}}. Create it?") - create <- (utils::menu(c("Yes", "No")) == 1) - } else { - create <- FALSE - } - } - - if (create) { - usethis::create_package(path = path) - } else { - stop("No description at ", path_desc, call. = FALSE) - } - } info <- read.dcf(path_desc)[1, ] Encoding(info) <- 'UTF-8' desc <- as.list(info) @@ -99,7 +85,6 @@ load_pkg_description <- function(path, create) { structure(desc, class = "package") } - #' Is the object a package? #' #' @keywords internal diff --git a/R/pkgbuild.R b/R/pkgbuild.R index dfecbe60e..9287afc15 100644 --- a/R/pkgbuild.R +++ b/R/pkgbuild.R @@ -12,7 +12,7 @@ build <- function(pkg = ".", path = NULL, binary = FALSE, vignettes = TRUE, save_all() if (!file_exists(pkg)) { - stop("`pkg` must exist", call. = FALSE) + cli::cli_abort("{.arg pkg} must exist") } check_dots_used(action = getOption("devtools.ellipsis_action", rlang::warn)) diff --git a/R/r-hub.R b/R/r-hub.R index bcbbf59b4..d3f690a8e 100644 --- a/R/r-hub.R +++ b/R/r-hub.R @@ -54,7 +54,7 @@ check_rhub <- function(pkg = ".", ) if (!interactive) { - cli::cli_alert_success("R-hub check for package {.pkg {pkg$package}} submitted.") + cli::cli_inform(c(v = "R-hub check for package {.pkg {pkg$package}} submitted.")) status } else { status diff --git a/R/release.R b/R/release.R index 993ab12c2..9ac699815 100644 --- a/R/release.R +++ b/R/release.R @@ -79,10 +79,7 @@ release <- function(pkg = ".", check = FALSE, args = NULL) { cran_mirror(), "/web/checks/check_results_", pkg$package, ".html" ) - if (yesno( - "Have you fixed all existing problems at \n", cran_url, - end_sentence - )) { + if (yesno("Have you fixed all existing problems at \n{cran_url}{end_sentence}")) { return(invisible()) } } @@ -149,57 +146,17 @@ find_release_questions <- function(pkg = ".") { } } -yesno <- function(...) { +yesno <- function(msg, .envir = parent.frame()) { yeses <- c("Yes", "Definitely", "For sure", "Yup", "Yeah", "Of course", "Absolutely") nos <- c("No way", "Not yet", "I forget", "No", "Nope", "Uhhhh... Maybe?") - cat(paste0(..., collapse = "")) + cli::cli_inform(msg, .envir = .envir) qs <- c(sample(yeses, 1), sample(nos, 2)) rand <- sample(length(qs)) utils::menu(qs[rand]) != which(rand == 1) } -# https://tools.ietf.org/html/rfc2368 -email <- function(address, subject, body) { - url <- paste( - "mailto:", - utils::URLencode(address), - "?subject=", utils::URLencode(subject), - "&body=", utils::URLencode(body), - sep = "" - ) - - tryCatch({ - utils::browseURL(url, browser = email_browser()) - }, - error = function(e) { - cli::cli_alert_danger("Sending failed with error: {e$message}") - cat("To: ", address, "\n", sep = "") - cat("Subject: ", subject, "\n", sep = "") - cat("\n") - cat(body, "\n", sep = "") - } - ) - - invisible(TRUE) -} - -email_browser <- function() { - if (!identical(.Platform$GUI, "RStudio")) { - return(getOption("browser")) - } - - # Use default browser, even if RStudio running - if (.Platform$OS.type == "windows") { - return(NULL) - } - - browser <- Sys.which(c("xdg-open", "open")) - browser[nchar(browser) > 0][[1]] -} - - maintainer <- function(pkg = ".") { pkg <- as.package(pkg) @@ -214,7 +171,7 @@ maintainer <- function(pkg = ".") { } else { maintainer <- pkg$maintainer if (is.null(maintainer)) { - stop("No maintainer defined in package.", call. = FALSE) + cli::cli_abort("No maintainer defined in package.") } maintainer <- utils::as.person(maintainer) } @@ -225,15 +182,18 @@ maintainer <- function(pkg = ".") { ) } -cran_comments <- function(pkg = ".") { +cran_comments <- function(pkg = ".", call = parent.frame()) { pkg <- as.package(pkg) path <- path(pkg$path, "cran-comments.md") if (!file_exists(path)) { - warning("Can't find cran-comments.md.\n", - "This file gives CRAN volunteers comments about the submission,\n", - "Create it with use_cran_comments().\n", - call. = FALSE + cli::cli_warn( + c( + x = "Can't find {.file cran-comments.md}.", + i = "This file is used to communicate your release process to the CRAN team.", + i = "Create it with {.code use_cran_comments()}." + ), + call = call ) return(character()) } @@ -257,14 +217,23 @@ cran_submission_url <- "https://xmpalantir.wu.ac.at/cransubmit/index2.php" #' @export #' @keywords internal submit_cran <- function(pkg = ".", args = NULL) { - if (yesno("Is your email address ", maintainer(pkg)$email, "?")) { + if (yesno("Is your email address {maintainer(pkg)$email}?")) { return(invisible()) } pkg <- as.package(pkg) - built_path <- build_cran(pkg, args = args) - if (yesno("Ready to submit ", pkg$package, " (", pkg$version, ") to CRAN?")) { + built_path <- pkgbuild::build(pkg$path, tempdir(), manual = TRUE, args = args) + + size <- format(as.object_size(file_info(built_path)$size), units = "auto") + cli::cat_rule("Submitting", col = "cyan") + cli::cli_inform(c( + "i" = "Path {.file {built_path}}", + "i" = "File size: {size}" + )) + cli::cat_line() + + if (yesno("Ready to submit {pkg$package} ({pkg$version}) to CRAN?")) { return(invisible()) } @@ -275,15 +244,6 @@ submit_cran <- function(pkg = ".", args = NULL) { ) } -build_cran <- function(pkg, args) { - cli::cli_alert_info("Building") - built_path <- pkgbuild::build(pkg$path, tempdir(), manual = TRUE, args = args) - cli::cli_alert_info("Submitting file: {built_path}") - size <- format(as.object_size(file_info(built_path)$size), units = "auto") - cli::cli_alert_info("File size: {size}") - built_path -} - extract_cran_msg <- function(msg) { # Remove "CRAN package Submission" and "Submit package to CRAN" msg <- gsub("CRAN package Submission|Submit package to CRAN", "", msg) @@ -300,13 +260,13 @@ extract_cran_msg <- function(msg) { msg } -upload_cran <- function(pkg, built_path) { +upload_cran <- function(pkg, built_path, call = parent.frame()) { pkg <- as.package(pkg) maint <- maintainer(pkg) - comments <- cran_comments(pkg) + comments <- cran_comments(pkg, call = call) # Initial upload --------- - cli::cli_alert_info("Uploading package & comments") + cli::cli_inform(c(i = "Uploading package & comments")) body <- list( pkg_id = "", name = maint$name, @@ -324,14 +284,20 @@ upload_cran <- function(pkg, built_path) { r2 <- httr::GET(sub("index2", "index", cran_submission_url)) msg <- extract_cran_msg(httr::content(r2, "text")) }) - stop("Submission failed:", msg, call. = FALSE) + cli::cli_abort( + c( + "*" = "Submission failed", + "x" = msg + ), + call = call + ) } httr::stop_for_status(r) new_url <- httr::parse_url(r$url) # Confirmation ----------- - cli::cli_alert_info("Confirming submission") + cli::cli_inform(c(i = "Confirming submission")) body <- list( pkg_id = new_url$query$pkg_id, name = maint$name, @@ -343,10 +309,12 @@ upload_cran <- function(pkg, built_path) { httr::stop_for_status(r) new_url <- httr::parse_url(r$url) if (new_url$query$submit == "1") { - cli::cli_alert_success("Package submission successful") - cli::cli_alert_info("Check your email for confirmation link.") + cli::cli_inform(c( + "v" = "Package submission successful", + "i" = "Check your email for confirmation link." + )) } else { - stop("Package failed to upload.", call. = FALSE) + cli::cli_abort("Package failed to upload.", call = call) } invisible(TRUE) @@ -360,7 +328,7 @@ flag_release <- function(pkg = ".") { return(invisible()) } - cli::cli_alert_warning("Don't forget to tag this release once accepted by CRAN") + cli::cli_inform(c("!" = "Don't forget to tag this release once accepted by CRAN")) withr::with_dir(pkg$path, { sha <- system2("git", c("rev-parse", "HEAD"), stdout = TRUE) diff --git a/R/reload.R b/R/reload.R index c6ba9467f..d3e0046be 100644 --- a/R/reload.R +++ b/R/reload.R @@ -26,11 +26,11 @@ reload <- function(pkg = ".", quiet = FALSE) { pkg <- as.package(pkg) if (is_attached(pkg)) { - if (!quiet) cli::cli_alert_info("Reloading attached {.pkg {pkg$package}}") + if (!quiet) cli::cli_inform(c(i = "Reloading attached {.pkg {pkg$package}}")) pkgload::unload(pkg$package) require(pkg$package, character.only = TRUE, quietly = TRUE) } else if (is_loaded(pkg)) { - if (!quiet) cli::cli_alert_info("Reloading loaded {.pkg {pkg$package}}") + if (!quiet) cli::cli_inform(c(i = "Reloading loaded {.pkg {pkg$package}}")) pkgload::unload(pkg$package) requireNamespace(pkg$package, quietly = TRUE) } diff --git a/R/run-examples.R b/R/run-examples.R index e3c2413b1..cfc87fd72 100644 --- a/R/run-examples.R +++ b/R/run-examples.R @@ -22,17 +22,21 @@ #' examples are updated before running them. #' @keywords programming #' @export -run_examples <- function(pkg = ".", start = NULL, show = TRUE, run_donttest = FALSE, - run_dontrun = FALSE, fresh = FALSE, document = TRUE, run, test) { +run_examples <- function(pkg = ".", start = NULL, show = deprecated(), run_donttest = FALSE, + run_dontrun = FALSE, fresh = FALSE, document = TRUE, + run = deprecated(), test = deprecated()) { if (!missing(run)) { - warning("`run_examples(run=)` is deprecated, please use `run_example(run_dontrun=)` instead", call. = FALSE) + lifecycle::deprecate_warn("2.3.1", "run_examples(run)", 'run_example(run_dontrun)') run_dontrun <- run } if (!missing(test)) { - warning("`run_examples(test=)` is deprecated, please use `run_example(run_donttest=)` instead", call. = FALSE) + lifecycle::deprecate_warn("2.3.1", "run_examples(test)", 'run_example(run_donttest)') run_donttest <- test } + if (!missing(show)) { + lifecycle::deprecate_warn("2.3.1", "run_examples(show)") + } pkg <- as.package(pkg) @@ -48,10 +52,6 @@ run_examples <- function(pkg = ".", start = NULL, show = TRUE, run_donttest = FA document(pkg) } - if (!missing(show)) { - warning("`show` is deprecated", call. = FALSE) - } - files <- rd_files(pkg$path, start = start) if (length(files) == 0) { return() diff --git a/R/run-source.R b/R/run-source.R index 41fac6f32..13bbb448a 100644 --- a/R/run-source.R +++ b/R/run-source.R @@ -39,29 +39,31 @@ source_url <- function(url, ..., sha1 = NULL) { httr::stop_for_status(request) writeBin(httr::content(request, type = "raw"), temp_file) - file_sha1 <- digest::digest(file = temp_file, algo = "sha1") + check_sha1(temp_file, sha1) + + check_dots_used(action = getOption("devtools.ellipsis_action", rlang::warn)) + source(temp_file, ...) +} + +check_sha1 <- function(path, sha1) { + file_sha1 <- digest::digest(file = path, algo = "sha1") if (is.null(sha1)) { - cli::cli_alert_info("SHA-1 hash of file is {file_sha1}") + cli::cli_inform(c(i = "SHA-1 hash of file is {.str {file_sha1}}")) } else { if (nchar(sha1) < 6) { - stop("Supplied SHA-1 hash is too short (must be at least 6 characters)") + cli::cli_abort("{.arg sha1} must be at least 6 characters, not {nchar(sha1)}.") } # Truncate file_sha1 to length of sha1 file_sha1 <- substr(file_sha1, 1, nchar(sha1)) if (!identical(file_sha1, sha1)) { - stop("SHA-1 hash of downloaded file (", file_sha1, - ")\n does not match expected value (", sha1, ")", - call. = FALSE + cli::cli_abort( + "{.arg sha1} ({.str {sha1}}) doesn't match SHA-1 hash of downloaded file ({.str {file_sha1}})" ) } } - - check_dots_used(action = getOption("devtools.ellipsis_action", rlang::warn)) - - source(temp_file, ...) } #' Run a script on gist @@ -119,36 +121,40 @@ source_gist <- function(id, ..., filename = NULL, sha1 = NULL, quiet = FALSE) { # 1654919 or "1654919" url <- find_gist(id, filename) } else { - stop("Unknown id: ", id) + cli::cli_abort("Invalid gist id specification {.str {id}}") } - if (!quiet) cli::cli_alert_info("Sourcing {url}") + if (!quiet) { + cli::cli_inform(c(i = "Sourcing gist {.str {id}}")) + } check_dots_used(action = getOption("devtools.ellipsis_action", rlang::warn)) - source_url(url, ..., sha1 = sha1) } -find_gist <- function(id, filename) { +find_gist <- function(id, filename = NULL, call = parent.frame()) { files <- gh::gh("GET /gists/:id", id = id)$files r_files <- files[grepl("\\.[rR]$", names(files))] if (length(r_files) == 0) { - stop("No R files found in gist", call. = FALSE) + cli::cli_abort("No R files found in gist", call = call) } if (!is.null(filename)) { if (!is.character(filename) || length(filename) > 1 || !grepl("\\.[rR]$", filename)) { - stop("'filename' must be NULL, or a single filename ending in .R/.r", call. = FALSE) + cli::cli_abort( + "{.arg filename} must be {.code NULL}, or a single filename ending in .R/.r", + call = call + ) } which <- match(tolower(filename), tolower(names(r_files))) if (is.na(which)) { - stop("'", filename, "' not found in this gist", call. = FALSE) + cli::cli_abort("{.path {filename}} not found in gist", call = call) } } else { if (length(r_files) > 1) { - warning("Multiple R files in gist, using first", call. = FALSE) + cli::cli_inform("{length(r_files)} .R files in gist, using first", call = call) } which <- 1 } diff --git a/R/show-news.R b/R/show-news.R index bb70bde0a..2349bec0b 100644 --- a/R/show-news.R +++ b/R/show-news.R @@ -10,7 +10,7 @@ show_news <- function(pkg = ".", latest = TRUE, ...) { news_path <- path(pkg$path, "NEWS") if (!file_exists(news_path)) { - stop("No NEWS found", call. = FALSE) + cli::cli_abort("No NEWS found") } check_dots_used(action = getOption("devtools.ellipsis_action", rlang::warn)) diff --git a/R/sitrep.R b/R/sitrep.R index fc3dad3a9..27c809c24 100644 --- a/R/sitrep.R +++ b/R/sitrep.R @@ -3,7 +3,7 @@ NULL rstudio_version_string <- function() { - if (!rstudioapi::isAvailable()) { + if (!is_rstudio_running()) { return(character()) } rvi <- rstudioapi::versionInfo() @@ -12,7 +12,7 @@ rstudio_version_string <- function() { check_for_rstudio_updates <- function(os = tolower(Sys.info()[["sysname"]]), version = rstudio_version_string(), - in_rstudio = rstudioapi::isAvailable()) { + in_rstudio = is_rstudio_running()) { if (!in_rstudio) { return() } @@ -107,7 +107,7 @@ dev_sitrep <- function(pkg = ".", debug = FALSE) { devtools_version = packageVersion("devtools"), devtools_deps = remotes::package_deps("devtools", dependencies = NA), pkg_deps = if (!is.null(pkg)) { remotes::dev_package_deps(pkg$path, dependencies = TRUE) }, - rstudio_version = if (rstudioapi::isAvailable()) rstudioapi::getVersion(), + rstudio_version = if (is_rstudio_running()) rstudioapi::getVersion(), rstudio_msg = check_for_rstudio_updates() ), class = "dev_sitrep" diff --git a/R/test.R b/R/test.R index b7665a643..29ecb6210 100644 --- a/R/test.R +++ b/R/test.R @@ -23,7 +23,7 @@ test <- function(pkg = ".", filter = NULL, stop_on_failure = FALSE, export_all = pkg <- as.package(pkg) if (!uses_testthat(pkg)) { - cli::cli_alert_danger("No testing infrastructure found.") + cli::cli_inform(c(i = "No testing infrastructure found.")) if (!interactive()) { ui_todo('Setup testing with {ui_code("usethis::use_testthat()")}.') return(invisible()) @@ -37,7 +37,7 @@ test <- function(pkg = ".", filter = NULL, stop_on_failure = FALSE, export_all = load_all(pkg$path) - cli::cli_alert_info("Testing {.pkg {pkg$package}}") + cli::cli_inform(c(i = "Testing {.pkg {pkg$package}}")) withr::local_envvar(r_env_vars()) testthat::test_local( pkg$path, @@ -74,7 +74,7 @@ test_coverage <- function(pkg = ".", show_report = interactive(), ...) { save_all() pkg <- as.package(pkg) - cli::cli_alert_info("Computing test coverage for {.pkg {pkg$package}}") + cli::cli_inform(c(i = "Computing test coverage for {.pkg {pkg$package}}")) check_dots_used(action = getOption("devtools.ellipsis_action", rlang::warn)) diff --git a/R/uninstall.R b/R/uninstall.R index 427cbf827..b392890e8 100644 --- a/R/uninstall.R +++ b/R/uninstall.R @@ -18,7 +18,7 @@ uninstall <- function(pkg = ".", unload = TRUE, quiet = FALSE, lib = .libPaths() } if (!quiet) { - cli::cli_alert_info("Uninstalling {.pkg {pkg$package}}") + cli::cli_inform(c(i = "Uninstalling {.pkg {pkg$package}}")) } remove.packages(pkg$package, .libPaths()[[1]]) diff --git a/R/utils.R b/R/utils.R index 2bb3987bd..764f35345 100644 --- a/R/utils.R +++ b/R/utils.R @@ -67,3 +67,11 @@ release_bullets <- function() { NULL ) } + +is_testing <- function() { + identical(Sys.getenv("TESTTHAT"), "true") +} + +is_rstudio_running <- function() { + !is_testing() && rstudioapi::isAvailable() +} diff --git a/R/wd.R b/R/wd.R index c552f9dd8..0b3be83f3 100644 --- a/R/wd.R +++ b/R/wd.R @@ -9,9 +9,9 @@ wd <- function(pkg = ".", path = "") { path <- path(pkg$path, path) if (!file_exists(path)) { - stop(path, " does not exist", call. = FALSE) + cli::cli_abort("{.path {path} does not exist") } - cli::cli_alert_info("Changing working directory to {.path {path}}") + cli::cli_inform(c(i = "Changing working directory to {.path {path}}")) setwd(path) } diff --git a/R/zzz.R b/R/zzz.R index 46f73e88b..dc8546066 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -5,41 +5,6 @@ #' @import fs NULL -#' Package development tools for R. -#' -#' @section Package options: -#' -#' Devtools uses the following [options()] to configure behaviour: -#' -#' \itemize{ -#' \item `devtools.path`: path to use for [dev_mode()] -#' -#' \item `devtools.name`: your name, used when signing draft -#' emails. -#' -#' \item `devtools.install.args`: a string giving extra arguments passed -#' to `R CMD install` by [install()]. -#' -#' \item `devtools.desc.author`: a string providing a default Authors@@R -#' string to be used in new \file{DESCRIPTION}s. Should be a R code, and -#' look like `"Hadley Wickham [aut, cre]"`. See -#' [utils::as.person()] for more details. -#' -#' \item `devtools.desc.license`: a default license string to use for -#' new packages. -#' -#' \item `devtools.desc.suggests`: a character vector listing packages to -#' to add to suggests by defaults for new packages. -# -#' \item `devtools.desc`: a named list listing any other -#' extra options to add to \file{DESCRIPTION} -#' -#' } -#' @docType package -#' @keywords internal -#' @name devtools -"_PACKAGE" - #' Deprecated Functions #' #' These functions are Deprecated in this release of devtools, they will be diff --git a/man/as.package.Rd b/man/as.package.Rd index 04e3e3874..1034691f5 100644 --- a/man/as.package.Rd +++ b/man/as.package.Rd @@ -4,14 +4,12 @@ \alias{as.package} \title{Coerce input to a package.} \usage{ -as.package(x = NULL, create = NA) +as.package(x = NULL, create = deprecated()) } \arguments{ \item{x}{object to coerce to a package} -\item{create}{only relevant if a package structure does not exist yet: if -\code{TRUE}, create a package structure; if \code{NA}, ask the user -(in interactive mode only)} +\item{create}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Hasn't worked for some time.} } \description{ Possible specifications of package: diff --git a/man/devtools.Rd b/man/devtools-package.Rd similarity index 92% rename from man/devtools.Rd rename to man/devtools-package.Rd index ccacd6962..d383bc778 100644 --- a/man/devtools.Rd +++ b/man/devtools-package.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/zzz.R +% Please edit documentation in R/devtools-package.R \docType{package} -\name{devtools} +\name{devtools-package} \alias{devtools} \alias{devtools-package} -\title{Package development tools for R.} +\title{devtools: Tools to Make Developing R Packages Easier} \description{ Collection of package development tools. } diff --git a/man/figures/lifecycle-archived.svg b/man/figures/lifecycle-archived.svg new file mode 100644 index 000000000..48f72a6f3 --- /dev/null +++ b/man/figures/lifecycle-archived.svg @@ -0,0 +1 @@ + lifecyclelifecyclearchivedarchived \ No newline at end of file diff --git a/man/figures/lifecycle-defunct.svg b/man/figures/lifecycle-defunct.svg new file mode 100644 index 000000000..01452e5fb --- /dev/null +++ b/man/figures/lifecycle-defunct.svg @@ -0,0 +1 @@ +lifecyclelifecycledefunctdefunct \ No newline at end of file diff --git a/man/figures/lifecycle-deprecated.svg b/man/figures/lifecycle-deprecated.svg new file mode 100644 index 000000000..4baaee01c --- /dev/null +++ b/man/figures/lifecycle-deprecated.svg @@ -0,0 +1 @@ +lifecyclelifecycledeprecateddeprecated \ No newline at end of file diff --git a/man/figures/lifecycle-experimental.svg b/man/figures/lifecycle-experimental.svg new file mode 100644 index 000000000..d1d060e92 --- /dev/null +++ b/man/figures/lifecycle-experimental.svg @@ -0,0 +1 @@ +lifecyclelifecycleexperimentalexperimental \ No newline at end of file diff --git a/man/figures/lifecycle-maturing.svg b/man/figures/lifecycle-maturing.svg new file mode 100644 index 000000000..df7131014 --- /dev/null +++ b/man/figures/lifecycle-maturing.svg @@ -0,0 +1 @@ +lifecyclelifecyclematuringmaturing \ No newline at end of file diff --git a/man/figures/lifecycle-questioning.svg b/man/figures/lifecycle-questioning.svg new file mode 100644 index 000000000..08ee0c903 --- /dev/null +++ b/man/figures/lifecycle-questioning.svg @@ -0,0 +1 @@ +lifecyclelifecyclequestioningquestioning \ No newline at end of file diff --git a/man/figures/lifecycle-stable.svg b/man/figures/lifecycle-stable.svg new file mode 100644 index 000000000..e015dc811 --- /dev/null +++ b/man/figures/lifecycle-stable.svg @@ -0,0 +1 @@ +lifecyclelifecyclestablestable \ No newline at end of file diff --git a/man/figures/lifecycle-superseded.svg b/man/figures/lifecycle-superseded.svg new file mode 100644 index 000000000..75f24f553 --- /dev/null +++ b/man/figures/lifecycle-superseded.svg @@ -0,0 +1 @@ + lifecyclelifecyclesupersededsuperseded \ No newline at end of file diff --git a/man/run_examples.Rd b/man/run_examples.Rd index 8596939f2..b225ceac5 100644 --- a/man/run_examples.Rd +++ b/man/run_examples.Rd @@ -7,13 +7,13 @@ run_examples( pkg = ".", start = NULL, - show = TRUE, + show = deprecated(), run_donttest = FALSE, run_dontrun = FALSE, fresh = FALSE, document = TRUE, - run, - test + run = deprecated(), + test = deprecated() ) } \arguments{ diff --git a/tests/testthat/_snaps/active.md b/tests/testthat/_snaps/active.md new file mode 100644 index 000000000..20afa4bbc --- /dev/null +++ b/tests/testthat/_snaps/active.md @@ -0,0 +1,21 @@ +# find_active_file() gives useful error if no RStudio + + Code + find_active_file() + Condition + Error: + ! Argument `file` is missing, with no default + +# fails if can't find tests + + Code + find_test_file("R/foo.blah") + Condition + Error: + ! Don't know how to find tests associated with the active file 'foo.blah' + Code + find_test_file("R/foo.R") + Condition + Error: + ! No test files found + diff --git a/tests/testthat/_snaps/build-readme.md b/tests/testthat/_snaps/build-readme.md new file mode 100644 index 000000000..70fc6c4a7 --- /dev/null +++ b/tests/testthat/_snaps/build-readme.md @@ -0,0 +1,16 @@ +# useful errors if too few or too many + + Code + build_readme(pkg) + Condition + Error in `build_readme()`: + ! Can't find 'README.Rmd' or 'inst/README.Rmd'. + +--- + + Code + build_readme(pkg) + Condition + Error in `build_readme()`: + ! Can't have both 'README.Rmd' and 'inst/README.Rmd'. + diff --git a/tests/testthat/_snaps/check-win.md b/tests/testthat/_snaps/check-win.md new file mode 100644 index 000000000..4b62647b1 --- /dev/null +++ b/tests/testthat/_snaps/check-win.md @@ -0,0 +1,16 @@ +# change_maintainer_email checks fields + + Code + change_maintainer_email(path, "x@example.com") + Condition + Error: + ! DESCRIPTION must use Authors@R field when changing `email` + +--- + + Code + change_maintainer_email(path, "x@example.com") + Condition + Error: + ! DESCRIPTION can't use Maintainer field when changing `email` + diff --git a/tests/testthat/_snaps/package.md b/tests/testthat/_snaps/package.md new file mode 100644 index 000000000..d38799b26 --- /dev/null +++ b/tests/testthat/_snaps/package.md @@ -0,0 +1,27 @@ +# package_file() gives useful errors + + Code + package_file(path = 1) + Condition + Error in `package_file()`: + ! `path` must be a string. + Code + package_file(path = "doesntexist") + Condition + Error in `package_file()`: + ! 'doesntexist' is not a directory. + Code + package_file(path = "/") + Condition + Error in `package_file()`: + ! Could not find package root. + i Is '/' inside a package? + +# create argument is deprecated + + Code + x <- as.package(path, create = TRUE) + Condition + Warning: + The `create` argument of `as.package()` is deprecated as of devtools 2.5.0. + diff --git a/tests/testthat/_snaps/run-source.md b/tests/testthat/_snaps/run-source.md new file mode 100644 index 000000000..f68358d54 --- /dev/null +++ b/tests/testthat/_snaps/run-source.md @@ -0,0 +1,51 @@ +# gist with multiple files uses first with warning + + Code + source_gist("605a984e764f9ed358556b4ce48cbd08", sha1 = "f176f5e1fe0", local = environment()) + Message + 2 .R files in gist, using first + i Sourcing gist "605a984e764f9ed358556b4ce48cbd08" + +# errors with bad id + + Code + source_gist("xxxx") + Condition + Error in `source_gist()`: + ! Invalid gist id specification "xxxx" + +# error if file doesn't exist or no files + + Code + find_gist("605a984e764f9ed358556b4ce48cbd08", 1) + Condition + Error: + ! `filename` must be `NULL`, or a single filename ending in .R/.r + Code + find_gist("605a984e764f9ed358556b4ce48cbd08", "c.r") + Condition + Error: + ! 'c.r' not found in gist + Code + find_gist("c535eee2d02e5f47c8e7642811bc327c") + Condition + Error: + ! No R files found in gist + +# check_sha1() checks or reports sha1 as needed + + Code + check_sha1(path, NULL) + Message + i SHA-1 hash of file is "9f7efafc467018e11a7efc4bb7089ff0e5bff371" + Code + check_sha1(path, "f") + Condition + Error in `check_sha1()`: + ! `sha1` must be at least 6 characters, not 1. + Code + check_sha1(path, "ffffff") + Condition + Error in `check_sha1()`: + ! `sha1` ("ffffff") doesn't match SHA-1 hash of downloaded file ("9f7efa") + diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R index 38b1021c4..ab74b570b 100644 --- a/tests/testthat/helper.R +++ b/tests/testthat/helper.R @@ -1,25 +1,10 @@ -# This is a trimmed down version of create_local_thing from usethis -# https://github.com/jimhester/usethis/blob/de8aa116820a8e54f2f952b341039985d78d0352/tests/testthat/helper.R#L28-L68 -create_local_package <- function() { - old_project <- asNamespace("usethis")$proj_get_() # this could be `NULL`, i.e. no active project - old_wd <- getwd() - dir <- file_temp() - - withr::defer(envir = parent.frame(), { - usethis::ui_silence({ - proj_set(old_project, force = TRUE) - }) - setwd(old_wd) - dir_delete(dir) - }) +# This is a VERY trimmed down version of create_local_thing from usethis +local_package_create <- function(envir = parent.frame()) { + dir <- withr::local_tempdir(.local_envir = envir) usethis::ui_silence({ create_package(dir, rstudio = FALSE, open = FALSE, check_name = FALSE) - proj_set(dir) }) - proj_dir <- proj_get() - setwd(proj_dir) - - invisible(proj_dir) + dir } diff --git a/tests/testthat/test-active.R b/tests/testthat/test-active.R index 07d9fa544..53984da67 100644 --- a/tests/testthat/test-active.R +++ b/tests/testthat/test-active.R @@ -1,6 +1,12 @@ +test_that("find_active_file() gives useful error if no RStudio", { + expect_snapshot(find_active_file(), error = TRUE) +}) + test_that("fails if can't find tests", { - expect_error(find_test_file("DESCRIPTION"), "find tests") - expect_error(find_test_file("R/foo.R"), "No test files found") + expect_snapshot(error = TRUE, { + find_test_file("R/foo.blah") + find_test_file("R/foo.R") + }) }) test_that("can determine file type", { diff --git a/tests/testthat/test-build-readme.R b/tests/testthat/test-build-readme.R index 5272012c3..0d1beb010 100644 --- a/tests/testthat/test-build-readme.R +++ b/tests/testthat/test-build-readme.R @@ -1,45 +1,38 @@ -test_that("Package readme in root directory can be built ", { +test_that("can build README in root directory", { skip_on_cran() - pkg_path <- create_local_package() + pkg <- local_package_create() + suppressMessages(usethis::with_project(pkg, use_readme_rmd())) - # errors if no readme found - expect_error( - build_readme(pkg_path), - "Can't find a 'README.Rmd'" - ) - - suppressMessages(use_readme_rmd()) - - suppressMessages(build_readme(pkg_path)) - - expect_true(file_exists(path(pkg_path, "README.md"))) - expect_false(file_exists(path(pkg_path, "README.html"))) + suppressMessages(build_readme(pkg)) + expect_true(file_exists(path(pkg, "README.md"))) + expect_false(file_exists(path(pkg, "README.html"))) }) -test_that("Package readme in inst/ can be built ", { +test_that("can build README in inst/", { skip_on_cran() - pkg_path <- create_local_package() - suppressMessages(use_readme_rmd()) - dir_create(pkg_path, "inst") - file_copy( - path(pkg_path, "README.Rmd"), - path(pkg_path, "inst", "README.Rmd") + pkg <- local_package_create() + suppressMessages(usethis::with_project(pkg, use_readme_rmd())) + dir_create(pkg, "inst") + file_move( + path(pkg, "README.Rmd"), + path(pkg, "inst", "README.Rmd") ) - # errors if both a root readme and inst readme found - expect_error( - build_readme(pkg_path), - "Can't have both" - ) - - file_delete(path(pkg_path, "README.Rmd")) + suppressMessages(build_readme(pkg)) + expect_true(file_exists(path(pkg, "inst", "README.md"))) + expect_false(file_exists(path(pkg, "README.Rmd"))) + expect_false(file_exists(path(pkg, "README.md"))) + expect_false(file_exists(path(pkg, "inst", "README.html"))) +}) - suppressMessages(build_readme(pkg_path)) +test_that("useful errors if too few or too many", { + pkg <- local_package_create() + expect_snapshot(build_readme(pkg), error = TRUE) - expect_true(file_exists(path(pkg_path, "inst", "README.md"))) - expect_false(file_exists(path(pkg_path, "README.Rmd"))) - expect_false(file_exists(path(pkg_path, "README.md"))) - expect_false(file_exists(path(pkg_path, "inst", "README.html"))) + suppressMessages(usethis::with_project(pkg, use_readme_rmd())) + dir_create(pkg, "inst") + file_copy(path(pkg, "README.Rmd"), path(pkg, "inst", "README.Rmd")) + expect_snapshot(build_readme(pkg), error = TRUE) }) diff --git a/tests/testthat/test-check-doc.R b/tests/testthat/test-check-doc.R index af7b77d16..a7727d02a 100644 --- a/tests/testthat/test-check-doc.R +++ b/tests/testthat/test-check-doc.R @@ -5,7 +5,7 @@ test_that("check_man works", { skip_if_not(interactive()) - pkg <- create_local_package() + pkg <- local_package_create() dir.create(file.path(pkg, "man")) writeLines(c(" \\name{foo} diff --git a/tests/testthat/test-check-win.R b/tests/testthat/test-check-win.R new file mode 100644 index 000000000..8be817864 --- /dev/null +++ b/tests/testthat/test-check-win.R @@ -0,0 +1,14 @@ +test_that("change_maintainer_email checks fields", { + path <- withr::local_tempfile() + + desc <- desc::desc(text = "") + desc$write(path) + expect_snapshot(change_maintainer_email(path, "x@example.com"), error = TRUE) + + desc <- desc::desc(text = c( + "Authors@R: person('x', 'y')", + "Maintainer: foo " + )) + desc$write(path) + expect_snapshot(change_maintainer_email(path, "x@example.com"), error = TRUE) +}) diff --git a/tests/testthat/test-install.R b/tests/testthat/test-install.R index fa34b188b..31ba83a77 100644 --- a/tests/testthat/test-install.R +++ b/tests/testthat/test-install.R @@ -2,7 +2,7 @@ library(mockery) local({ -pkg <- create_local_package() +pkg <- fs::path_real(local_package_create()) path2char <- function(x) { if (inherits(x, "fs_path")) { diff --git a/tests/testthat/test-package.R b/tests/testthat/test-package.R new file mode 100644 index 000000000..2cd4e0ff6 --- /dev/null +++ b/tests/testthat/test-package.R @@ -0,0 +1,12 @@ +test_that("package_file() gives useful errors", { + expect_snapshot(error = TRUE, { + package_file(path = 1) + package_file(path = "doesntexist") + package_file(path = "/") + }) +}) + +test_that("create argument is deprecated", { + path <- local_package_create() + expect_snapshot(x <- as.package(path, create = TRUE)) +}) diff --git a/tests/testthat/test-run-source.R b/tests/testthat/test-run-source.R index 5cb33106b..ef968c355 100644 --- a/tests/testthat/test-run-source.R +++ b/tests/testthat/test-run-source.R @@ -1,9 +1,7 @@ test_that("gist containing single file works unambiguously", { skip_if_offline() skip_on_cran() - # TODO remove the CI skips once remotes is on CRAN skip_on_ci() - withr::local_envvar(list("GITHUB_PAT" = asNamespace("remotes")$github_pat())) a <- 10 source_gist( @@ -19,26 +17,26 @@ test_that("gist with multiple files uses first with warning", { skip_if_offline() skip_on_cran() skip_on_ci() - withr::local_envvar(list("GITHUB_PAT" = asNamespace("remotes")$github_pat())) a <- 10 - expect_warning( + expect_snapshot( source_gist( "605a984e764f9ed358556b4ce48cbd08", - sha1 = "f176f5e1fe05b69b1ef799fdd1e4bac6341aff51", - quiet = TRUE, + sha1 = "f176f5e1fe0", local = environment() - ), - "using first" + ) ) expect_equal(a, 1) }) +test_that("errors with bad id", { + expect_snapshot(source_gist("xxxx"), error = TRUE) +}) + test_that("can specify filename", { skip_if_offline() skip_on_cran() skip_on_ci() - withr::local_envvar(list("GITHUB_PAT" = asNamespace("remotes")$github_pat())) b <- 10 source_gist( @@ -55,15 +53,22 @@ test_that("error if file doesn't exist or no files", { skip_if_offline() skip_on_cran() skip_on_ci() - withr::local_envvar(list("GITHUB_PAT" = asNamespace("remotes")$github_pat())) - expect_error( - source_gist("605a984e764f9ed358556b4ce48cbd08", filename = "c.r", local = environment()), - "not found" - ) + expect_snapshot(error = TRUE, { + find_gist("605a984e764f9ed358556b4ce48cbd08", 1) + find_gist("605a984e764f9ed358556b4ce48cbd08", "c.r") + find_gist("c535eee2d02e5f47c8e7642811bc327c") + }) - expect_error( - source_gist("c535eee2d02e5f47c8e7642811bc327c"), - "No R files found" - ) +}) + +test_that("check_sha1() checks or reports sha1 as needed", { + path <- withr::local_tempfile() + writeBin("abc\n", path) + + expect_snapshot(error = TRUE, { + check_sha1(path, NULL) + check_sha1(path, "f") + check_sha1(path, "ffffff") + }) }) diff --git a/tests/testthat/testError/R/error.R b/tests/testthat/testError/R/error.R index 7f2de6e8a..d55c675f8 100644 --- a/tests/testthat/testError/R/error.R +++ b/tests/testthat/testError/R/error.R @@ -4,4 +4,4 @@ f <- function() { -stop("This is an error!") +stop("This is an error!") # nolint diff --git a/tests/testthat/testTestWithFailure/tests/testthat/test-warn.R b/tests/testthat/testTestWithFailure/tests/testthat/test-warn.R index 7ad959948..a6d2de91d 100644 --- a/tests/testthat/testTestWithFailure/tests/testthat/test-warn.R +++ b/tests/testthat/testTestWithFailure/tests/testthat/test-warn.R @@ -1,3 +1,3 @@ test_that("warning from test", { - warning("Beware!") + warning("Beware!") # nolint })