tests/testthat/helper.R

In MangoTheCat/remotes: R Package Installation from Remote Repositories, Including 'GitHub'

skip_if_offline <- function(host = "httpbin.org", port = 80) {

  res <- tryCatch(
    pingr::ping_port(host, count = 1L, port = port),
    error = function(e) NA
  )

  if (is.na(res)) skip("No internet connection")
}

skip_if_over_rate_limit <- function(by = 50) {

  tmp <- tempfile()
  download(
    tmp,
    "https://api.github.com/rate_limit",
    auth_token = github_pat()
  )

  res <- json$parse_file(tmp)$rate$remaining
  if (is.null(res) || res <= by) skip("Over the GitHub rate limit")
}

expect_equal_named_lists <- function(object, expected, ...) {
  expect_true(!is.null(names(object)) && !is.null(names(expected)))
  expect_true(is.list(object) && is.list(expected))
  object <- object[order(names(object))]
  expected <- expected[order(names(expected))]
  expect_equal(!!object, !!expected)
}

skip_without_package <- function(pkg) {
  if (!requireNamespace(pkg, quietly = TRUE)) {
    skip(paste("Need the", pkg, "package"))
  }
}

skip_without_program <- function(program) {
  if (Sys.which(program) == "") {
    skip(paste("Need the", program, "program"))
  }
}

test_temp_file <- function(fileext = "", pattern = "test-file-",
                           envir = parent.frame()) {
  tmp <- tempfile(pattern = pattern, fileext = fileext)
  withr::defer(
    try(unlink(tmp, recursive = TRUE, force = TRUE), silent = TRUE),
    envir = envir)
  tmp
}

test_temp_dir <- function(pattern = "test-dir-", envir = parent.frame()) {
  tmp <- test_temp_file(pattern, envir = envir)
  dir.create(tmp, recursive = TRUE, showWarnings = FALSE)
  tmp
}

httpbin <- webfakes::new_app_process(webfakes::httpbin_app())

test_package_root <- function() {
  x <- tryCatch(
    rprojroot::find_package_root_file(),
    error = function(e) NULL)

  if (!is.null(x)) return(x)

  pkg <- testthat::testing_package()
  x <- tryCatch(
    rprojroot::find_package_root_file(
      path = file.path("..", "..", "00_pkg_src", pkg)),
    error = function(e) NULL)

  if (!is.null(x)) return(x)

  stop("Cannot find package root")
}