✨Use cli for all errors etc ✨

R/edition.R

@@ -27,8 +27,8 @@ edition_deprecate <- function(in_edition, what, instead = NULL) {
     return()
   }
 
-  warn(c(
-    paste0("`", what, "` was deprecated in ", edition_name(in_edition), "."),
+  cli::cli_warn(c(
+    "{.code {what}} was deprecated in {edition_name(in_edition)}.",
     i = instead
   ))
 }
@@ -40,7 +40,7 @@ edition_require <- function(in_edition, what) {
     return()
   }
 
-  stop(paste0("`", what, "` requires ", edition_name(in_edition), "."))
+  cli::cli_abort("{.code {what}} requires {edition_name(in_edition)}.")
 }
 
 edition_name <- function(x) {

R/expect-comparison.R

@@ -39,8 +39,8 @@ expect_compare_ <- function(
 
   cmp <- op(act$val, exp$val)
   if (length(cmp) != 1 || !is.logical(cmp)) {
-    abort(
-      "Result of comparison must be a single logical value",
+    cli::cli_abort(
+      "Result of comparison must be a single logical value.",
       call = trace_env
     )
   }
@@ -112,14 +112,14 @@ expect_gte <- function(object, expected, label = NULL, expected.label = NULL) {
 #' @param ... All arguments passed on to `expect_lt()`/`expect_gt()`.
 #' @keywords internal
 expect_less_than <- function(...) {
-  warning("Deprecated: please use `expect_lt()` instead", call. = FALSE)
+  cli::cli_warn("Deprecated: please use {.fn expect_lt} instead.")
   expect_lt(...)
 }
 
 #' @rdname expect_less_than
 #' @export
 expect_more_than <- function(...) {
-  warning("Deprecated: please use `expect_gt()` instead", call. = FALSE)
+  cli::cli_warn("Deprecated: please use {.fn expect_gt} instead.")
   expect_gt(...)
 }
 

R/expect-condition.R

@@ -169,7 +169,7 @@ expect_warning <- function(
 
   if (edition_get() >= 3) {
     if (!missing(all)) {
-      warn("The `all` argument is deprecated")
+      cli::cli_warn("The {.arg all} argument is deprecated.")
     }
 
     expect_condition_matching_(

R/expect-known.R

@@ -79,7 +79,7 @@ expect_known_output <- function(
 
 compare_file <- function(path, lines, ..., update = TRUE, info = NULL) {
   if (!file.exists(path)) {
-    warning("Creating reference output", call. = FALSE)
+    cli::cli_warn("Creating reference output.")
     brio::write_lines(lines, path)
     return(pass(NULL))
   }
@@ -88,11 +88,11 @@ compare_file <- function(path, lines, ..., update = TRUE, info = NULL) {
   if (update) {
     brio::write_lines(lines, path)
     if (!all_utf8(lines)) {
-      warning("New reference output is not UTF-8 encoded", call. = FALSE)
+      cli::cli_warn("New reference output is not UTF-8 encoded.")
     }
   }
   if (!all_utf8(old_lines)) {
-    warning("Reference output is not UTF-8 encoded", call. = FALSE)
+    cli::cli_warn("Reference output is not UTF-8 encoded.")
   }
 
   comp <- waldo_compare(
@@ -178,7 +178,7 @@ expect_known_value <- function(
   act <- quasi_label(enquo(object), label)
 
   if (!file.exists(file)) {
-    warning("Creating reference value", call. = FALSE)
+    cli::cli_warn("Creating reference value.")
     saveRDS(object, file, version = version)
   } else {
     ref_val <- readRDS(file)
@@ -232,7 +232,7 @@ expect_known_hash <- function(object, hash = NULL) {
   }
 
   if (is.null(hash)) {
-    warning(paste0("No recorded hash: use ", substr(act_hash, 1, 10)))
+    cli::cli_warn("No recorded hash: use {substr(act_hash, 1, 10)}.")
   } else {
     if (hash != act_hash) {
       msg <- sprintf("Value hashes to %s, not %s", act_hash, hash)

R/expect-setequal.R

@@ -131,35 +131,6 @@ expect_in <- function(object, expected) {
 
 # Helpers ----------------------------------------------------------------------
 
-check_map_names <- function(
-  x,
-  error_arg = caller_arg(x),
-  error_call = caller_env()
-) {
-  nms <- names2(x)
-
-  if (anyDuplicated(nms)) {
-    dups <- unique(nms[duplicated(nms)])
-    cli::cli_abort(
-      c(
-        "All elements in {.arg {error_arg}} must have unique names.",
-        x = "Duplicate names: {.str {dups}}"
-      ),
-      call = error_call
-    )
-  }
-  if (any(nms == "")) {
-    empty <- which(nms == "")
-    cli::cli_abort(
-      c(
-        "All elements in {.arg {error_arg}} must have names.",
-        x = "Empty names at position{?s}: {empty}"
-      ),
-      call = error_call
-    )
-  }
-}
-
 check_vector <- function(
   x,
   error_arg = caller_arg(x),

R/expectation.R

@@ -189,11 +189,9 @@ as.expectation.skip <- function(x, ..., srcref = NULL) {
 
 #' @export
 as.expectation.default <- function(x, srcref = NULL) {
-  stop(
-    "Don't know how to convert '",
-    paste(class(x), collapse = "', '"),
-    "' to expectation.",
-    call. = FALSE
+  cli::cli_abort(
+    "Don't know how to convert {.cls {class(x)}} to expectation.",
+    call = NULL
   )
 }
 

R/mock.R

@@ -27,9 +27,11 @@ with_mock <- function(..., .env = topenv()) {
   mock_qual_names <- names(dots)
 
   if (all(mock_qual_names == "")) {
-    warning(
-      "Not mocking anything. Please use named parameters to specify the functions you want to mock.",
-      call. = FALSE
+    cli::cli_warn(
+      c(
+        "Not mocking anything.",
+        "i" = "Please use named parameters to specify the functions you want to mock."
+      )
     )
     code_pos <- rep(TRUE, length(dots))
   } else {
@@ -85,11 +87,8 @@ extract_mocks <- function(funs, .env) {
       pkg_name <- gsub(pkg_and_name_rx, "\\1", qual_name)
 
       if (is_base_pkg(pkg_name)) {
-        stop(
-          "Can't mock functions in base packages (",
-          pkg_name,
-          ")",
-          call. = FALSE
+        cli::cli_abort(
+          "Can't mock functions in base package {.pkg {pkg_name}}."
         )
       }
 
@@ -102,13 +101,8 @@ extract_mocks <- function(funs, .env) {
       env <- asNamespace(pkg_name)
 
       if (!exists(name, envir = env, mode = "function")) {
-        stop(
-          "Function ",
-          name,
-          " not found in environment ",
-          environmentName(env),
-          ".",
-          call. = FALSE
+        cli::cli_abort(
+          "Function {.fn {name}} not found in environment {environmentName(env)}."
         )
       }
       mock(name = name, env = env, new = funs[[qual_name]])

R/mock2.R

@@ -185,18 +185,18 @@ local_bindings_rebind <- function(..., .env = .frame, .frame = caller_env()) {
   invisible()
 }
 
-dev_package <- function() {
+dev_package <- function(call = caller_env()) {
   if (is_testing() && testing_package() != "") {
     testing_package()
   } else {
     loaded <- loadedNamespaces()
     is_dev <- map_lgl(loaded, function(x) !is.null(pkgload::dev_meta(x)))
     if (sum(is_dev) == 0) {
-      cli::cli_abort("No packages loaded with pkgload")
+      cli::cli_abort("No packages loaded with pkgload", call = call)
     } else if (sum(is_dev) == 1) {
       loaded[is_dev]
     } else {
-      cli::cli_abort("Multiple packages loaded with pkgload")
+      cli::cli_abort("Multiple packages loaded with pkgload", call = call)
     }
   }
 }

R/old-school.R

@@ -139,9 +139,8 @@ throws_error <- function(regexp = NULL, ...) {
 #' @export
 #' @param amount maximum duration in seconds
 takes_less_than <- function(amount) {
-  warning(
-    "takes_less_than() is deprecated because it is stochastic and unreliable",
-    call. = FALSE
+  cli::cli_warn(
+    "{.fn takes_less_than} is deprecated because it is stochastic and unreliable."
   )
 
   function(expr) {
@@ -165,7 +164,7 @@ takes_less_than <- function(amount) {
 #' @keywords internal
 #' @export
 not <- function(f) {
-  warning("`not()` is deprecated.", call. = FALSE)
+  cli::cli_warn("{.fn not} is deprecated.")
   stopifnot(is.function(f))
 
   negate <- function(expt) {

R/parallel-config.R

@@ -8,7 +8,9 @@ find_parallel <- function(path, load_package = "source", package = NULL) {
     if (toupper(parenv) == "FALSE") {
       return(FALSE)
     }
-    abort("`TESTTHAT_PARALLEL` must be `TRUE` or `FALSE`")
+    cli::cli_abort(
+      "{.envvar TESTTHAT_PARALLEL} must be {.code TRUE} or {.code FALSE}."
+    )
   }
 
   # Make sure we get the local package package if not "installed"
@@ -28,7 +30,7 @@ find_parallel <- function(path, load_package = "source", package = NULL) {
   if (par) {
     ed <- as.integer(desc$get_field("Config/testthat/edition", default = 2L))
     if (ed < 3) {
-      inform("Running tests in parallel requires the 3rd edition")
+      cli::cli_inform("Running tests in parallel requires the 3rd edition.")
       par <- FALSE
     }
   }

R/parallel-taskq.R

@@ -40,7 +40,7 @@ task_q <- R6::R6Class(
         id <- private$get_next_id()
       }
       if (id %in% private$tasks$id) {
-        stop("Duplicate task id")
+        cli::cli_abort("Duplicate task id.")
       }
       before <- which(private$tasks$idle)[1]
       private$tasks <- df_add_row(
@@ -123,16 +123,11 @@ task_q <- R6::R6Class(
             private$handle_error(msg, i)
           } else {
             file <- private$tasks$args[[i]][[1]]
-            errmsg <- paste0(
-              "unknown message from testthat subprocess: ",
-              msg$code,
-              ", ",
-              "in file `",
-              file,
-              "`"
-            )
-            abort(
-              errmsg,
+            cli::cli_abort(
+              c(
+                "Unknown message from testthat subprocess: {msg$code}.",
+                "i" = "In file {.file {file}}."
+              ),
               test_file = file,
               class = c("testthat_process_error", "testthat_error")
             )
@@ -211,7 +206,7 @@ task_q <- R6::R6Class(
     },
 
     handle_error = function(msg, task_no) {
-      inform("\n") # get out of the progress bar, if any
+      cat("\n") # get out of the progress bar, if any
       fun <- private$tasks$fun[[task_no]]
       file <- private$tasks$args[[task_no]][[1]]
       if (is.null(fun)) {
@@ -220,21 +215,22 @@ task_q <- R6::R6Class(
           c(private$tasks$startup[[task_no]], msg$stderr),
           collapse = "\n"
         )
-        abort(
-          paste0(
-            "testthat subprocess failed to start, stderr:\n",
-            msg$error$stderr
+        cli::cli_abort(
+          c(
+            "testthat subprocess failed to start.",
+            " " = "{no_wrap(msg$error$stderr)}"
           ),
           test_file = NULL,
-          parent = msg$error,
-          class = c("testthat_process_error", "testthat_error")
+          class = c("testthat_process_error", "testthat_error"),
+          call = NULL
         )
       } else {
-        abort(
-          paste0("testthat subprocess exited in file `", file, "`"),
+        cli::cli_abort(
+          "testthat subprocess exited in file {.file {file}}.",
           test_file = file,
           parent = msg$error,
-          class = c("testthat_process_error", "testthat_error")
+          class = c("testthat_process_error", "testthat_error"),
+          call = NULL
         )
       }
     }

R/parallel.R

@@ -46,12 +46,9 @@ test_files_parallel <- function(
   # TODO: support timeouts. 20-30s for each file by default?
 
   num_workers <- min(default_num_cpus(), length(test_paths))
-  inform(paste0(
-    "Starting ",
-    num_workers,
-    " test process",
-    if (num_workers != 1) "es"
-  ))
+  cli::cli_inform(
+    "Starting {num_workers} test process{?es}."
+  )
 
   # Set up work queue ------------------------------------------
   queue <- NULL
@@ -110,7 +107,7 @@ default_num_cpus <- function() {
   if (!is.null(ncpus)) {
     ncpus <- suppressWarnings(as.integer(ncpus))
     if (is.na(ncpus)) {
-      abort("`getOption(Ncpus)` must be an integer")
+      cli::cli_abort("{.fn getOption}({.arg Ncpus}) must be an integer.")
     }
     return(ncpus)
   }
@@ -120,7 +117,7 @@ default_num_cpus <- function() {
   if (ncpus != "") {
     ncpus <- suppressWarnings(as.integer(ncpus))
     if (is.na(ncpus)) {
-      abort("TESTTHAT_CPUS must be an integer")
+      cli::cli_abort("{.envvar TESTTHAT_CPUS} must be an integer.")
     }
     return(ncpus)
   }
@@ -155,7 +152,7 @@ parallel_event_loop_smooth <- function(queue, reporters, test_dir) {
 
       m <- x$message
       if (!inherits(m, "testthat_message")) {
-        message(m)
+        cli::cli_inform(as.character(m))
         next
       }
 
@@ -195,7 +192,7 @@ parallel_event_loop_chunky <- function(queue, reporters, test_dir) {
 
       m <- x$message
       if (!inherits(m, "testthat_message")) {
-        message(m)
+        cli::cli_inform(as.character(m))
         next
       }
 

R/reporter-fail.R

@@ -23,7 +23,7 @@ FailReporter <- R6::R6Class(
 
     end_reporter = function() {
       if (self$failed) {
-        stop("Failures detected.", call. = FALSE)
+        cli::cli_abort("Failures detected.")
       }
     }
   )

R/reporter-junit.R

@@ -166,7 +166,7 @@ JunitReporter <- R6::R6Class(
         xml2::write_xml(self$doc, file, format = TRUE)
         cat(brio::read_file(file), file = self$out)
       } else {
-        stop("unsupported output type: ", toString(self$out))
+        cli::cli_abort("Unsupported output type: {toString(self$out)}.")
       }
     } # end_reporter
   ), # public