skip_on_cran() mock_fetch_memory <- function(url, handle, ...) { file <- system.file("testdata", paste0(basename(url), ".rds"), package = "ricu") if (identical(file, "")) { stop("file ", url, "not found") } readRDS(file) } mock_fetch_disk <- function(url, path, handle, ...) { dat <- mock_fetch_memory(url, handle) # if e.g. timecondition opt can be queried from handle, a 304 could be # returned to mimic the no-change scenario writeBin(dat[["content"]], path) dat } mock_fetch_stream <- function(url, fun, handle, ...) { dat <- mock_fetch_memory(url, handle) fun(dat[["content"]]) dat } if (requireNamespace("mockthat", quietly = TRUE)) { wrong_fun <- mockthat::mock(stop("called wrong fun")) } test_that("credentials", { withr::local_envvar(FOO_VAR = "bar_val") expect_silent(crd <- get_cred("foo_val", "FOO_VAR", "input")) expect_identical(crd, "foo_val") expect_silent(crd <- get_cred(NULL, "FOO_VAR", "input")) expect_identical(crd, "bar_val") withr::local_envvar(FOO_VAR = NA) skip_if_not_installed("mockthat") res <- mockthat::with_mock( is_interactive = function() TRUE, read_line = function(...) "baz_val", get_cred(NULL, "BAR_VAR", "input") ) expect_identical(res, "baz_val") }) test_that("file size", { skip_if_not_installed("mockthat") pat_siz <- mockthat::with_mock( `curl::curl_fetch_memory` = mock_fetch_memory, `curl::curl_fetch_disk` = wrong_fun, `curl::curl_fetch_stream` = wrong_fun, get_file_size("foo/PATIENTS.csv", NULL, NULL) ) expect_type(pat_siz, "double") expect_length(pat_siz, 1L) }) test_that("hash checking", { skip_if_not_installed("mockthat") sha <- mockthat::with_mock( `curl::curl_fetch_memory` = mock_fetch_memory, `curl::curl_fetch_disk` = wrong_fun, `curl::curl_fetch_stream` = wrong_fun, get_sha256("foo") ) expect_type(sha, "list") for (x in sha) { expect_type(x, "character") expect_length(x, 2L) } tmp <- withr::local_tempdir() tbl <- "PATIENTS.csv" res <- mockthat::with_mock( `curl::curl_fetch_memory` = wrong_fun, `curl::curl_fetch_disk` = mock_fetch_disk, `curl::curl_fetch_stream` = wrong_fun, download_pysionet_file( "foo/PATIENTS.csv", file.path(tmp, tbl) ) ) expect_null(res) sha <- setNames(chr_xtr(sha, 1L), chr_xtr(sha, 2L)) expect_true(check_file_sha256(file.path(tmp, tbl), sha[[tbl]])) }) test_that("file download", { skip_if_not_installed("mockthat") tmp <- withr::local_tempdir() dat_mem <- mockthat::with_mock( `curl::curl_fetch_memory` = mock_fetch_memory, `curl::curl_fetch_disk` = wrong_fun, `curl::curl_fetch_stream` = wrong_fun, download_pysionet_file("foo/SHA256SUMS.txt") ) expect_type(dat_mem, "raw") expect_identical(list.files(tmp), character(0L)) tmp <- withr::local_tempdir() dat_disk <- mockthat::with_mock( `curl::curl_fetch_memory` = wrong_fun, `curl::curl_fetch_disk` = mock_fetch_disk, `curl::curl_fetch_stream` = wrong_fun, download_pysionet_file( "foo/SHA256SUMS.txt", file.path(tmp, "SHA256SUMS.txt") ) ) expect_type(dat_disk, "NULL") expect_identical(list.files(tmp), "SHA256SUMS.txt") tmp <- withr::local_tempdir() tables <- c("PATIENTS.csv", "SERVICES.csv") res <- mockthat::with_mock( `curl::curl_fetch_memory` = mock_fetch_memory, `curl::curl_fetch_disk` = mock_fetch_disk, `curl::curl_fetch_stream` = mock_fetch_stream, download_check_data(tmp, tables, "foo", "foo", NULL, NULL, FALSE) ) expect_null(res) expect_setequal(list.files(tmp), tables) expect_warning( mockthat::with_mock( `curl::curl_fetch_memory` = mock_fetch_memory, `curl::curl_fetch_disk` = mock_fetch_disk, `curl::curl_fetch_stream` = mock_fetch_stream, check_file_sha256 = function(...) FALSE, download_check_data(tmp, tables, "foo", "foo", NULL, NULL, FALSE) ), class = "checksum_mismatch" ) expect_error( mockthat::with_mock( `curl::curl_fetch_memory` = mock_fetch_memory, `curl::curl_fetch_disk` = mock_fetch_disk, `curl::curl_fetch_stream` = mock_fetch_stream, download_check_data(tmp, tolower(tables), "foo", "foo", NULL, NULL, FALSE) ), class = "are_in_assert" ) }) test_that("src download", { skip_if_not_installed("mockthat") mock_dl_check <- function(dest_folder, files, url, user, pass, src) { assert_that( is.character(files), has_length(files), is.string(dest_folder), is.string(url) ) invisible(NULL) } mock_untar <- function(tarfile, files, exdir, ...) { assert_that( is.string(tarfile), is.character(files), has_length(files), is.string(exdir) ) invisible(0L) } tmp <- withr::local_tempdir() srcs <- c("mimic_demo", "eicu_demo") dirs <- file.path(tmp, srcs) expect_true(all(lgl_ply(dirs, dir.create))) mk_dl <- mockthat::mock(NULL) expect_invisible( res <- mockthat::with_mock( download_check_data = mk_dl, download_src(srcs, dirs) ) ) expect_null(res) expect_true(dir.exists(mockthat::mock_arg(mk_dl, "dest_folder"))) src <- "hirid" dir <- file.path(tmp, src) expect_true(dir.create(dir)) expect_invisible( res <- mockthat::with_mock( download_check_data = NULL, ricu_untar = 0L, download_src(src, dir) ) ) expect_null(res) skip_if_no_local_testdata() dl_file <- function(url, handle = new_handle(), dest = NULL, progr = NULL) { dir <- system.file("local_testdata", package = "ricu") if (is.null(dest)) { readRDS(file.path(dir, "aumc-fs.rds")) } else { file.copy(file.path(dir, "AmsterdamUMCdb-v1.0.2.zip"), dirname(dest)) readRDS(file.path(dir, "aumc-dl.rds")) } } src <- "aumc" dir <- file.path(tmp, src) expect_true(dir.create(dir)) expect_invisible( res <- mockthat::with_mock( download_file = dl_file, get_cred = "foo", download_src(src, dir, verbose = FALSE) ) ) expect_null(res) expect_length(list.files(dir, pattern = "\\.csv$"), 7L) expect_message( res <- mockthat::with_mock( download_file = NULL, download_src(src, dir) ), class = "no_dl_required" ) expect_null(res) })