test_that("%|z|%", { expect_true("" %|z|% TRUE) bad <- list( character(), c("", ""), "foo", structure("", class = "foo") ) for (b in bad) expect_identical(b %|z|% FALSE, b) }) test_that("%&z&%", { expect_equal( NULL %&z&% "bar", "" ) expect_equal( character() %&z&% "bar", "" ) expect_equal( "" %&z&% "bar", "" ) expect_equal( "foo" %&z&% "bar", "bar" ) }) test_that("get_private", { cls <- R6::R6Class( "foo", public = list(foo = function() "foo"), private = list(bar = function() "bar") ) obj <- cls$new() expect_equal(get_private(obj)$bar(), "bar") }) test_that("default_cran_mirror", { m1 <- withr::with_options( list(repos = c(CRAN = "@CRAN@")), default_cran_mirror() ) m2 <- withr::with_options( list(repos = NULL), default_cran_mirror() ) m3 <- withr::with_options( list(repos = c("foo" = "bar")), default_cran_mirror() ) expect_true(is.character(m1) && length(m1) == 1 && !is.na(m1)) expect_identical(m1, m2) expect_identical(m1, m3) m4 <- withr::with_options( list(repos = c(CRAN = "mymirror")), default_cran_mirror() ) expect_identical(m4, c(CRAN = "mymirror")) }) test_that("current_r_version", { ver <- current_r_version() expect_true(is.character(ver)) expect_true(length(ver) == 1) }) test_that("get_minor_r_version", { expect_equal(get_minor_r_version("4.2.2"), "4.2") expect_equal(get_minor_r_version("4.2.2.0"), "4.2") }) test_that("recommended_packages", { expect_snapshot( recommended_packages() ) }) test_that("lapply_with_names", { expect_equal( lapply_with_names(list(a = 1, b = 2), function(x) x * 2), list(a = 2, b = 4) ) expect_equal( lapply_with_names(c("a","b"), function(x) paste0(x, x)), list(a = "aa", b = "bb") ) }) test_that("vlapply", { l <- list(NULL, "", character(), 1) expect_identical( vapply(l, is.character, logical(1)), vlapply(l, is.character) ) expect_identical( vapply(list(), is.character, logical(1)), vlapply(list(), is.character) ) expect_error(vlapply(l, identity), "values must be length 1") expect_error(vlapply(1:5, identity), "values must be type .*logical") }) test_that("viapply", { expect_equal( viapply(c(1L, 2L, 3L), function(x) x), c(1L, 2L, 3L) ) expect_equal( viapply(c(a = 1L, b = 2L, c = 3L), function(x) x), c(a = 1L, b = 2L, c = 3L) ) expect_error( viapply(c(a = 1L, b = 2L), function(x) 1) ) }) test_that("vdapply", { l <- list(NULL, "", character(), 1) f <- function(x) as.double(length(x)) expect_identical( vapply(l, f, double(1)), vdapply(l, f) ) expect_identical( vapply(list(), f, double(1)), vdapply(list(), f) ) expect_error(vdapply(l, identity), "values must be length 1") expect_error(vdapply(letters, identity), "values must be type .*double") }) test_that("add_class", { expect_equal( add_class(structure(1, class = "foo"), "bar"), structure(1, class = c("bar", "foo")) ) }) test_that("cat0", { expect_snapshot({ cat0("foo", "bar", "\n") cat0("foo", "bar", "\n", sep = " ") }) }) test_that("lapply_rows", { expect_equal( lapply_rows(data_frame(), function(...) 1), list() ) expect_equal( lapply_rows( data_frame(foo = character(), bar = integer()), function(...) 1 ), list() ) expect_snapshot( lapply_rows(mtcars[1:3,], function(row) row) ) }) test_that("detect_download_cache_dir", { expect_equal( detect_download_cache_dir(), detect_download_cache_dir() ) }) test_that("rbind_expand", { expect_snapshot({ rbind_expand(data_frame(), data_frame()) rbind_expand(data_frame(), data_frame(foo = 1:2)) rbind_expand(data_frame(bar = c("a", "b")), data_frame()) rbind_expand(data_frame(foo = 1:2), data_frame(foo = 3:4)) rbind_expand(data_frame(foo = 1:2), data_frame(bar = 3:4)) rbind_expand( data_frame(foo = list(1,2), bar = letters[1:2]), data_frame(foo = list(3,4), baz = list("x", "y")) ) }) }) test_that("drop_nulls", { expect_equal(drop_nulls(list()), list()) expect_equal(drop_nulls(list(1,2,3)), list(1,2,3)) expect_equal(drop_nulls(list(NULL)), list()) expect_equal(drop_nulls(list(NULL, NULL)), list()) expect_equal(drop_nulls(list(NULL, 1, NULL)), list(1)) }) test_that("get_num_workers", { withr::local_options(Ncpus = NULL) # ps is not installed mockery::stub(get_num_workers, "ps::ps_cpu_count", function(...) stop("no")) expect_equal(get_num_workers(), 1L) # ps works mockery::stub(get_num_workers, "ps::ps_cpu_count", function(...) 13L) expect_equal(get_num_workers(), 13L) # option works withr::local_options(Ncpus = 11L) expect_equal(get_num_workers(), 11L) }) test_that("is_rcmd_check", { withr::local_envvar(NOT_CRAN = "true") expect_false(is_rcmd_check()) withr::local_envvar( NOT_CRAN = NA_character_, "_R_CHECK_PACKAGE_NAME_" = NA_character_ ) expect_false(is_rcmd_check()) withr::local_envvar( NOT_CRAN = NA_character_, "_R_CHECK_PACKAGE_NAME_" = "foo" ) expect_true(is_rcmd_check()) }) test_that("update_named_vector", { cases <- list( list(c(a=1, b=2), c(a=2, c=5), c(a=2, b=2, c=5)), list(double(), c(a=2), c(a=2)), list(character(), character(), character()), list(c(a=1), double(), c(a=1)) ) for (c in cases) { expect_identical(update_named_vector(c[[1]], c[[2]]), c[[3]]) } expect_error(update_named_vector(1, c(a=1)), "must be named.") expect_error(update_named_vector(c(a=1), 1), "must be named.") }) test_that("make_dl_status", { obj <- list( status = "status", url = "url", target = "target", bytes = NA_real_, error = NULL ) expect_identical( make_dl_status("Got", obj$url, obj$target, 100L), update_named_vector(obj, list(status = "Got", bytes = 100)) ) expect_identical( make_dl_status("Failed", obj$url, obj$target, error = "foobar"), update_named_vector(obj, list(status = "Failed", error = "foobar")) ) expect_identical( make_dl_status("Had", obj$url, obj$target, 100), update_named_vector(obj, list(status = "Had", bytes = 100)) ) }) test_that("comma_wrap", { expect_equal( withr::with_options( list(width = 15), comma_wrap(c("foo", "x", "foo2")) ), " foo, x,\n foo2" ) expect_equal( withr::with_options( list(width = 10), comma_wrap(c("foo", "x", "foo2"), indent = 0) ), "foo, x,\nfoo2" ) expect_equal( withr::with_options( list(width = 10), comma_wrap(c("foo", "x", "foo2"), indent = 0, exdent = 2) ), "foo, x,\n foo2" ) expect_equal( withr::with_options( list(width = 15), comma_wrap(c("foo", "x", "foo2"), sep = "xx ") ), " fooxx xxx\n foo2" ) }) test_that("is_na_scalar", { pos <- list(NA, NA_character_, NA_real_, NA_integer_, NA_complex_) neg <- list(logical(), integer(), 1, 1L, NULL, "foobar", c(NA, 1)) for (p in pos) expect_true(is_na_scalar(p)) for (n in neg) expect_false(is_na_scalar(n)) }) test_that("omit_cols", { df <- data.frame(a = 1:5, b = 5:1, c = letters[1:5]) expect_identical(omit_cols(df, character()), df) expect_identical(omit_cols(df, "x"), df) expect_identical(omit_cols(df, "a"), df[, 2:3]) expect_identical(omit_cols(df, c("a", "b")), df[, 3, drop = FALSE]) expect_identical(omit_cols(df, c("a", "b", "c")), df[, c(), drop = FALSE]) }) test_that("same_sha", { expect_true(same_sha("badcafe", "b")) expect_true(same_sha("b", "badcafe")) expect_false(same_sha("badcafe1", "badcafebadcafe")) expect_false(same_sha("badcafe", NA_character_)) expect_false(same_sha(NA_character_, "badcafe")) }) test_that("format_iso_8601", { d <- structure(1266510204, class = c("POSIXct", "POSIXt"), tzone = "UTC") expect_equal(format_iso_8601(d), "2010-02-18T16:23:24+00:00") }) test_that("is_online", { environment(is_online)$expires <- Sys.time() - 1 on.exit(environment(is_online)$expires <- Sys.time() - 1, add = TRUE) mockery::stub(is_online, "is_rcmd_check", TRUE) expect_false(is_online()) mockery::stub(is_online, "is_rcmd_check", FALSE) mockery::stub(is_online, "pingr::is_online", TRUE) expect_true(is_online()) mockery::stub(is_online, "pingr::is_online", FALSE) # cached for 10 minutes expect_true(is_online()) environment(is_online)$expires <- Sys.time() - 1 expect_false(is_online()) }) test_that("once_per_session", { once_per_session(reset = TRUE) on.exit(once_per_session(reset = TRUE), add = TRUE) expect_snapshot({ once_per_session(message("hello")) once_per_session(message("hello")) once_per_session(reset = TRUE) once_per_session(message("hello")) once_per_session(message("hello")) }) }) test_that("format_error_with_stdout", { err <- new_error("message") expect_snapshot(format_error_with_stdout(err)) err$stdout <- c("this is", "the", "standard output") expect_snapshot(format_error_with_stdout(err)) }) test_that("last_stdout_lines", { expect_snapshot({ last_stdout_lines(letters[1:3], "stdout + stderr") }) # truncated in interactive sessions withr:::local_options(rlib_interactive = TRUE) expect_snapshot({ last_stdout_lines(letters[1:11], "stdout + stderr") }) # full in non-interactive sessions withr:::local_options(rlib_interactive = FALSE) expect_snapshot({ last_stdout_lines(letters[1:11], "stdout + stderr") }) }) test_that("is_windows", { expect_true(is_flag(is_windows())) }) test_that("is_older_rstudio", { expect_true(is_flag(is_older_rstudio())) mockery::stub(is_older_rstudio, "rstudio$detect", list(type = "foo")) expect_false(is_older_rstudio()) mockery::stub( is_older_rstudio, "rstudio$detect", list(type = "rstudio_console", version = package_version("1.4.801")) ) expect_false(is_older_rstudio()) mockery::stub( is_older_rstudio, "rstudio$detect", list(type = "rstudio_console", version = package_version("1.4.700")) ) expect_true(is_older_rstudio()) }) cli::test_that_cli(configs = c("plain", "ansi"), "ansi_align_width", { expect_equal(ansi_align_width(character()), character()) expect_snapshot( ansi_align_width(c("foobar", cli::col_red("bar"))) ) }) test_that("get_id", { expect_true(is_count(get_id())) expect_true(get_id() != get_id()) }) test_that("safe_md5sum", { mkdirp(tmp <- withr::local_tempdir()) x <- file.path(tmp, "cs\u0151\u00fa\u0171") file.create(x) expect_equal( safe_md5sum(x)[[1]], "d41d8cd98f00b204e9800998ecf8427e" ) mockery::stub( safe_md5sum, "tools::md5sum", function(files) { if (files == x) stop("no") else tools::md5sum(files) } ) expect_equal( safe_md5sum(x)[[1]], "d41d8cd98f00b204e9800998ecf8427e" ) }) test_that("get_euid", { skip_on_os("windows") expect_true(is_count(get_euid())) mockery::stub(get_euid, "processx::run", function(...) stop("nope")) expect_equal(get_euid(), NA_integer_) })