Skip to content

Commit

Permalink
rm crayon; update tests for cli
Browse files Browse the repository at this point in the history
  • Loading branch information
Eliot McIntire committed Dec 5, 2024
1 parent fea036d commit 5c5aaee
Show file tree
Hide file tree
Showing 3 changed files with 12 additions and 14 deletions.
1 change: 0 additions & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -65,7 +65,6 @@ Imports:
Suggests:
archive,
covr,
crayon,
DBI,
future,
geodata,
Expand Down
10 changes: 5 additions & 5 deletions R/messages.R
Original file line number Diff line number Diff line change
Expand Up @@ -223,10 +223,10 @@ messageColoured <- function(..., colour = NULL, indent = NULL, hangingIndent = T

} else {

needCrayon <- FALSE
needCli <- FALSE
if (!is.null(colour)) {
if (is.character(colour)) {
needCrayon <- TRUE
needCli <- TRUE
}
}
mess <- paste0(..., collapse = "")
Expand Down Expand Up @@ -283,15 +283,15 @@ messageColoured <- function(..., colour = NULL, indent = NULL, hangingIndent = T
}
if (any(grepl(.spaceTmpChar, mess)))
mess <- gsub(.spaceTmpChar, " ", mess)
if (needCrayon && requireNamespace("cli", quietly = TRUE)) {
if (needCli && requireNamespace("cli", quietly = TRUE)) {
mess <- lapply(strsplit(mess, "\n"), function(m)
paste0(cliCol(colour)(m)))[[1]]
mess <- .addSlashNToAllButFinalElement(mess)
message(mess, appendLF = appendLF)
} else {
if (needCrayon && !isTRUE(.pkgEnv$.checkedCrayon) && !.requireNamespace("cli")) {
if (needCli && !isTRUE(.pkgEnv$.checkedCli) && !.requireNamespace("cli")) {
message("To add colours to messages, install.packages('cli')", appendLF = appendLF)
.pkgEnv$.checkedCrayon <- TRUE
.pkgEnv$.checkedCli <- TRUE
}
message(mess, appendLF = appendLF)
}
Expand Down
15 changes: 7 additions & 8 deletions tests/testthat/test-cache.R
Original file line number Diff line number Diff line change
Expand Up @@ -564,7 +564,7 @@ test_that("test asPath", {
.message$LoadedCacheResult("Memoised"), "|",
.message$LoadedCacheResult()
), a2)) == 1)
expect_true(sum(grepl(paste(.message$LoadedCacheResult("Memoised"), "saveRDS call"), a3)) == 1)
expect_true(sum(grepl(paste(.message$LoadedCacheResult("Memoised"), ".*saveRDS.*call"), a3)) == 1)

unlink("filename.RData")
try(clearCache(tmpdir, ask = FALSE), silent = TRUE)
Expand All @@ -585,7 +585,7 @@ test_that("test asPath", {
.message$LoadedCacheResult("Memoised"), "|",
.message$LoadedCacheResult()
), a2)) == 1)
expect_true(sum(grepl(paste(.message$LoadedCacheResult("Memoised"), "saveRDS call"), a3)) == 1)
expect_true(sum(cli::ansi_grepl(paste(.message$LoadedCacheResult("Memoised"), "saveRDS call"), a3)) == 1)
})

test_that("test wrong ways of calling Cache", {
Expand Down Expand Up @@ -654,7 +654,7 @@ test_that("test Cache argument inheritance to inner functions", {
# does cachePath propagate to outer ones -- no message about cachePath being tempdir()
out <- capture_messages(Cache(outer, n = 2, cachePath = tmpdir))
expect_true(length(out) == 2)
expect_true(sum(grepl(paste(.message$LoadedCacheResult(), "outer call"), out)) == 1)
expect_true(sum(cli::ansi_grepl(paste(.message$LoadedCacheResult(), "outer call"), out)) == 1)

# check that the rnorm inside "outer" returns cached value even if outer "outer" function is changed
outer <- function(n) {
Expand All @@ -667,7 +667,7 @@ test_that("test Cache argument inheritance to inner functions", {
"There is no similar item in the cachePath",
sep = "|"
)
expect_true(sum(grepl(msgGrep, out)) == 1)
expect_true(sum(cli::ansi_grepl(msgGrep, out)) == 1)

# Override with explicit argument
outer <- function(n) {
Expand All @@ -690,7 +690,7 @@ test_that("test Cache argument inheritance to inner functions", {
# Second time will get a cache on outer
out <- capture_messages(Cache(outer, n = 2, cachePath = tmpdir))
expect_true(length(out) == 2)
expect_true(sum(grepl(paste(.message$LoadedCacheResult(), "outer call"), out)) == 1)
expect_true(sum(cli::ansi_grepl(paste(.message$LoadedCacheResult(), "outer call"), out)) == 1)

# doubly nested
inner <- function(mean, useCache = TRUE) {
Expand Down Expand Up @@ -728,7 +728,7 @@ test_that("test Cache argument inheritance to inner functions", {
"There is no similar item in the cachePath",
sep = "|"
)
expect_true(sum(grepl(msgGrep, out)) == 1)
expect_true(sum(cli::ansi_grepl(msgGrep, out)) == 1)

# Check userTags -- all items have it
clearCache(tmpdir, ask = FALSE)
Expand Down Expand Up @@ -801,7 +801,7 @@ test_that("test future", {
(dd <- system.time({
for (i in 1:3) d[[i]] <- Cache(cachePath = tmpCache, rnorm(1e6 + i))
}))
expect_true((dd[[3]] * 3) < aa[[3]])
expect_true((dd[[3]] * 2) < aa[[3]])
for (i in 1:3) {
expect_true(identical(attr(d[[i]], ".Cache")$newCache, FALSE))
}
Expand Down Expand Up @@ -1361,7 +1361,6 @@ test_that("change to new capturing of FUN & base pipe", {
# (function(xx) rnorm(1, 2, sd = xx))() |>
Cache(cachePath = tmpCache)
")
browser()
mess3 <- capture_messages(
eval(parse(text = f2))
)
Expand Down

0 comments on commit 5c5aaee

Please sign in to comment.