tests/testthat/test-file-utilities-files.R

In writeAlizer: Generate Predicted Writing Quality Scores

# tests/testthat/test-file-utilities.R

quiet <- function(expr) {
  withCallingHandlers(
    suppressWarnings(suppressMessages(force(expr))),
    message = function(m) invokeRestart("muffleMessage"),
    warning = function(w) invokeRestart("muffleWarning")
  )
}

testthat::test_that(".wa_cached_path joins onto wa_cache_dir correctly", {
  if (!exists(".wa_cached_path", asNamespace("writeAlizer"))) {
    testthat::skip("`.wa_cached_path` not found in this build")
  }
  .wa_cached_path <- getFromNamespace(".wa_cached_path", "writeAlizer")
  wa_cache_dir    <- getFromNamespace("wa_cache_dir",    "writeAlizer")

  # Put cache into a temp tree so we don't touch user cache
  withr::local_envvar(R_USER_CACHE_DIR = withr::local_tempdir())

  rel <- file.path("models", "x", "y.bin")
  got <- .wa_cached_path(rel)
  exp <- file.path(wa_cache_dir(), rel)

  # Normalize for OS differences and ensure directories are present
  testthat::expect_identical(normalizePath(dirname(got), winslash = "/", mustWork = FALSE),
                             normalizePath(dirname(exp), winslash = "/", mustWork = FALSE))
  testthat::expect_true(endsWith(got, "y.bin"))
})

testthat::test_that(".wa_from_file_url round-trips real file:// URLs (spaces, % encoding, Windows drives)", {
  if (!exists(".wa_from_file_url", asNamespace("writeAlizer"))) {
    testthat::skip("`.wa_from_file_url` not found in this build")
  }
  .wa_from_file_url <- getFromNamespace(".wa_from_file_url", "writeAlizer")

  # Create a real file path with a space to force %20 encoding in URLs
  tmpdir <- withr::local_tempdir()
  p      <- file.path(tmpdir, "has space.txt")
  writeLines("ok", p)

  # Build a file:// URL from the normalized forward-slash path
  fwd <- normalizePath(p, winslash = "/", mustWork = TRUE)
  url <- paste0("file:///", sub("^/*", "", fwd))   # ensure exactly 3 slashes

  # The helper should decode %20 etc. and produce a platform path
  got <- .wa_from_file_url(url)

  if (.Platform$OS.type == "windows") {
    # On Windows we expect backslashes and no leading slash before drive
    exp <- chartr("/", "\\", fwd)
    if (grepl("^/[A-Za-z]:", got)) {
      got <- substring(got, 2L)  # function already does this, but be resilient
    }
    testthat::expect_true(grepl("^[A-Za-z]:\\\\", got))
    testthat::expect_identical(tolower(got), tolower(exp))
  } else {
    # POSIX: should be the same absolute path with a single leading slash
    testthat::expect_true(startsWith(got, "/"))
    testthat::expect_identical(got, fwd)
  }

  # Non-file URLs should pass through unchanged
  testthat::expect_identical(.wa_from_file_url("https://example.com/x.rds"),
                             "https://example.com/x.rds")
})

testthat::test_that(".wa_local_path builds a path under inst/extdata", {
  if (!exists(".wa_local_path", asNamespace("writeAlizer"))) {
    testthat::skip("`.wa_local_path` not found in this build")
  }
  .wa_local_path <- getFromNamespace(".wa_local_path", "writeAlizer")

  # This does not require the file to exist; we verify the base prefix
  target <- ".does_not_need_to_exist.txt"
  got    <- .wa_local_path(target)
  base   <- system.file("extdata", package = "writeAlizer")

  testthat::expect_true(startsWith(normalizePath(got, winslash = "/", mustWork = FALSE),
                                   normalizePath(base, winslash = "/", mustWork = FALSE)))
  testthat::expect_true(endsWith(got, target))
})

testthat::test_that(".wa_from_file_url handles UNC form (Windows) and leaves host paths untouched (POSIX)", {
  if (!exists(".wa_from_file_url", asNamespace("writeAlizer"))) {
    testthat::skip("`.wa_from_file_url` not found in this build")
  }
  .wa_from_file_url <- getFromNamespace(".wa_from_file_url", "writeAlizer")

  if (.Platform$OS.type == "windows") {
    got <- .wa_from_file_url("file://server/share/folder/file.rds")
    # Accept one or more leading backslashes, then server\share\
    testthat::expect_true(grepl("^\\\\+server\\\\share\\\\", got))
    testthat::expect_true(endsWith(got, "file.rds"))
  } else {
    got <- .wa_from_file_url("file://server/share/folder/file.rds")
    testthat::expect_true(startsWith(got, "/server/share/"))
    testthat::expect_true(endsWith(got, "file.rds"))
  }
})